I have a hash table of methods:
my %makefileMacroSimplifiers = (
"or" => \&makefileSimplifyOr,
"and" => \&makefileSimplifyAnd,
"strip" => \&makefileSimplifyStrip,
);
sub makefileSimplifyStrip {
my $self = shift;
my $prefix = shift;
my $paramsRef = shift;
...
}
where each method requires $self. What I have is:
$makefileMacroSimplifiers{$macroName}->($self, $macroName.$ws1, \#parms);
This seems to work, but it seems a bit odd to me to explicitly pass in $self to a method. Is there a better way of doing this, or is this considered a normal coding practice? (I didn't find any better ways to do this on the web, but I thought I would ask in case I'm not using the right search criteria).
You can also call a code ref on an object. That way the thing on the left will be passed in.
my $coderef = sub { ... };
$self->$coderef(#args);
Using a hash element does not work like this.
$self->$dispatch{foo}(1, 2, 3); # BOOM
This is a syntax error. So you need to grab the code reference first. Borodin also explains this above in their comment.
my %dispatch = (
foo => sub { print "#_" },
);
require HTTP::Request;
my $obj = HTTP::Request->new;
my $method = $dispatch{foo};
$obj->$method(1, 2, 3);
I've used HTTP::Request here as an example of an arbitrary class/object.
Related
I need to transform data structures from a list of arrays into a tree-like one. I know the depth of the tree before I start processing the data, but I want to keep things flexible so I can re-use the code.
So I landed upon the idea of generating a subref on the fly (from within a Moose-based module) to go from array to tree. Like this (in a simplified way):
use Data::Dump qw/dump/;
sub create_tree_builder {
my $depth = shift;
return eval join '', 'sub { $_[0]->{$_[',
join(']}->{$_[', (1..$depth)),
']} = $_[', $depth + 1 , '] }';
}
my $s = create_tree_builder(5);
my $tree = {};
$s->($tree, qw/one two three four five/, 'a value');
print dump $tree;
# prints
# {
# one => { two => { three => { four => { five => "a value" } } } },
# }
This opened up worlds to me, and I'm finding cool uses for this process of eval-in a parametrically generated string into a function all over the place (clearly, a solution in search of problems).
However, it feels a little too good to be true, almost.
Any advice against this practice? Or suggestion for improvements?
I can see clearly that eval-ing arbitrary input might not be the safest thing, but what else?
Follow up
Thanks for all the answers. I used amon's code and benchmarked a bit, like this:
use Benchmark qw(:all) ;
$\ = "\n";
sub create_tree_builder {
my $depth = shift;
return eval join '', 'sub { $_[0]->{$_[',
join(']}->{$_[', (1..$depth)),
']} = $_[', $depth + 1 , '] }';
}
my $s = create_tree_builder(5);
$t = sub {
$_[0] //= {};
my ($tree, #keys) = #_;
my $value = pop #keys;
$tree = $tree->{shift #keys} //= {} while #keys > 1;
$tree->{$keys[0]} = $value;
};
cmpthese(900000, {
'eval' => sub { $s->($tree, qw/one two three four five/, 'a value') },
'build' => sub { $t->($tree, qw/one two three four five/, 'a value') },
});
The results are clearly in favour of building the tree, not of the eval'ed factory:
Rate build eval
build 326087/s -- -79%
eval 1525424/s 368% --
I'll admit I could have done that before. I'll try with more random trees (rather than assigning the same element over and over) but I see no reason that the results should be different.
Thanks a lot for the help.
It is very easy to write a generalized subroutine to build such a nested hash. It is much simpler that way than writing a factory that will produce such a subroutine for a specific number of hash levels.
use strict;
use warnings;
sub tree_assign {
# Create an empty tree if one was not given, using an alias to the original argument
$_[0] //= {};
my ($tree, #keys) = #_;
my $value = pop #keys;
$tree = $tree->{shift #keys} //= {} while #keys > 1;
$tree->{$keys[0]} = $value;
}
tree_assign(my $tree, qw/one two three four five/, 'a value');
use Data::Dump;
dd $tree;
output
{
one => { two => { three => { four => { five => "a value" } } } },
}
Why this might be a bad idea
Maintainability.
Code that is eval'd has to be eval'd inside the programmers head first– not always an easy task. Essentially, evaling is obfuscation.
Speed.
eval re-runs the perl parser and compiler, before normal execution resumes. However, the same technique can be used to gain start-up time by deferring compilation of subroutines until they are needed. This is not such a case.
There is more than one way to do it.
I like anonymous subroutines, but you don't have to use an eval to construct them. They are closures anyway. Something like
...;
return sub {
my ($tree, $keys, $value) = #_;
$#$keys >= $depth or die "need moar keys";
$tree = $tree->{$keys->[$_]} for 0 .. $depth - 1;
$tree->{$keys->[$depth]} = $value;
};
and
$s->($tree, [qw(one two three four five)], "a value");
would do something suprisingly similar. (Actually, using $depth now looks like a design error; the complete path is already specified by the keys. Therefore, creating a normal, named subroutine would probably be best.)
Understanding what the OP is doing a little better based on their comments, and riffing on Borodin's code, I'd suggest an interface change. Rather than writing a subroutine to apply a value deep in a tree, I'd write a subroutine to create an empty subtree and then work on that subtree. This allows you to work efficiently on the subtree without having to walk the tree on every operation.
package Root;
use Mouse;
has root =>
is => 'ro',
isa => 'HashRef',
default => sub { {} };
sub init_subtree {
my $self = shift;
my $tree = $self->root;
for my $key (#_) {
$tree = $tree->{$key} //= {};
}
return $tree;
}
my $root = Root->new;
my $subtree = $root->init_subtree(qw/one two three four/);
# Now you can quickly work with the subtree without having
# to walk down every time. This loop's performance is only
# dependent on the number of keys you're adding, rather than
# the number of keys TIMES the depth of the subtree.
my $val = 0;
for my $key ("a".."c") {
$subtree->{$key} = $val++;
}
use Data::Dump;
dd $root;
Data::Diver is your friend:
use Data::Diver 'DiveVal', 'DiveRef';
my $tree = {};
DiveVal( $tree, qw/one two three four five/ ) = 'a value';
# or if you hate lvalue subroutines:
${ DiveRef( $tree, qw/one two three four five/ ) } = 'a value';
use Data::Dump 'dump';
print dump $tree;
Need help figuring out how to do this. My code:
my %hash;
$hash{'1'}= {'Make' => 'Toyota','Color' => 'Red',};
$hash{'2'}= {'Make' => 'Ford','Color' => 'Blue',};
$hash{'3'}= {'Make' => 'Honda','Color' => 'Yellow',};
&printInfo(%hash);
sub printInfo{
my (%hash) = %_;
foreach my $key (keys %_{
my $a = $_{$key}{'Make'};
my $b = $_{$key}{'Color'};
print "$a $b\n";
}
}
The easy way, which may lead to problems when the code evolves, is simply by assigning the default array #_ (which contains all key-value-pairs as an even list) to the %hash which then rebuilds accordingliy. So your code would look like this:
sub printInfo {
my %hash = #_;
...
}
The better way would be to pass the hash as reference to the subroutine. This way you could still pass more parameters to your subroutine.
printInfo(\%hash);
sub PrintInfo {
my %hash = %{$_[0]};
...
}
An introduction to using references in Perl can be found in the perlreftut
You're so very, very close. There is no %_ for passing hashes, it must be passed in #_. Luckily, Hashes are assigned using a list context, so
sub printInfo {
my %hash = #_;
...
}
will make it work!
Also note, using the & in front of the subroutine call has been, in most cases, unnecessary since at least Perl 5.000. You can call Perl subroutines just like in other languages these days, with just the name and arguments. (As #mob points out in the comments, there are some instances where this is still necessary; see perlsub to understand this more, if interested.)
The best way to pass hashes and arrays is by reference. A reference is simply a way to talk about a complex data structure as a single data point -- something that can be stored in a scalar variable (like $foo).
Read up on references, so you understand how to create a reference and dereference a reference in order to get your original data back.
The very basics: You precede your data structure with a backslash to get the reference to that structure.
my $hash_ref = \%hash;
my $array_ref = \#array;
my $scalar_ref = \$scalar; #Legal, but doesn't do much for you...
A reference is a memory location of the original structure (plus a clue about the structure):
print "$hash_ref\n";
Will print something like:
HASH(0x7f9b0a843708)
To get the reference back into a useable format, you simply put the reference into the correct sigil in front:
my %new_hash = %{ $hash_ref };
You should learn about using references since this is the way you can create extremely complex data structures in Perl, and how Object Oriented Perl works.
Let's say you want to pass three hashes to your subroutine. Here are the three hashes:
my %hash1 = ( this => 1, that => 2, the => 3, other => 4 );
my %hash2 = ( tom => 10, dick => 20, harry => 30 );
my %hash3 = ( no => 100, man => 200, is => 300, an => 400, island => 500 );
I'll create the references for them
my $hash_ref1 = \%hash1;
my $hash_ref2 = \%hash2;
my $hash_ref3 = \%hash3;
And now just pass the references:
mysub ( $hash_ref1, $hash_ref2, $hash_ref3 );
The references are scalar data, so there's no problem passing them to my subroutine:
sub mysub {
my $sub_hash_ref1 = shift;
my $sub_hash_ref2 = shift;
my $sub_hash_ref3 = shift;
Now, I just dereference them, and my subroutine can use them.
my %sub_hash1 = %{ $sub_hash_ref1 };
my %sub_hash2 = %{ $sub_hash_ref2 };
my %sub_hash3 = %{ $sub_hash_ref3 };
You can see what a reference is a reference to by using the ref command:
my $ref_type = ref $sub_hash_ref; # $ref_type is now equal to "HASH"
This is useful if you want to make sure you're being passed the correct type of data structure.
sub mysub {
my $hash_ref = shift;
if ( ref $hash_ref ne "HASH" ) {
croak qq(You need to pass in a hash reference);
}
Also note that these are memory references, so modifying the reference will modify the original hash:
my %hash = (this => 1, is => 2, a => 3 test => 4);
print "$hash{test}\n"; # Printing "4" as expected
sub mysub ( \%hash ); # Passing the reference
print "$hash{test}\n"; # This is printing "foo". See subroutine:
sub mysub {
my $hash_ref = shift;
$hash_ref->{test} = "foo"; This is modifying the original hash!
}
This can be good -- it allows you to modify data passed to the subroutine, or bad -- it allows you to unintentionally modify data passed to the original subroutine.
I believe you want
my %hash;
$hash{'1'}= {'Make' => 'Toyota','Color' => 'Red',};
$hash{'2'}= {'Make' => 'Ford','Color' => 'Blue',};
$hash{'3'}= {'Make' => 'Honda','Color' => 'Yellow',};
printInfo(%hash);
sub printInfo{
my %hash = #_;
foreach my $key (keys %hash){
my $a = $hash{$key}{'Make'};
my $b = $hash{$key}{'Color'};
print "$a $b\n";
}
}
In the line printInfo(%hash) the %hash is expanded to a list with the alternating key-value pairs.
In printInfo, the #_ is this list that, and assigned to %hash it creates again the keys with their corresponding value from the alternating elements in the list.
You can pass them as
The argument list do_hash_thing( %hash )
A reference to the hash in the argument list
`do_hash_thing( #args_before, \%hash, #args_after )
As a reference by prototype, working like keys and other hash operators.
The list works like so:
sub do_hash_thing {
my %hash = #_;
...
}
do_hash_thing( %hash );
This also allows you to "stream" hash arguments as well:
do_hash_thing( %hash_1, %hash_2, parameter => 'green', other => 'pair' );
By reference works like this:
sub do_hash_thing {
my $hash_ref = shift;
...
}
do_hash_thing( \%hash, #other_args );
Here by prototype (\%#). The prototype makes perl look for a hash in the first argument and pass it by reference.
sub do_hash_thing (\%#) {
my $hash_ref = shift;
...
}
do_hash_thing( %hash => qw(other args) );
# OR
do_hash_thing %hash => qw(other args);
Caveat: prototypes don't work on methods.
I have a perl script (simplified) like so:
my $dh = Stats::Datahandler->new(); ### homebrew module
my %url_map = (
'/(article|blog)/' => \$dh->articleDataHandler,
'/video/' => \$dh->nullDataHandler,
);
Essentially, I'm going to loop through %url_map, and if the current URL matches a key, I want to call the function pointed to by the value of that key:
foreach my $key (keys %url_map) {
if ($url =~ m{$key}) {
$url_map{$key}($url, $visits, $idsite);
$mapped = 1;
last;
}
}
But I'm getting the message:
Can't use string ("/article/") as a subroutine ref while "strict refs" in use at ./test.pl line 236.
Line 236 happens to be the line $url_map{$key}($url, $visits, $idsite);.
I've done similar things in the past, but I'm usually doing it without parameters to the function, and without using a module.
Since this is being answered here despite being a dup, I may as well post the right answer:
What you need to do is store a code reference as the values in your hash. To get a code reference to a method, you can use the UNIVERSAL::can method of all objects. However, this is not enough as the method needs to be passed an invocant. So it is clearest to skip ->can and just write it this way:
my %url_map = (
'/(article|blog)/' => sub {$dh->articleDataHandler(#_)},
'/video/' => sub {$dh->nullDataHandler(#_)},
);
This technique will store code references in the hash that when called with arguments, will in turn call the appropriate methods with those arguments.
This answer omits an important consideration, and that is making sure that caller works correctly in the methods. If you need this, please see the question I linked to above:
How to take code reference to constructor?
You're overthinking the problem. Figure out the string between the two forward slashes, then look up the method name (not reference) in a hash. You can use a scalar variable as a method name in Perl; the value becomes the method you actually call:
%url_map = (
'foo' => 'foo_method',
);
my( $type ) = $url =~ m|\A/(.*?)/|;
my $method = $url_map{$type} or die '...';
$dh->$method( #args );
Try to get rid of any loops where most of the iterations are useless to you. :)
my previous answer, which I don't like even though it's closer to the problem
You can get a reference to a method on a particular object with can (unless you've implemented it yourself to do otherwise):
my $dh = Stats::Datahandler->new(); ### homebrew module
my %url_map = (
'/(article|blog)/' => $dh->can( 'articleDataHandler' ),
'/video/' => $dh->can( 'nullDataHandler' ),
);
The way you have calls the method and takes a reference to the result. That's not what you want for deferred action.
Now, once you have that, you call it as a normal subroutine dereference, not a method call. It already knows its object:
BEGIN {
package Foo;
sub new { bless {}, $_[0] }
sub cat { print "cat is $_[0]!\n"; }
sub dog { print "dog is $_[0]!\n"; }
}
my $foo = Foo->new;
my %hash = (
'cat' => $foo->can( 'cat' ),
'dog' => $foo->can( 'dog' ),
);
my #tries = qw( cat dog catbird dogberg dogberry );
foreach my $try ( #tries ) {
print "Trying $try\n";
foreach my $key ( keys %hash ) {
print "\tTrying $key\n";
if ($try =~ m{$key}) {
$hash{$key}->($try);
last;
}
}
}
The best way to handle this is to wrap your method calls in an anonymous subroutine, which you can invoke later. You can also use the qr operator to store proper regexes to avoid the awkwardness of interpolating patterns into things. For example,
my #url_map = (
{ regex => qr{/(article|blog)/},
method => sub { $dh->articleDataHandler }
},
{ regex => qr{/video/},
method => sub { $dh->nullDataHandler }
}
);
Then run through it like this:
foreach my $map( #url_map ) {
if ( $url =~ $map->{regex} ) {
$map->{method}->();
$mapped = 1;
last;
}
}
This approach uses an array of hashes rather than a flat hash, so each regex can be associated with an anonymous sub ref that contains the code to execute. The ->() syntax dereferences the sub ref and invokes it. You can also pass parameters to the sub ref and they'll be visible in #_ within the sub's block. You can use this to invoke the method with parameters if you want.
I choose to use tie and find this:
package Galaxy::IO::INI;
sub new {
my $invocant = shift;
my $class = ref($invocant) || $invocant;
my $self = {']' => []}; # ini section can never be ']'
tie %{$self},'INIHash';
return bless $self, $class;
}
package INIHash;
use Carp;
require Tie::Hash;
#INIHash::ISA = qw(Tie::StdHash);
sub STORE {
#$_[0]->{$_[1]} = $_[2];
push #{$_[0]->{']'}},$_[1] unless exists $_[0]->{$_[1]};
for (keys %{$_[2]}) {
next if $_ eq '=';
push #{$_[0]->{$_[1]}->{'='}},$_ unless exists $_[0]->{$_[1]}->{$_};
$_[0]->{$_[1]}->{$_}=$_[2]->{$_};
}
$_[0]->{$_[1]}->{'='};
}
if I remove the last "$[0]->{$[1]}->{'='};", it does not work correctly.
Why ?
I know a return value is required. But "$[0]->{$[1]};" cannot work correctly either, and $[0]->{$[1]}->{'='} is not the whole thing.
Old post:
I am write a package in Perl for parsing INI files.
Just something based on Config::Tiny.
I want to keep the order of sections & keys, so I use extra array to store the order.
But when I use " $Config->{newsection} = { this => 'that' }; # Add a section ", I need to overload '=' so that "newsection" and "this" can be pushed in the array.
Is this possible to make "$Config->{newsection} = { this => 'that' };" work without influence other parts ?
Part of the code is:
sub new {
my $invocant = shift;
my $class = ref($invocant) || $invocant;
my $self = {']' => []}; # ini section can never be ']'
return bless $self, $class;
}
sub read_string {
if ( /^\s*\[\s*(.+?)\s*\]\s*$/ ) {
$self->{$ns = $1} ||= {'=' => []}; # ini key can never be '='
push #{$$self{']'}},$ns;
next;
}
if ( /^\s*([^=]+?)\s*=\s*(.*?)\s*$/ ) {
push #{$$self{$ns}{'='}},$1 unless defined $$self{$ns}{$1};
$self->{$ns}->{$1} = $2;
next;
}
}
sub write_string {
my $self = shift;
my $contents = '';
foreach my $section (#{$$self{']'}}) {
}}
Special Symbols for Overload
lists the behaviour of Perl overloading for '='.
The value for "=" is a reference to a function with three arguments, i.e., it looks like the other values in use overload. However, it does not overload the Perl assignment operator. This would go against Camel hair.
So you will probably need to rethink your approach.
This is not exactly JUST operator overloading, but if you absolutely need this functionality, you can try a perl tie:
http://perldoc.perl.org/functions/tie.html
Do you know about Config::IniFiles? You might consider that before you go off and reinvent it. With some proper subclassing, you can add ordering to it.
Also, I think you have the wrong interface. You're exposing the internal structure of your object and modifying it through magical assignments. Using methods would make your life much easier.
The question "How can I monkey-patch an instance method in Perl?" got me thinking. Can I dynamically redefine Perl methods? Say I have a class like this one:
package MyClass;
sub new {
my $class = shift;
my $val = shift;
my $self = { val=> $val};
bless($self, $class);
return $self;
};
sub get_val {
my $self = shift;
return $self->{val}+10;
}
1;
And let's say that adding two numbers is really expensive.
I'd like to modify the class so that $val+10 is only computed the first time I call the method on that object. Subsequent calls to the method would return a cached value.
I could easily modify the method to include caching, but:
I have a bunch of methods like this.
I'd rather not dirty up this method.
What I really want to do is specify a list of methods that I know always return the same value for a given instance. I then want to take this list and pass it to a function to add caching support to those methods
Is there an effective way to accomplish this?
Follow up. The code below works, but because use strict doesn't allow references by string I'm not 100% where I want to be.
sub myfn {
printf("computing\n");
return 10;
}
sub cache_fn {
my $fnref = shift;
my $orig = $fnref;
my $cacheval;
return sub {
if (defined($cacheval)) { return $cacheval; }
$cacheval = &$orig();
return $cacheval;
}
}
*{myfn} = cache_fn(\&myfn);
How do I modify to just do this?:
cache_fn(&myfn);
You can overwrite methods like get_val from another package like this:
*{MyClass::get_val} = sub { return $some_cached_value };
If you have a list of method names, you could do something like this:
my #methods = qw/ foo bar get_val /;
foreach my $meth ( #methods ) {
my $method_name = 'MyClass::' . $meth;
no strict 'refs';
*{$method_name} = sub { return $some_cached_value };
}
Is that what you imagine?
I write about several different things you might want to do in the "Dynamic Subroutines" chapter of Mastering Perl. Depending on what you are doing, you might want to wrap the subroutine, or redefine it, or subclass, or all sorts of other things.
Perl's a dynamic language, so there is a lot of black magic that you can do. Using it wisely is the trick.
I've never tried it with methods, but Memoize may be what you're looking for. But be sure to read the caveats.
Not useful in your case but had your class been written in Moose then you can dynamically override methods using its Class::MOP underpinnings....
{
package MyClass;
use Moose;
has 'val' => ( is => 'rw' );
sub get_val {
my $self = shift;
return $self->val + 10;
}
}
my $A = MyClass->new( val => 100 );
say 'A: before: ', $A->get_val;
$A->meta->remove_method( 'get_val' );
$A->meta->add_method( 'get_val', sub { $_[0]->val } );
say 'A: after: ', $A->get_val;
my $B = MyClass->new( val => 100 );
say 'B: after: ', $B->get_val;
# gives u...
# => A: before: 110
# => A: after: 100
# => B: after: 100
How do I modify to just do this?:
cache_fn(\&myfn);
Well based on your current example you could do something like this....
sub cache_fn2 {
my $fn_name = shift;
no strict 'refs';
no warnings 'redefine';
my $cache_value = &{ $fn_name };
*{ $fn_name } = sub { $cache_value };
}
cache_fn2( 'myfn' );
However looking at this example I can't help thinking that you could use Memoize instead?