subroutine to array

[QoS]

Is there any other way to load a subroutine into an array?

#!/usr/bin/perl
use strict;
use warnings;

my @array;

@array = loadSub('example');
if (defined $array[0]) {
foreach my $l (@array) {
print $l;
}
}

exit;

sub loadSub #-----------------------------------------------------------
{
my $sub = quotemeta ($_[0]) || return (0);
my $this_perl = $0;

if (open (IN, '<', $this_perl)) {
my ($out, $found,);
while (my $line = (<IN>)) {
if (! $found && ! $line =~ m/^\s*sub\s+$sub/) {
next;
}
else {
$found = 1;
if ($line =~ m/^\s*}/) { last; }
$out .= $line;
}
}
if (! $found) {
warn 'Unable to find subroutine: ' . $sub . "\n";
$out = 0;
}
close IN
|| warn "Unable to close input file in loadSub\n";
return ($out);
}
else {
warn "Unable to read file: $this_perl\n$!\n";
}
return (0);
}
sub example #-----------------------------------------------------------
{
my ($a, $b,);
foreach my $n (1..5) { $a++; $b += $a + $n; }
return ($b);
}

 

[John W. Krahn]

Is there any other way to load a subroutine into an array?

perldoc -q "How do I find matching/nesting anything"

#!/usr/bin/perl
use strict;
use warnings;

my @array;

@array = loadSub('example');

Or just:

my @array = loadSub('example');

if (defined $array[0]) {
foreach my $l (@array) {
print $l;
}
}

Or just:

@array and print @array;

exit;

sub loadSub #-----------------------------------------------------------
{
my $sub = quotemeta ($_[0]) || return (0);

You are returning 0 but you are testing the result of running this
subroutine with defined() so your test "if (defined $array[0]) {" will
always be true.

my $this_perl = $0;

if (open (IN, '<', $this_perl)) {
my ($out, $found,);
while (my $line = (<IN>)) {
if (! $found && ! $line =~ m/^\s*sub\s+$sub/) {
next;
}
else {
$found = 1;
if ($line =~ m/^\s*}/) { last; }
$out .= $line;
}
}
if (! $found) {
warn 'Unable to find subroutine: ' . $sub . "\n";
$out = 0;
}
close IN
|| warn "Unable to close input file in loadSub\n";
return ($out);
}
else {
warn "Unable to read file: $this_perl\n$!\n";
}
return (0);

You are returning 0 but you are testing the result of running this
subroutine with defined() so your test "if (defined $array[0]) {" will
always be true.

}
sub example #-----------------------------------------------------------
{
my ($a, $b,);
foreach my $n (1..5) { $a++; $b += $a + $n; }
return ($b);
}

Could be written more simply as:

#!/usr/bin/perl
use strict;
use warnings;

# Is there any other way to load a subroutine into an array?

my @array = loadSub( 'example' );

@array and print @array;

sub loadSub {
my $sub = quotemeta $_[ 0 ] or return;
my $this_perl = $0;

open my $IN, '<', $this_perl or do {
warn "Unable to read file: $this_perl\n$!\n";
return;
};

my $out;
while ( my $line = <$IN> ) {
next if !defined $out && $line !~ /^\s*sub\s+$sub/;
$out .= $line;
return $out if $line =~ /^\s*}/;
}

warn "Unable to find subroutine: $sub\n";
return;
}

sub example {
my ( $x, $y );
$y += ++$x + $_ for 1 .. 5;
return $y;
}

__END__



John

 

[sln]

On Sat, 29 Nov 2008 05:35:52 GMT, (e-mail address removed) wrote:

Not until you indent more than 2 characters.
Even then I won't look at it. Just because of the title.

sln

 

[Jürgen Exner]

Is there any other way to load a subroutine into an array?

Sort of. Typically people would use a hash also known as a dispatch
table. But of course you could use an array instead of a hash, too, to
store the function references.

jue

 

[QoS]

Sort of. Typically people would use a hash also known as a dispatch
table. But of course you could use an array instead of a hash, too, to
store the function references.

jue

dispatch table, yeah ive got some text on those; thanks!

 

[QoS]

appreciate the tips, learned something, thanks.

Is there any other way to load a subroutine into an array?

perldoc -q "How do I find matching/nesting anything"

#!/usr/bin/perl
use strict;
use warnings;

my @array;

@array = loadSub('example');

Or just:

my @array = loadSub('example');

if (defined $array[0]) {
foreach my $l (@array) {
print $l;
}
}

Or just:

@array and print @array;

exit;

sub loadSub #-----------------------------------------------------------
{
my $sub = quotemeta ($_[0]) || return (0);

You are returning 0 but you are testing the result of running this
subroutine with defined() so your test "if (defined $array[0]) {" will
always be true.

my $this_perl = $0;

if (open (IN, '<', $this_perl)) {
my ($out, $found,);
while (my $line = (<IN>)) {
if (! $found && ! $line =~ m/^\s*sub\s+$sub/) {
next;
}
else {
$found = 1;
if ($line =~ m/^\s*}/) { last; }
$out .= $line;
}
}
if (! $found) {
warn 'Unable to find subroutine: ' . $sub . "\n";
$out = 0;
}
close IN
|| warn "Unable to close input file in loadSub\n";
return ($out);
}
else {
warn "Unable to read file: $this_perl\n$!\n";
}
return (0);

You are returning 0 but you are testing the result of running this
subroutine with defined() so your test "if (defined $array[0]) {" will
always be true.

}
sub example #-----------------------------------------------------------
{
my ($a, $b,);
foreach my $n (1..5) { $a++; $b += $a + $n; }
return ($b);
}

Could be written more simply as:

#!/usr/bin/perl
use strict;
use warnings;

# Is there any other way to load a subroutine into an array?

my @array = loadSub( 'example' );

@array and print @array;

sub loadSub {
my $sub = quotemeta $_[ 0 ] or return;
my $this_perl = $0;

open my $IN, '<', $this_perl or do {
warn "Unable to read file: $this_perl\n$!\n";
return;
};

my $out;
while ( my $line = <$IN> ) {
next if !defined $out && $line !~ /^\s*sub\s+$sub/;
$out .= $line;
return $out if $line =~ /^\s*}/;
}

warn "Unable to find subroutine: $sub\n";
return;
}

sub example {
my ( $x, $y );
$y += ++$x + $_ for 1 .. 5;
return $y;
}

__END__



John

 

[sln]

Is there any other way to load a subroutine into an array?

#!/usr/bin/perl
use strict;
use warnings;

my @array;

@array = loadSub('example');
if (defined $array[0]) {
foreach my $l (@array) {
print $l;
}
}

exit;

sub loadSub #-----------------------------------------------------------
{
my $sub = quotemeta ($_[0]) || return (0);
my $this_perl = $0;

if (open (IN, '<', $this_perl)) {
my ($out, $found,);
while (my $line = (<IN>)) {
if (! $found && ! $line =~ m/^\s*sub\s+$sub/) {

^-^
The binding might be closer than the =~ giving all but the sub.
Try if (! $found && !($line =~ m/^\s*sub\s+$sub/)) {,
typically, if (! $found && $line !~ m/^\s*sub\s+$sub/) {

next;
}
else {
$found = 1;

Need to get the last line before bailing out of the while(),
if that is what you wan't.
$out .= $line;

if ($line =~ m/^\s*}/) { last; }
# $out .= $line;
}
}
if (! $found) {
warn 'Unable to find subroutine: ' . $sub . "\n";
$out = 0;
}
close IN
|| warn "Unable to close input file in loadSub\n";
return ($out);
}
else {
warn "Unable to read file: $this_perl\n$!\n";
}
return (0);
}
sub example #-----------------------------------------------------------
{
my ($a, $b,);
foreach my $n (1..5) { $a++; $b += $a + $n; }
return ($b);
}

This line: if ($line =~ m/^\s*}/) { last; }
will not always get you what you appear to wan't.
I mean, if this is any more than casual, you would have
to do a balanced squigly for it to really parse, including
comment processing, etc..

Consider:

sub example1 {
my ( $x, $y );
$y += ++$x + $_ for 1 .. 5;
if ($y > 357) {
# ??
}
return $y;
}

sub example1 will return before the end of the sub is read.

Good luck!


sln

 

[sln]

[snip]
The binding might be closer than the =~ giving all but the sub.

Actually, I correct myself, it will give all up to the first
if ($line =~ m/^\s*}/) { last; },
which is right after line 6.

sln

 

[QoS]

Is there any other way to load a subroutine into an array?

#!/usr/bin/perl
use strict;
use warnings;

my @array;

@array = loadSub('example');
if (defined $array[0]) {
foreach my $l (@array) {
print $l;
}
}

exit;

sub loadSub #-----------------------------------------------------------
{
my $sub = quotemeta ($_[0]) || return (0);
my $this_perl = $0;

if (open (IN, '<', $this_perl)) {
my ($out, $found,);
while (my $line = (<IN>)) {
if (! $found && ! $line =~ m/^\s*sub\s+$sub/) {

^-^
The binding might be closer than the =~ giving all but the sub.
Try if (! $found && !($line =~ m/^\s*sub\s+$sub/)) {,
typically, if (! $found && $line !~ m/^\s*sub\s+$sub/) {

next;
}
else {
$found = 1;

Need to get the last line before bailing out of the while(),
if that is what you wan't.
$out .= $line;

if ($line =~ m/^\s*}/) { last; }
# $out .= $line;
}
}
if (! $found) {
warn 'Unable to find subroutine: ' . $sub . "\n";
$out = 0;
}
close IN
|| warn "Unable to close input file in loadSub\n";
return ($out);
}
else {
warn "Unable to read file: $this_perl\n$!\n";
}
return (0);
}
sub example #-----------------------------------------------------------
{
my ($a, $b,);
foreach my $n (1..5) { $a++; $b += $a + $n; }
return ($b);
}

This line: if ($line =~ m/^\s*}/) { last; }
will not always get you what you appear to wan't.
I mean, if this is any more than casual, you would have
to do a balanced squigly for it to really parse, including
comment processing, etc..

Consider:

sub example1 {
my ( $x, $y );
$y += ++$x + $_ for 1 .. 5;
if ($y > 357) {
# ??
}
return $y;
}

sub example1 will return before the end of the sub is read.

Good luck!


sln

Thanks very much, appreciate the tips.

I will assume then that there is no better method than
reading in the script line by line then; just i had a
notion that Perl interpreter had already loaded the
script to memory and thought perhaps there was a way
to get at the subroutine bits through some other
mechanism.

All of the replies are very helpful and I am grateful for the responses.

Jason

 

[sln]

Thanks very much, appreciate the tips.

I will assume then that there is no better method than
reading in the script line by line then; just i had a
notion that Perl interpreter had already loaded the
script to memory and thought perhaps there was a way
to get at the subroutine bits through some other
mechanism.

All of the replies are very helpful and I am grateful for the responses.

Jason

Not sure what you mean by 'subroutine bits'. There is a way
to run dynamically generated code at runtime. And/or there is
a way to store references to subroutines (addresses) into an
array at runtime (the compiler will optimize static occurances
of references), then call them later. There is only compile-time
and run-time code. Interpeter may be a partial misnomer.

That you have created a dynamic array (run-time) means you
can join the elements into a string and pass it to the eval()
function.

If though, you just want to print out subroutines, I don't
(or never heard of) know an internal function that will print
those out. There may be, dunno. I would be suprised though.

sln

 

[Tad J McClellan]

if that is what you wan't.

if that is what you wa not?

 

[Tad J McClellan]

If though, you just want to print out subroutines, I don't
(or never heard of) know an internal function that will print
those out. There may be, dunno. I would be suprised though.

Surprise!

perl -MO=Deparse -e 'sub {print 1+2}'

 

[Tim Greer]

if that is what you wa not?

I saw a lady on TV, she was born without arms. That's sad, but then they
said, "Lola does not know the meaning of the word ``can't``." That, to
me, is even worse in a way. Not only is she missing arms, but she
doesn't understand simple contractions! It's easy, Lola - you just take
two words, put them together, take out the middle letters, put in a
comma, and you raise it up! -- Mitch Hedberg

 

[Peter J. Holzer]

if that is what you wa not?

[...]
doesn't understand simple contractions! It's easy, Lola - you just take
two words, put them together, take out the middle letters, put in a
comma, and you raise it up! -- Mitch Hedberg

hp