How do I call a sub returned by reference by a Perl closure? - perl

I'm trying to make subroutine closure working like an object.
However, I cannot call the returned subs references properly.
I receive Not a CODE reference at .\closure.pl line 22. error.
#!/usr/bin/perl
use strict;
use warnings;
sub number {
my ($value) = #_;
my $val = sub { $value };
my $inc = sub { ++$value };
my $dec = sub { --$value };
my %api = (
'val' => \$val,
'inc' => \$inc,
'dec' => \$dec,
);
return %api;
}
my %numb = number(42);
$numb{'inc'}->();
print $numb{'val'}->();
How to fix the code?
Code fixed
Yes, of course, an anonymous definition must return a reference. it means that it can be put directly in the %api. Perl doesn't complain and works like a charm :)
#!/usr/bin/perl
use strict;
use warnings;
sub number {
my ($value) = #_;
my %api = (
'val' => sub { $value },
'inc' => sub { ++$value },
'dec' => sub { --$value },
);
return \%api;
}
my $m = number(14);
my $n = number(41);
$m->{'dec'}->();
$n->{'inc'}->();
print $m->{'val'}->() . "\n"; # -> 13
print $n->{'val'}->() . "\n"; # -> 42

As discussed in perlref, the sub keyword without a name creates an anonymous subroutine and returns a reference to it. So you don't need to create another level of reference using the backslash; just pass the reference you already have as the value in the hash.

Related

Automatically call hash values that are subroutine references

I have a hash with a few values that are not scalar data but rather anonymous subroutines that return scalar data. I want to make this completely transparent to the part of the code that looks up values in the hash, so that it doesn't have to be aware that some of the hash values may be anonymous subroutines that return scalar data rather than just plain old scalar data.
To that effect, is there any way to have the anonymous subroutines executed when their keys are accessed, without using any special syntax? Here's a simplified example that illustrates the goal and the problem:
#!/usr/bin/perl
my %hash = (
key1 => "value1",
key2 => sub {
return "value2"; # In the real code, this value can differ
},
);
foreach my $key (sort keys %hash) {
print $hash{$key} . "\n";
}
The output I would like is:
perl ./test.pl
value1
value2
Instead, this is what I get:
perl ./test.pl
value1
CODE(0x7fb30282cfe0)
As noted by Oleg, it's possible to do this using various more or less arcane tricks like tie, overloading or magic variables. However, this would be both needlessly complicated and pointlessly obfuscated. As cool as such tricks are, using them in real code would be a mistake at least 99% of the time.
In practice, the simplest and cleanest solution is probably to write a helper subroutine that takes a scalar and, if it's a code reference, executes it and returns the result:
sub evaluate {
my $val = shift;
return $val->() if ref($val) eq 'CODE';
return $val; # otherwise
}
and use it like this:
foreach my $key (sort keys %hash) {
print evaluate($hash{$key}) . "\n";
}
I don't believe that the words that others have written in disapproval of the tie mechanism are warranted. None of the authors seem to properly understand how it works and what core library backup is available
Here's a tie example based on Tie::StdHash
If you tie a hash to the Tie::StdHash class then it works exactly as a normal hash. That means there's nothing left to write except for methods that you may want to override
In this case I've overridden TIEHASH so that I could specify the initialisation list in the same statement as the tie command, and FETCH, which calls the superclass's FETCH and then makes a call to it if it happens to be a subroutine reference
Your tied hash will work as normal except for the change that you have asked for. I hope it is obvious that there is no longer a direct way to retrieve a subroutine reference if you have stored it as a hash value. Such a value will always be replaced by the result of calling it without any parameters
SpecialHash.pm
package SpecialHash;
use Tie::Hash;
use base 'Tie::StdHash';
sub TIEHASH {
my $class = shift;
bless { #_ }, $class;
}
sub FETCH {
my $self = shift;
my $val = $self->SUPER::FETCH(#_);
ref $val eq 'CODE' ? $val->() : $val;
}
1;
main.pl
use strict;
use warnings 'all';
use SpecialHash;
tie my %hash, SpecialHash => (
key1 => "value1",
key2 => sub {
return "value2"; # In the real code, this value can differ
},
);
print "$hash{$_}\n" for sort keys %hash;
output
value1
value2
Update
It sounds like your real situation is with an existing hash that looks something like this
my %hash = (
a => {
key_a1 => 'value_a1',
key_a2 => sub { 'value_a2' },
},
b => {
key_b1 => sub { 'value_b1' },
key_b2 => 'value_b2',
},
);
Using tie on already-populated variables isn't so neat as tying then at the point of declaration and then inserting the values as the data must be copied to the tied object. However the way I have written the TIEHASH method in the SpecialHash class makes this simple to do in the tie statement
If possible, it would be much better to tie each hash before you put data into it and add it to the primary hash
This program ties every value of %hash that happens to be a hash reference. The core of this is the statement
tie %$val, SpecialHash => ( %$val )
which functions identically to
tie my %hash, SpecialHash => ( ... )
in the previous code but dereferences $val to make the syntax valid, and also uses the current contents of the hash as the initialisation data for the tied hash. That is how the data gets copied
After that there is just a couple of nested loops that dump the whole of %hash to verify that the ties are working
use strict;
use warnings 'all';
use SpecialHash;
my %hash = (
a => {
key_a1 => 'value_a1',
key_a2 => sub { 'value_a2' },
},
b => {
key_b1 => sub { 'value_b1' },
key_b2 => 'value_b2',
},
);
# Tie all the secondary hashes that are hash references
#
for my $val ( values %hash ) {
tie %$val, SpecialHash => ( %$val ) if ref $val eq 'HASH';
}
# Dump all the elements of the second-level hashes
#
for my $k ( sort keys %hash ) {
my $v = $hash{$k};
next unless ref $v eq 'HASH';
print "$k =>\n";
for my $kk ( sort keys %$v ) {
my $vv = $v->{$kk};
print " $kk => $v->{$kk}\n"
}
}
output
a =>
key_a1 => value_a1
key_a2 => value_a2
b =>
key_b1 => value_b1
key_b2 => value_b2
There's a feature called "magic" that allows code to be called when variables are accessed.
Adding magic to a variable greatly slows down access to that variable, but some are more expensive than others.
There's no need to make access to every element of the hash magical, just some values.
tie is an more expensive form of magic, and it's not needed here.
As such, the most efficient solution is the following:
use Time::HiRes qw( time );
use Variable::Magic qw( cast wizard );
{
my $wiz = wizard(
data => sub { my $code = $_[1]; $code },
get => sub { ${ $_[0] } = $_[1]->(); },
);
sub make_evaluator { cast($_[0], $wiz, $_[1]) }
}
my %hash;
$hash{key1} = 'value1';
make_evaluator($hash{key2}, sub { 'value2#'.time });
print("$hash{$_}\n") for qw( key1 key2 key2 );
Output:
value1
value2#1462548850.76715
value2#1462548850.76721
Other examples:
my %hash; make_evaluator($hash{key}, sub { ... });
my $hash; make_evaluator($hash->{$key}, sub { ... });
my $x; make_evaluator($x, sub { ... });
make_evaluator(my $x, sub { ... });
make_evaluator(..., sub { ... });
make_evaluator(..., \&some_sub);
You can also "fix up" an existing hash. In your hash-of-hashes scenario,
my $hoh = {
{
key1 => 'value1',
key2 => sub { ... },
...
},
...
);
for my $h (values(%$hoh)) {
for my $v (values(%$h)) {
if (ref($v) eq 'CODE') {
make_evaluator($v, $v);
}
}
}
Yes you can. You can either tie hash to implementation that will resolve coderefs to their return values or you can use blessed scalars as values with overloaded mehods for stringification, numification and whatever else context you want to resolve automatically.
One of perl's special features for just such a use case is tie. This allows you to attach object oriented style methods, to a scalar or hash.
It should be used with caution, because it can mean that your code is doing really strange things, in unexpected ways.
But as an example:
#!/usr/bin/env perl
package RandomScalar;
my $random_range = 10;
sub TIESCALAR {
my ( $class, $range ) = #_;
my $value = 0;
bless \$value, $class;
}
sub FETCH {
my ($self) = #_;
return rand($random_range);
}
sub STORE {
my ( $self, $range ) = #_;
$random_range = $range;
}
package main;
use strict;
use warnings;
tie my $random_var, 'RandomScalar', 5;
for ( 1 .. 10 ) {
print $random_var, "\n";
}
$random_var = 100;
for ( 1 .. 10 ) {
print $random_var, "\n";
}
As you can see - this lets you take an 'ordinary' scalar, and do fruity things with it. You can use a very similar mechanism with a hash - an example might be to do database lookups.
However, you also need to be quite cautious - because you're creating action at a distance by doing so. Future maintenance programmers might well not expect your $random_var to actually change each time you run it, and a value assignment to not actually 'set'.
It can be really useful for e.g. testing though, which is why I give an example.
In your example - you could potentially 'tie' the hash:
#!/usr/bin/env perl
package MagicHash;
sub TIEHASH {
my ($class) = #_;
my $self = {};
return bless $self, $class;
}
sub FETCH {
my ( $self, $key ) = #_;
if ( ref( $self->{$key} ) eq 'CODE' ) {
return $self->{$key}->();
}
else {
return $self->{$key};
}
}
sub STORE {
my ( $self, $key, $value ) = #_;
$self->{$key} = $value;
}
sub CLEAR {
my ($self) = #_;
$self = {};
}
sub FIRSTKEY {
my ($self) = #_;
my $null = keys %$self; #reset iterator
return each %$self;
}
sub NEXTKEY {
my ($self) = #_;
return each %$self;
}
package main;
use strict;
use warnings;
use Data::Dumper;
tie my %magic_hash, 'MagicHash';
%magic_hash = (
key1 => 2,
key2 => sub { return "beefcake" },
);
$magic_hash{random} = sub { return rand 10 };
foreach my $key ( keys %magic_hash ) {
print "$key => $magic_hash{$key}\n";
}
foreach my $key ( keys %magic_hash ) {
print "$key => $magic_hash{$key}\n";
}
foreach my $key ( keys %magic_hash ) {
print "$key => $magic_hash{$key}\n";
}
This is slightly less evil, because future maintenance programmers can use your 'hash' normally. But dynamic eval can shoot the unwary in the foot, so still - caution is advised.
And alternative is to do it 'proper' object oriented - create a 'storage object' that's ... basically like the above - only it creates an object, rather than using tie. This should be much clearer for long term usage, because you won't get unexpected behaviour. (It's an object doing magic, which is normal, not a hash that 'works funny').
You need to identify when a code ref is present, then execute it as an actual call:
foreach my $key (sort keys %hash) {
if (ref $hash{$key} eq 'CODE'){
print $hash{$key}->() . "\n";
}
else {
print "$hash{$key}\n";
}
}
Note that you may consider making all of the hash values subs (a true dispatch table) instead of having some that return non-coderefs and some that return refs.
However, if you define the hash as such, you don't have to do any special trickery when it comes time to use the hash. It calls the sub and returns the value directly when the key is looked up.
key2 => sub {
return "value2";
}->(),
No, not without some ancillary code. You are asking for a simple scalar value and a code reference to behave in the same way. The code that would do that is far from simple and also injects complexity between your hash and its use. You might find the following approach simpler and cleaner.
You can make all values code references, making the hash a dispatch table, for uniform invocation
my %hash = (
key1 => sub { return "value1" },
key2 => sub {
# carry on some processing ...
return "value2"; # In the real code, this value can differ
},
);
print $hash{$_}->() . "\n" for sort keys %hash;
But of course there is a minimal overhead to this approach.

Perl - Changing a parent reference that is passed into a sub

I am new to perl and couldn't find any info on my problem, so apologies in advance if this is a duplicate or I am completely out to lunch.
Actual question a little lower.
#!/usr/bin/perl
use strict;
my #root = undef;
myfunc(\#root);
sub myfunc()
{
my ($ptr_parent) = #_;
print "root => ";
print \#root;
print "\n";
print "ptr_parent => $ptr_parent\n";
my #stuff = split(',', 'test1,test2,test3');
$ptr_parent = \#stuff;
print "stuff => ";
print \#stuff;
print "\n";
print "root => ";
print \#root;
print "\n";
print "ptr_parent => $ptr_parent\n";
}
Not surprisingly my output is as follows:
root => ARRAY(0x7f903182e890)
ptr_parent => ARRAY(0x7f903182e890)
stuff => ARRAY(0x7f9031838548)
root => ARRAY(0x7f903182e890)
ptr_parent => ARRAY(0x7f9031838548)
What I am trying to achieve is the following:
root => ARRAY(0x7f903182e890)
ptr_parent => ARRAY(0x7f903182e890)
stuff => ARRAY(0x7f9031838548)
root => ARRAY(0x7f9031838548) <---- Note this changes.
ptr_parent => ARRAY(0x7f9031838548)
So I have a suspicion that this is impossible to do like this because of scoping as I would imagine that the #stuff memory pointer gets released.
I feel like I could make #root a $root where it is a pointer to a pointer. But I am stuck on how to write this. The syntax for pointers is still not 100% in my head.
But the general requirement is that whatever list is generated in myfunc would need to survive in #root. And I cannot modify #root directly from myfunc();
Thanks in advance. Let me know if I need to clarify.
In your code, $ptr_parent is a variable that holds a reference, and you are modifying the variable, not the referent. You need to use some dereference syntax if you want to modify the actual thing the reference points to. See perlreftut for an introduction and perlref for all the gory details.
use strict;
use warnings;
use Data::Dump;
my #arr;
dd(\#arr);
foo(\#arr);
dd(\#arr);
bar(\#arr);
dd(\#arr);
sub foo {
my $aref = shift;
#$aref = split(/,/, 'test1,test2,test3'); # notice the dereference
}
sub bar {
my $aref = shift;
$aref->[0] = 42; # individual element dereference
$aref->[1] = 'ponies';
}
Output:
[]
["test1", "test2", "test3"]
[42, "ponies", "test3"]
Perl passes by reference, which means that changing the argument in the sub will change it in the caller too. But you're not modifying the argument ($_[0]); you're modifying a lexical variable ($ptr_parent).
All of the following will work with myfunc($root):
# Create the object as needed, and pass it back explicitly on exit.
sub myfunc {
my $parent = $_[0] // [];
push #$parent, split(/,/, 'test1,test2,test3');
$_[0] = $parent;
}
# Create the object, and pass it back explicitly up front.
sub myfunc {
my $parent = shift //= [];
push #$parent, split(/,/, 'test1,test2,test3');
}
# Create the object as needed by using a layer of indirection.
sub myfunc {
my $parent_ref = \shift;
push #{ $$parent_ref }, split(/,/, 'test1,test2,test3');
}
Or you could be less "magical" and pass a reference to myfunc (myfunc(\$root)):
sub myfunc {
my $parent_ref = shift;
push #{ $$parent_ref }, split(/,/, 'test1,test2,test3');
}
By the way, the prototype was incorrect. I fixed this issue by removing it.
Indeed, you need to use a reference, and pass a reference to that reference if you want to modify it from a different place.
#!/usr/bin/perl
use strict;
my $root = [];
myfunc(\$root);
sub myfunc()
{
my ($ptr_parent) = #_;
print "root => ";
print $root;
print "\n";
print "ptr_parent => $$ptr_parent\n";
my #stuff = split(',', 'test1,test2,test3');
$$ptr_parent = \#stuff;
print "stuff => ";
print \#stuff;
print "\n";
print "root => ";
print $root;
print "\n";
print "ptr_parent => $$ptr_parent\n";
}
Output:
root => ARRAY(0x7f8143001ee8)
ptr_parent => ARRAY(0x7f8143001ee8)
stuff => ARRAY(0x7f8143022ad8)
root => ARRAY(0x7f8143022ad8)
ptr_parent => ARRAY(0x7f8143022ad8)

How can I pass a module's function as a reference to another module in Perl?

How can I pass a reference to a module's function as parameter in a function call of another module?
I tried the following (simple example):
This is the module that has a function (process_staff) that takes as a parameter a function reference (is_ok).
#!/usr/bin/perl
use strict;
use warnings;
package Objs::Processing;
sub new {
my ($class) = #_;
bless {} ;
}
sub process_staff {
my ($employee, $func) = #_;
if($func->is_ok($employee)) {
print "Is ok to process\n";
}
else {
print "Not ok to process\n";
}
}
1;
This is the module that implements the passed function (is_ok)
#!usr/bin/perl
use strict;
use warnings;
package Objs::Employee;
my $started;
sub new {
my ($class) = #_;
my $cur_time = localtime;
my $self = {
started => $cur_time,
};
print "Time: $cur_time \n";
bless $self;
}
sub get_started {
my ($class) = #_;
return $class->{started};
}
sub set_started {
my ($class, $value) = #_;
$class->{started} = $value;
}
sub is_ok {
my ($emp) = #_;
print "In is ok I received:\n";
use Data::Dumper;
print Dumper($emp);
return 1;
}
This is my test script that I run:
#!/usr/bin/perl
use strict;
use warnings;
use Objs::Manager;
use Objs::Processing;
my $emp = Objs::Manager->new('John Smith');
use Data::Dumper;
print Dumper($emp);
my $processor = Objs::Processing->new();
$processor->process_staff(\&$emp->is_ok); #error is here
I get a:
Not a CODE reference at testScript.pl line 14.
I also tried: $processor->process_staff(\&$emp->is_ok()); but also still does not work.
What am I doing wrong here
You appear to want to pass an object and a method to call on it; the easiest way to do that would be:
$processor->process_staff( sub { $emp->is_ok } );
where process_staff looks like:
sub process_staff {
my ($self, $func) = #_;
if ( $func->() ) {
...
or you can pass the reference and the object separately:
sub process_staff {
my ($self, $emp, $method) = #_;
if ( $emp->$method() ) {
...
$processor->process_staff( $emp, $emp->can('is_ok') );
I think this could work with:
$processor->process_staff(\&Objs::Employee::is_ok);
where you pass in the method ref.
and where you currently have
if( $func->is_ok($employee) ) {
you need
if( $func->( $employee ) ) {
This is because you cannot reference named methods simply from an object, by the syntax \&$obj->method.
However, in your example code it is not at all clear why you don't do this instead:
if( $employee->is_ok() ) {
in which case you would not need to reference the method to call in process_staff at all. There are also other ways to achieve the same method indirection that might give you better encapsulation in future.
In this expression:
$processor->process_staff(\&$emp->is_ok);
You are saying "call the method $emp->is_ok, take the return value, treat it as a CODE reference, dereference it, and return a reference to that. That doesn't work, since the return value from that sub is not a CODE reference.
To do what you want, you can use a reference to an anonymous sub to wrap the call to your object method:
$processor->process_staff( sub { $emp->is_ok } );
You can pass anonymous coderef which returns result from desired method,
$processor->process_staff(sub{ $emp->is_ok(#_) });
#_ can be dropped as is_ok method doesn't take any arguments.
It's not specifically what you asked for, but I think you simply need the following:
sub process_staff {
my ($self, $emp) = #_;
if ($emp->is_ok()) {
print "Is ok to process\n";
}
else {
print "Not ok to process\n";
}
}
$processor->process_staff($emp);

How do you create a callback function (dispatch table) in Perl using hashes?

I want to call a main controller function that dispatches other function dynamically, something like this:
package Controller;
my %callback_funcs = ();
sub register_callback{
my ($class,$callback,$options) = _#;
#apppend to %callback_funcs hash ... ?
}
sub main{
%callback_funcs = ( add => 'add_func', rem => 'remove_func', edit => 'edit_func');
while(<STDIN>){
last if ($_ =~ /^\s*$/);
if($_ == 'add' || _$ == 'rem' || _$ == 'edit'){
$result = ${callback_funcs['add']['func']}(callback_funcs['add']['options']);
}
}
}
sub add_func{
...
}
One caveat is that the subs are defined in other Modules, so the callbacks would have to be able to reference them... plus
I'm having a hard time getting the hashes right!
So, it's possible to have a hash that contains anonymous subroutines that you can invoke from stdin.
my %callbacks = (
add => sub {
# do stuff
},
fuzzerbligh => sub {
# other stuff
},
);
And you can insert more hashvalues into the hash:
$callbacks{next} = sub {
...
};
And you would invoke one like this
$callbacks{next}->(#args);
Or
my $coderef = $callbacks{next};
$coderef->(#args);
You can get the hashkey from STDIN, or anywhere else.
You can also define them nonymously and then take a reference to them.
sub delete {
# regular sub definition
}
$callbacks{delete} = \&delete;
I wouldn't call these callbacks, however. Callbacks are subs that get called after another subroutine has returned.
Your code is also rife with syntax errors which may be obscuring the deeper issues here. It's also not clear to me what you're trying to do with the second level of arrays. When are you defining these subs, and who is using them when, and for what?
Perhaps this simplified example will help:
# Very important.
use strict;
use warnings;
# Define some functions.
sub multiply { $_[0] * $_[1] }
sub divide { $_[0] / $_[1] }
sub add { $_[0] + $_[1] }
sub subtract { $_[0] - $_[1] }
# Create a hash of references to those functions (dispatch table).
my %funcs = (
multiply => \&multiply,
divide => \&divide,
add => \&add,
subtract => \&subtract,
);
# Register some more functions.
sub register {
my ($key, $func) = #_;
$funcs{$key} = $func;
}
register('+', \&add); # As above.
register('sum', sub { # Or using an anonymous subroutine.
my $s = 0;
$s += $_ for #_;
return $s;
});
# Invoke them dynamically.
while (<>){
my ($op, #args) = split;
last unless $op and exists $funcs{$op}; # No need for equality tests.
print $funcs{$op}->(#args), "\n";
}
You've already got some good answers on how to build a dispatch table and call functions through it within a single file, but you also keep talking about wanting the functions to be defined in other modules. If that's the case, then wouldn't it be better to build the dispatch table dynamically based on what dispatchable functions each module says it has rather than having to worry about keeping it up to date manually? Of course it would!
Demonstrating this requires multiple files, of course, and I'm using Module::Pluggable from CPAN to find the modules which provide the function definitions.
dispatch_core.pl:
#!/usr/bin/env perl
use strict;
use warnings;
my %dispatch;
use lib '.'; # a demo is easier if I can put modules in the same directory
use Module::Pluggable require => 1, search_path => 'DTable';
for my $plugin (plugins) {
%dispatch = (%dispatch, $plugin->dispatchable);
}
for my $func (sort keys %dispatch) {
print "$func:\n";
$dispatch{$func}->(2, 5);
}
DTable/Add.pm:
package DTable::Add;
use strict;
use warnings;
sub dispatchable {
return (add => \&add);
}
sub add {
my ($num1, $num2) = #_;
print "$num1 + $num2 = ", $num1 + $num2, "\n";
}
1;
DTable/MultDiv.pm:
package DTable::MultDiv;
use strict;
use warnings;
sub dispatchable {
return (multiply => \&multiply, divide => \&divide);
}
sub multiply {
my ($num1, $num2) = #_;
print "$num1 * $num2 = ", $num1 * $num2, "\n";
}
sub divide {
my ($num1, $num2) = #_;
print "$num1 / $num2 = ", $num1 / $num2, "\n";
}
1;
Then, on the command line:
$ ./dispatch_core.pl
add:
2 + 5 = 7
divide:
2 / 5 = 0.4
multiply:
2 * 5 = 10
Adding new functions is now as simple as dropping a new file into the DTable directory with an appropriate dispatchable sub. No need to ever touch dispatch_core.pl just to add a new function again.
Edit: In response to the comment's question about whether this can be done without Module::Pluggable, here's a modified dispatch_core.pl which doesn't use any external modules other than the ones defining the dispatchable functions:
#!/usr/bin/env perl
use strict;
use warnings;
my %dispatch;
my #dtable = qw(
DTable::Add
DTable::MultDiv
);
use lib '.';
for my $plugin (#dtable) {
eval "use $plugin";
%dispatch = (%dispatch, $plugin->dispatchable);
}
for my $func (sort keys %dispatch) {
print "$func:\n";
$dispatch{$func}->(2, 5);
}

How can I loop through a list of functions in Perl?

I have a list of functions in Perl. Example:
my #funcs = qw (a b c)
Now they all belong to this module Foo::Bar::Stix. I would like to call them iteratively in a loop:
foreach $func (#funcs) {
Foo::Bar::Stix::$func->(%args)
}
where args is a hash of arguments. However I keep getting this error: "Bad name after :: ..." at the line which contains Foo::Bar::Stix::$func->(%args) How do I fix this error?
a b and c are not function objects but strings
Rather than storing the names of the functions in your array, store references to them in a hash so that you can refer to them by name. Here's a simple code example:
#!/usr/bin/perl
use strict;
use warnings;
my %func_refs = (
'a' => \&Foo::Bar::Stix::a,
'b' => \&Foo::Bar::Stix::b,
'c' => \&Foo::Bar::Stix::c
);
foreach my $func_ref ( values %func_refs ) {
print $func_ref->( "woohoo: " ), "\n";
}
{
package Foo::Bar::Stix;
sub a {
my $arg = shift;
return $arg . "a";
}
sub b {
my $arg = shift;
return $arg . "b";
}
sub c {
my $arg = shift;
return $arg . "c";
}
}
If you're stuck with storing the names for some reason, try this:
my $package = "Foo::Bar::Stix";
my #func_names = qw/ a b c /;
foreach my $func_name (#func_names) {
my $str = &{ "$package\::$func_name" }( "woohoo: " );
print $str, "\n";
}
However, this doesn't work under use strict, and because of this I prefer the first solution. Whatever you do, try to avoid using eval. It's unnecessary, and will likely only cause you problems.
Also, most people who work with Perl capitalize it as Perl rather than PERL. Here's a Stackoverflow question on the subject:
How should I capitalize Perl?
Bad answer: use a symbolic reference:
for $func (#funcs) {
&{"Foo::Bar::Stix::$func"}(\%args);
}
Good answer: use a dispatch table:
my %call_func = (
'a' => \&Foo::Bar::Stix::a,
'b' => \&Foo::Bar::Stix::b,
'c' => \&Foo::Bar::Stix::c,
);
...
for $func (#funcs) {
$call_func{$func}->(\%args);
}
Slight change of syntax will give you what you want
Foo::Bar::Stix->$func(%args)
Though this will pass the package name as the first parameter.
You can use can
my #funcs = qw (a b c)
foreach $func (#funcs) {
Foo::Bar::Stix->can($func)->(%args)
}
You could access it through the special %Foo::Bar::Stix:: variable. This gives full access directly to the symbol table. You'll also notice that it works under strict mode.
#! /usr/bin/env perl
use strict;
use warnings;
{
package Foo::Bar::Stix;
sub a{ print "sub a\n" }
sub b{ print "sub b\n" }
sub c{ print "sub c\n" }
}
my #funcs = qw' a b c ';
my %args;
for my $func (#funcs) {
$Foo::Bar::Stix::{$func}->(%args); # <====
}
Another option:
my $symbol_table = $::{'Foo::'}{'Bar::'}{'Stix::'};
my %funcs = (
# we only want the CODE references
'a' => *{ $symbol_table->{'a'} }{'CODE'},
'b' => *{ $symbol_table->{'b'} }{'CODE'},
'c' => *{ $symbol_table->{'c'} }{'CODE'},
);
for my $func (#funcs) {
$funcs{$func}->(%args); # <====
}
If you are going to be doing that for a large number of subroutines, this is how I would load up the %funcs variable.
my %funcs;
BEGIN{
my $symbol_table = $::{'Foo::'}{'Bar::'}{'Stix::'};
for my $name (qw' a b c '){
$funcs{$name} = *{ $symbol_table->{$name} }{'CODE'};
}
}
I wouldn't do this unless you need the subroutines to have both a fully qualified name, and access to it through a hash variable.
If you only need access to the subroutines through a hash variable this is a better way to set it up.
my %funcs = (
'a' => sub{ print "sub a\n" },
'b' => sub{ print "sub b\n" },
'c' => sub{ print "sub c\n" },
);
Note: you could replace "my %funcs" with "our %funcs"