This question already has answers here:
How can I elegantly call a Perl subroutine whose name is held in a variable?
(12 answers)
Closed 6 years ago.
Let say I have one array that contains all subroutine name and I want to call all one by one.
foreach $sub (#arr){
print "Calling $sub\n";
#---How to call $sub?----
&$sub; ## will not work
}
Your code is correct in general, but you need to turn off strict 'refs' to make Perl allow you to use variable content as code refs.
use strict;
use warnings;
sub foo { print "foo" }
sub bar { print "bar" }
my #arr = qw/foo bar/;
foreach my $sub (#arr) {
no strict 'refs';
print "Calling $sub\n";
&$sub();
}
The output here is:
Calling foo
fooCalling bar
bar
I've also added parenthesis () after the call. That way we pass no arguments to %$sub. If we do not those, the #_ argument list of the current subroutine will be used.
However, you should probably not do this. Especially if #arr contains user input, this is a big problem. Your user can inject code. Consider this:
my #arr = qw/CORE::die/;
Now we get the following output:
Calling CORE::die
Died at /home/code/scratch.pl line 1492.
Oops. You don't want to do this. The die example is not very bad, but like this you could easily call code in some different package that wasn't intended.
It's probably better to make a dispatch table. There is a whole chapter about those in Higher Order Perl by Mark Jason Dominus, which you can download for free on his website.
It basically means you put all the subs into a hash as code references, and then call those in your loop. That way you can control which ones are allowed.
use strict;
use warnings;
sub baz { print "baz" }
my %dispatch = (
foo => sub { print "foo" },
bar => sub { print "bar" },
baz => \&baz,
);
my #arr = qw/foo bar baz wrong_entry/;
foreach my $sub ( #arr ) {
die "$sub is not allowed"
unless exists $dispatch{$sub};
$dispatch{$sub}->();
}
This outputs:
foobarbaz
wrong_entry is not allowed at /home/code/scratch.pl line 1494.
You want to do that using code references.
foreach my $sub (#arr)
{
$sub->();
}
where #arr contains scalars such as
my $rc = sub { print "Anonymous subroutine\n" };
or
sub func { print "Named sub\n" }
my $rc = \&func;
You can manipulate these scalars as you would any other, to form your array. However, it is more common and useful to use them as values in a hash, creating a dispatch table.
See perlref and perlsub, and (for example) this post and links in it for comments and details.
Related
I have code that repeats this pattern:
sub method1 {
my ($foo, $bar) = _get_things(); # this line...
}
sub method2 {
my ($foo, $bar) = _get_things(); # ...is repeated here
}
The repeated line is just one line, so in a sense repeating it is no big deal. But, that has the drawback that if the list ($foo, $bar) ever changes, all these lines need to change. In C, one might use the preprocessor to solve this problem. Is there a good idiom for doing it in Perl? Something like the following psuedo-perl:
MACRO_DEFINITION my ($foo, $bar) = _get_things();
sub method1 {
MACRO_CALL
print "hi $foo";
}
sub method2 {
MACRO_CALL
print "hi $foo and $bar";
}
note: the reason _get_things() returns a list that I am binding to local lexical scalars is that I want to use them in string interpolation, as the latter example shows.
When a sub has more than a very few parameters, or what the parameters are is possibly going to change, you should pass a hash or hashref to emulate named parameters.
All the more so here, where you are returning more than one result and what the results are is likely to change, you should return a hashref from the sub. And just use that hashref in the caller (yes, even in string interpolation.)
use strict;
use warnings;
sub method2 {
my $thing = _get_things();
print "hi $thing->{'foo'} and $thing->{'bar'}\n";
}
sub _get_things {
return {
'foo' => 42,
'bar' => 'quux',
};
}
method2();
I am trying to undestand OO in Perl. I made the following trivial class:
#/usr/bin/perl
package Tools::Util;
use strict;
use warnings;
my $var;
sub new {
my ($class, $arg) = #_;
my $small_class = {
var => $arg,
};
return bless $small_class;
}
sub print_object {
print "var = $var\n"; #this is line 20
}
1;
And this is a test script:
#!/usr/bin/perl
use strict;
use warnings;
use Tools::Util;
my $test_object = new Tools::Util("Some sentence");
$test_object->print_object();
use Data::Dumper;
print Dumper($test_object);
The result I get is:
Use of uninitialized value $var in concatenation (.) or string at Tools/Util.pm line 20.
var =
$VAR1 = bless( {
'var' => 'Some sentence'
}, 'Tools::Util' );
I can not understand this. I thought that objects in Perl are hashes and so I could access/initialize the member variables using the same names without a $. Why in this case the $var is not initialized but the hash that I Dump contains the value?
How should I use/initialize/handle member variables and what am I misunderstanding here?
$var is lexical class variable, and undefined in your example.
You probably want:
sub print_object {
my $self = shift;
print "var = $self->{var}\n";
}
Perl doesn't handle object methods in quite the same way that you're used to.
Are you familiar with the implicit this argument that many object-oriented languages use? If not, now would be a great time to read up on it.
Here's a five-second introduction that glosses over the details:
//pretend C++
//this function signature
MyClass::MyFunction(int x);
//is actually more like the following
MyClass::MyFunction(MyClass this, int x);
When you access instance members of the class, my_var is equivalent to this.my_var.
In Perl, you get to do this manually! The variable $var is not equivalent to $self->{var}.
Your blessed object is actually a hash reference, and can be accessed as such. When you call $test_object->print_object(), the sub gets the value of $test_object as its first argument. Most Perl programmers handle this like so:
sub my_method {
my $self = shift; #shift first argument off of #_
print $self->{field};
}
With that in mind, you should probably rewrite your print_object sub to match mpapec's answer.
Further reading: perlsub, perlobj
I'm maintaining old Perl code and need to enable strict pragma in all modules. I have a problem in passing a file handle as a reference between modules and subs. We have a common module responsible for opening the log file which is passed as typeglob reference. In other modules, the run function first calls open_log() from the common module, then it passes this file handle to other subs.
Here I've written a simple test to simulate the situation.
#!/usr/bin/perl -w
use strict;
$::STATUS_OK = 0;
$::STATUS_NOT_OK = 1;
sub print_header {
our $file_handle = #_;
print { $$file_handle } "#### HEADER ####"; # reference passing fails
}
sub print_text {
my ($file_handle, $text)= #_;
print_header(\$file_handle);
print { $$file_handle } $text;
}
sub open_file_handle {
my ($file_handle, $path, $name) = #_;
my $filename = $path."\\".$name;
unless ( open ($$file_handle, ">".$filename)) {
print STDERR "Failed to open file_handle $filename for writing.\n";
return $::STATUS_NOT_OK;
}
print STDERR "File $filename was opened for writing successfully.\n";
return $::STATUS_OK;
}
my $gpath = "C:\\Temp";
my $gname = "mylogfile.log";
my $gfile_handle;
if (open_file_handle(\$gfile_handle, $gpath, $gname) == $::STATUS_OK) {
my $text = "BIG SUCCESS!!!\n";
print_text(\$gfile_handle, $text);
print STDERR $text;
} else {
print STDERR "EPIC FAIL!!!!!!!!\n";
}
The Main function first calls open_file_handle and passes a file handle reference to the print_text function. If I comment out the row:
print_header(\$file_handle);
Everything works fine, but I need to pass the file handle reference to other functions from the print_text function, and this doesn't work.
I'm a Java developer and Perl's reference handling is not familiar to me. I don't want to change the open_log() sub to return a file handle (now it returns only status), since I have lots of modules and hundreds of code lines to go through to make this change in all places.
How can I fix my code to make it work?
There are two types of filehandles in Perl. Lexical and global bareword filehandles:
open my $fh, '>', '/path/to/file' or die $!;
open FILEHANDLE, '>', '/path/to/file' or die $!;
You are dealing with the first, which is good. The second one is global and should not be used.
The file handles you have are lexical, and they are stored in a scalar variable. It's called scalar because it has a dollar sign $. These can be passed as arguments to subs.
foo($fh);
They can also be referenced. In that case, you get a scalar reference.
my $ref = \$fh;
Usually you reference stuff if you hand it over to a function so Perl does not make a copy of the data. Think of a reference like a pointer in C. It's only the memory location of the data (structure). The piece of data itself remains where it is.
Now, in your code you have references to these scalars. You can tell because it is dereferenced in the print statement by saying $$fh.
sub print_text {
my ($file_handle, $text)= #_;
print_header(\$file_handle);
print { $$file_handle } $text;
}
So the $file_handle you get as a parameter (that's what the = #_ does) is actually a reference. You do not need to reference it again when you pass it to a function.
I guess you wrote the print_header yourself:
sub print_header {
our $file_handle = #_;
print { $$file_handle } "#### HEADER ####"; # reference passing fails
}
There are a few things here:
- our is for globals. Do not use that. Use my instead.
- Put parenthesis around the parameter assignment: my ($fh) = #_
- Since you pass over a reference to a reference to a scalar, you need to dereference twice: ${ ${ $file_handle } }
Of course the double-deref is weird. Get rid of it passing the variable $file_hanlde to print_header instead of a refence to it:
sub print_text {
my ($file_handle, $text)= #_;
print_header($file_handle); # <-- NO BACKSLASH HERE
print { $$file_handle } $text;
}
That is all you need to to make it work.
In general, I would get rid of all the references to the $file_handle vars here. You don't need them. The lexical filehandle is already a reference to an IO::Handle object, but don't concern yourself with that right now, it is not important. Just remember:
use filehandles that have a $ up front
pass them without references and you do not need to worry about \ and ${} and stuff like that
For more info, see perlref and perlreftut.
You are having difficulties because you added multiple extra level of references. Objects like lexical filehandles already are references.
If you have difficulties keeping track of what is a reference, you might want to use some kind of hungarian notation, like a _ref suffix.
In print_text, this would be:
sub print_text {
my ($file_handle_ref, $text)= #_;
print_header(\$file_handle_ref);
print { $$file_handle_ref } $text;
}
And in print_header:
sub print_header {
my ($file_handle_ref_ref) = #_; # don't use `our`, and assign to a lvalue list!
print { $$$file_handle_ref_ref } "#### HEADER ####"; # double derefernence … urgh
}
A far superior solution is to pass the filehandle around directly, without references.
sub print_header {
my ($file_handle) = #_;
print {$file_handle} "#### HEADER ####"; # no reference, no cry
}
sub print_text {
my ($file_handle, $text)= #_;
print_header($file_handle);
print {$file_handle} $text;
}
And in the main part:
my $gpath = "C:/Temp"; # forward slashes work too, as long as you are consistent
my $gname = "mylogfile.log";
if (open_file_handle(\my $gfile_handle, $gpath, $gname) == $::STATUS_OK) {
my $text = "BIG SUCCESS!!!\n";
print_text($gfile_handle, $text);
...
} else {
...
}
the reference operator is "\" (backslash)
anything includes arrays, hashes and even sub-routines can be referenced
the 5th line to count backwards
print_text(\$gfile_handle, $text);
you passed a referenced variable \$gfile_handle to the sub-routine print_text
sub print_text {
my ($file_handle, $text)= #_;
print_header(\$file_handle);
print { $$file_handle } $text;
}
and in this sub-routine, $file_handle is already a reference
then your referenced it again and pass it to the sub-routine print_header
so, you can solve this problem by putting off the reference operator the 5th line to count backwards like this:
print_text($gfile_handle, $text);
and try again :-)
I don't grok Perl subroutine attributes at all.
I have never seen them in actual code and perldoc perlsub and the perldoc attributes fail to answer my questions:
What are attributes useful for?
What do they bring to the table that is not already present in Perl best practices?
Are there any CPAN modules (well-known or otherwise) that make use of attributes?
It would be great if someone could put together a detailed example of attributes being used the way they should be.
For those who are as clueless as me, attributes are the parameters after the colon in the attributes SYNOPSIS examples below:
sub foo : method ;
my ($x,#y,%z) : Bent = 1;
my $s = sub : method { ... };
use attributes (); # optional, to get subroutine declarations
my #attrlist = attributes::get(\&foo);
use attributes 'get'; # import the attributes::get subroutine
my #attrlist = get \&foo;
Attributes allow you annotate variables to perform auto-magic behind the scenes. A similar concept is java annotations. Here is a small example that might help. It uses Attribute::Handlers to create the loud attributes.
use Attribute::Handlers;
sub UNIVERSAL::loud : ATTR(CODE) {
my ( $pkg, $sym, $code ) = #_;
no warnings 'redefine';
*{$sym} = sub {
return uc $code->(#_);
};
}
sub foo : loud {
return "this is $_[0]";
}
say foo("a spoon");
say foo("a fork");
Whenever a sub is declared with the loud attribute the UNIVERSAL::loud callback triggers exposing meta-information on the sub. I redefined the function to actually call an anonymous sub, which in turn calls the original sub and passes it to uc
This outputs:
THIS IS A SPOON
THIS IS A FORK
Now let's looks a the variable example from the SYNOPSIS:
my ($x,#y,%z) : Bent = 1;
Breaking this down into small perl statement without taking into account attributes we have
my $x : Bent
$x = 1;
my #y : Bent
#y = 1;
my %Z : Bent
%z = 1;
We can now see that each variable has been attributed the Bent annotation in a concise way, while also assigning all variables the value 1. Here is a perhaps more interesting example:
use Attribute::Handlers;
use Tie::Toggle;
sub UNIVERSAL::Toggle : ATTR(SCALAR) {
my ($package, $symbol, $referent, $attr, $data, $phase) = #_;
my #data = ref $data eq 'ARRAY' ? #$data : $data;
tie $$referent, 'Tie::Toggle', #data;
}
my $x : Toggle;
say "x is ", $x;
say "x is ", $x;
say "x is ", $x;
Which outputs:
x is
x is 1
x is
You can use this to do logging, create test annotations, add type details to variables, syntactic sugar, do moose-ish role composition and many other cool things.
Also see this question: How do Perl method attributes work?.
What are attributes useful for?
It is a way to pass some additional information (the attribute)
about a variable or subroutine.
You can catch this information (the attribute) as a string ( at COMPILE TIME !)
and handle it however you like. You can generate additional code,
modify stashs ... . It is up to you.
What do they bring to the table that is not already present in Perl best practices?
Sometimes it makes life easier. See example below.
Some people use it. Do a : find . -name *.p[ml] | xargs grep 'use attributes;'
at your perl installation path to look at packages using attributes.
Catalyst extensively uses attributes to handle requests based on the given path.
Example :
Say you like to execute subroutines in a certain order. And you want to tell the
subroutine when it has to execute ( by a run number RUNNR ). Using attributes
the implementation could be :
#!/usr/bin/env perl
use strict;
use warnings;
use Runner; # immplements the attribute handling
# some subroutines to be scheduled :
# attibutes automatically filling #$Runner::schedule
sub func_a : RUNNR(2) {return "You called func_a !"};
sub func_b : RUNNR(1) {return "You called func_b !"};
sub func_c : RUNNR(3) {return "You called func_c !"};
# run the subroutines according to the their RUNNR
sub run {
# #$Runner::schedule holds the subroutine refs according
# to their RUNNR
foreach my $func (#$Runner::schedule) {
if ( defined $func ) {
print "Running : $func --> ", $func->(), "\n";
}
}
}
print "Starting ...\n\n";
run();
print "\nDone !\n";
The attribute handling is in package Runner using the MODIFY_CODE_ATTRIBUTES
hook.
package Runner;
use strict;
use warnings;
use attributes;
BEGIN {
use Exporter ();
our (#ISA, #EXPORT);
#ISA = qw(Exporter);
#EXPORT = qw(&MODIFY_CODE_ATTRIBUTES); # needed for use attributes;
}
# we have subroutines with attributes : <type> is CODE in MODIFY_<type>_ATTRIBUTES
# MODIFY_CODE_ATTRIBUTES is executed at COMPILE TIME ! try perl -c <prog_name> to prove it :-)
sub MODIFY_CODE_ATTRIBUTES {
# for each subroutine of a package we get
# the code ref to it and the attribute(s) as string
my ($pckg, $code_ref, #attr) = #_;
# whatever you like to do with the attributes of the sub ... do it
foreach my $attr (#attr) {
# here we parse the attribute string(s), extract the number and
# save the code ref of the subroutine
# into $Runner::schedule array ref according to the given number
# that is how we 'compile' the RUNNR of subroutines into
# a schedule
if ( $attr =~ /^RUNNR\((\d+)\)$/ ) {
$Runner::schedule->[$1] = $code_ref;
}
}
return(); # ERROR if returning a non empty list
}
1;
The output will be :
Starting ...
Running : CODE(0x129c288) --> You called func_b !
Running : CODE(0x129c2b8) --> You called func_a !
Running : CODE(0x12ed460) --> You called func_c !
Done !
If you really want to understand what attributes do and when what happens you
have to 'perldoc attributes', read it step by step and play with it. The interface
is cumbersome but in principle you hook in at compile time and handle
the information provided.
You can use attributes to tie a variable upon creation. See the silly module Tie::Hash::Cannabinol which lets you do:
use Tie::Hash::Cannabinol;
my %hash;
tie %hash, 'Tie::Hash::Cannabinol';
## or ##
my %hash : Stoned;
Edit: upon deeper examination, T::H::C (hehe) uses Attribute::Handlers too (as JRideout's answer already suggests) so perhaps that is the place to look.
Here's an example that I ran on perl 5.26.1 with Carp::Assert. Perl attributes seem to generate nice syntax for decorator pattern. Was sort of a pain to implement MODIFY_CODE_ATTRIBUTES though b.c. of the damn eval and Perl's auto reference counting.
use strict;
use Carp::Assert;
# return true if `$func` is callable, false otherwise
sub callable {
my ($func) = #_;
return defined(&$func);
}
# get the symbol table hash (stash) and the inverse of it the
# coderef table hash (crtash) where coderefs are keys and symbols are
# values. The return value is a pair of hashrefs ($stash, $crtash)
sub get_stash_and_crtash {
my $stash = eval("\\%" . __PACKAGE__ . "::");
my %coderef_to_sym;
while (my ($k, $v) = each(%$stash)) {
$coderef_to_sym{$v} = $k if (callable($v));
}
return ($stash, \%coderef_to_sym);
}
# return an eval string that inserts `$inner` as the first argument
# passed into the function call string `$outer`. For example, if
# `$inner` is "$foo" (the lvalue NAME, not the lvalue itself), and
# `$outer` is "bar(1)", then the resulting eval string will be
# "bar($foo, 1)"
sub insert_context {
my ($inner, $outer) = #_;
my $args_pat = qr/\((.*)\)$/;
$outer .= '()' if ($outer !~ /\)$/);
$outer =~ /$args_pat/;
$1 ?
$outer =~ s/$args_pat/($inner, $1)/ :
$outer =~ s/$args_pat/($inner)/;
return $outer;
}
# hook that gets called when appending attributes to functions.
# `$cls` is the package at the point of function declaration/definition,
# `$ref` is the coderef to the function being declared/defined,
# `#attrs` is a list to the attributes being added. Attributes are function
# call strings.
sub MODIFY_CODE_ATTRIBUTES {
my ($cls, $ref, #attrs) = #_;
assert($cls eq 'main');
assert(ref($ref) eq 'CODE');
for (#attrs) {
assert(/^appender_d\(.*\)$/ || $_ eq 'upper_d');
}
my #non_decorators = grep { !/^\w+_d\b/ } #attrs;
return #non_decorators if (#non_decorators);
my ($stash, $crtash) = get_stash_and_crtash();
my $sym = $crtash->{$ref};
$stash->{$sym} = sub {
my $ref = $ref;
my $curr = '$ref';
for my $attr (#attrs) {
$curr = insert_context($curr, $attr);
}
eval("${curr}->()");
};
return ();
}
sub appender_d {
my ($func, $chars) = #_;
return sub { $func->() . $chars };
}
sub upper_d {
my ($func) = #_;
return sub { uc($func->()) };
}
sub foo : upper_d appender_d('!') {
return "foo";
}
sub main {
print(foo());
}
main();
I am doing pass-by-reference like this:
use strict;
use warnings;
sub repl {
local *line = \$_[0]; our $line;
$line = "new value";
}
sub doRepl {
my ($replFunc) = #_;
my $foo = "old value";
$replFunc->($foo);
print $foo; # prints "new value";
}
doRepl(\&repl);
Is there a cleaner way of doing it?
Prototypes don't work because I'm using a function reference (trust me that there's a good reason for using a function reference).
I also don't want to use $_[0] everywhere in repl because it's ugly.
Have you looked at Data::Alias? It lets you create lexically-scoped aliases with a clean syntax.
You can use it to create pass-by-reference semantics like this:
use strict;
use warnings;
use Data::Alias;
sub foo {
alias my ($arg) = #_;
$arg++;
}
my $count = 0;
foo($count);
print "$count\n";
The output is 1, indicating that the call to foo modified its argument.
There are a couple of ways to do this. Explicitly pass a scalar ref to $foo, or take advantage of Perl's built-in pass by reference semantics.
Explicit reference:
my $foo = "old value";
doRepl( \&repl, \$foo );
print $foo; # prints "new value";
sub repl {
my $line = shift;
$$line = "new value";
}
sub doRepl {
my ($replFunc, $foo) = #_;
$replFunc->($foo);
}
Pass by reference:
my $foo = "old value";
doRepl( \&repl, $foo );
print $foo; # prints "new value";
sub repl {
$_[0] = "new value";
}
sub doRepl {
my $replFunc = shift;
$replFunc->(#_);
}
Even fancier pass by reference:
my $foo = "old value";
doRepl( \&repl, $foo );
print $foo; # prints "new value";
sub repl {
$_[0] = "new value";
}
sub doRepl {
my $replFunc = shift;
&$replFunc;
}
The first one use normal perl hard references to do the job.
The first pass by ref method uses the fact that Perl passes arguments to all functions as references. The elements of #_ are actually aliases to the values in the argument list when the subroutine is called. By altering $_[0] in foo(), you actually alter the first argument to foo().
The second pass by ref method use the fact that a sub called with an & sigil and no parens gets the #_ array of its caller. Otherwise it is identical.
Update: I just noticed you desire to avoid $_[0]. You can do this in repl if you want:
sub repl {
for my $line( $_[0] ) {
$line = 'new value';
}
}
sub repl {
my $line = \$_[0]; # or: my $line = \shift
$$line = "new value";
}
I don't think there is anything wrong with using local to create the alias in this case.
Dynamic scope is of course a powerful feature, but so long as you are aware of the side effects (new value is visible in functions called from its scope, if a lexical of the same name is in scope, it can't be localized, ...) then it is a useful addition to the already overflowing Perl toolbox.
The main reason for the warnings in the Perl docs about local are to keep people from inadvertently using it instead of my and to ease the transition from perl4. But there are definitely times when local is useful, and this is one.
Using for to create your alias is also an option, but I find the explicit syntax with local clearer in its intent. It is also a bit faster if performance is a concern.