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.
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.
I try to use a (class) method in an Object for sorting object instances.
package Something;
use strict;
use warnings;
use Data::Dumper;
sub new {
my ($class, $date) = #_;
my $self = bless{}, $class;
$self->{date} = $date;
return $self;
}
sub _sort($$) {
print STDERR Dumper($_[0], $_[1]);
$_[0]->{date} cmp $_[1]->{date};
}
package SomethingTest;
use base 'Test::Class';
use Test::More;
__PACKAGE__->runtests() unless caller;
sub sorting : Test {
my $jan = Something->new("2016-01-01");
my $feb = Something->new("2016-02-01");
my $mar = Something->new("2016-03-01");
is_deeply(
sort Something::_sort [$feb, $mar, $jan],
[$jan, $feb, $mar]);
}
I've seen this snippet in perldoc -f sort, hence the prototype for _sort.
# using a prototype allows you to use any comparison subroutine
# as a sort subroutine (including other package's subroutines)
package other;
sub backwards ($$) { $_[1] cmp $_[0]; } # $a and $b are
# not set here
package main;
#new = sort other::backwards #old;
However, the dumped arguments look odd:
$VAR1 = [
bless( {
'date' => '2016-02-01'
}, 'Something' ),
bless( {
'date' => '2016-03-01'
}, 'Something' ),
bless( {
'date' => '2016-01-01'
}, 'Something' )
];
$VAR2 = [
$VAR1->[2],
$VAR1->[0],
$VAR1->[1]
];
and the test fails with
# Failed test 'sorting died (Not a HASH reference at sort.t line 16.)'
# at sort.t line 25.
Is this just my test setup or can't I have the same objects in these arrays?
What else am I missing?
Your problem isn't with the subroutine you pass to sort(), but in the arguments you pass to is_deeply(). The way you have written it parses like this, if we add some parentheses:
is_deeply(
sort(Something::_sort [$feb, $mar, $jan], [$jan, $feb, $mar] )
);
That is, you're telling sort() to act on a list consisting of two anonymous array references, and then is_deeply() to run with the single argument returned from sort (except it crashes before is_deeply() can try to run and complain that you gave it too few arguments to work with).
This is probably closer to what you intended:
is_deeply(
[sort(Something::_sort ($feb, $mar, $jan))],
[$jan, $feb, $mar]);
That is, tell is_deeply() to compare two anonymous arrays, the first of which is made from telling sort() to apply your sorting routine to the list ($feb, $mar, $jan).
I have a dispatch table that I wish to initialize only once, and is only intended to be used by one function. I was hoping to move the dispatch table outside of the subroutine and into the same anonymous block, but since the dispatch table uses closures to call methods for the object passed into the function, moving the table outside the function separates it from access to the object. What other options do I have for this dispatch table?
I'm using Perl 5.8, so unfortunately I'm unable to use state variables.
sub foo {
my ($self, $var) = #_;
my %funcs = (
a => sub { $self->_a() },
b => sub { $self->_b() },
...
);
return $funcs{$var}->();
}
Your functions in the dispatch table are closures over $self. If you pass in the $self as a parameter, you can get around that. Note that state variables are not true closures over $self, and would require an explicit parameter as well.
my %funcs = (
a => sub { shift->_a }, # these are like anonymous methods
b => sub { shift->_b },
);
sub foo {
my ($self, $var) = #_;
my $meth = $funcs{$var} || die "There is no entry $var";
return $self->$meth(); # sugary syntax
}
Here is a demonstration why state would be a bad idea:
use 5.010;
package Foo;
sub new { my ($c, $v) = #_; bless \$v, $c }
sub foo {
my ($self) = #_;
state $cb = sub { say $$self };
$cb->();
}
Foo->new($_)->foo for 1..3;
Output:
1
1
1
The inner sub is a closure, but the initialization of $cb is only performed once. Thus the closed over $self is the first one.
I'm modularizing my code, but when I move a sub out of it's original module, I get the following error:
Couldn't load application from file "foo.pl": Not an ARRAY reference at D.pm line 10.
This was the original file. As is, it's all ok:
FormerC.pm:
package FormerC;
use strict;
my %my_hash = ( key => 'value' );
my #my_array = qw( some strings inside array );
sub problematic_sub {
my ($hash_ref, $array_ref) = #_;
my #an_array = #$array_ref;
return \#an_array;
};
sub uses_problematic_sub {
problematic_sub(\%my_hash, \#my_array);
};
uses_problematic_sub();
1
These are the two new modules. With these I get the error:
D.pm:
package D;
use strict;
sub new { bless {}, shift };
sub problematic_sub {
my ($hash_ref, $array_ref) = #_;
my #an_array = #$array_ref;
return \#an_array;
};
1
C.pm:
package C;
use strict;
use D;
my $d = D->new;
my %my_hash = ( key => 'value' );
my #my_array = qw( some strings inside array );
sub uses_problematic_sub {
$d->problematic_sub(\%my_hash, \#my_array);
};
uses_problematic_sub();
1
You used to call problematic_sub as a sub
problematic_sub(\%my_hash, \#my_array);
but you now call is as a method:
$d->problematic_sub(\%my_hash, \#my_array);
Since you didn't code problematic_sub as a method, this isn't correct. You need to also change problematic_sub's parameters to the following:
my ($self, $hash_ref, $array_ref) = #_;
You are likely to be better off using the Exporter module to export the subroutine names into the calling code's namespace. What you have written here is an object-oriented module, but the object is just a collection of subroutines and doesn't need object-oriented support.
The problem is that a method call like
$d->problematic_sub(\%my_hash, \#my_array)
implicitly passes the object as the first parameter, so it is equivalent to
D::problematic_sub($d, \%my_hash, \#my_array)
All you need to do is account for this in the subroutine
sub problematic_sub {
my ($self, $hash_ref, $array_ref) = #_;
my #an_array = #$array_ref;
return \#an_array;
}
and your code should work.
Also note that a subroutine declaration, like a while or for loop, is not a statement and so doesn't need and shouldn't have a semicolon after it.