I'm trying to implement a dispatch table which calls functions inside a Perl module. I know how to implement dispatch tables generally, but I can't seem to get it right when referencing an object method from within $self. Maybe I haven't Googled enough, but so far, the right syntax is elusive.
I have traced the parameters though the calls, and I know what is happening -- the function references are not receiving a reference to $self as their first parameter. This is what I currently have inside $self. I believe I copied this over properly; if I made a mistake and it doesn't run, I apologize.
package MyRefHashTest;
use strict;
use warnings;
sub new {
my $class = shift;
my $self = {
DISPATCH => {
ONE => \&funcOne,
TWO => \&funcTwo,
THREE => \&funcThree,
FOUR => \&funcFour
}
};
bless $self, $class;
return $self;
}
sub funcOne {
my ($self, $param) = #_;
print "func1 $param \n";
}
sub funcTwo {
my ($self, $param) = #_;
print "func2 $param \n";
}
sub funcThree {
my ($self, $param) = #_;
print "func3 $param \n";
}
sub funcFour {
my ($self, $param) = #_;
print "func4 $param \n";
}
sub runTesting {
my ($self, $type) = #_;
($self->{DISPATCH}{$type} || sub {})->("string");
}
1;
# To Test:
$test = MyRefHashTest->new;
$test->runTesting("ONE");
$test->runTesting("TWO");
$test->runTesting("THREE");
$test->runTesting("FOUR");
The actual output I get is that $param is undefined in the function calls from the dispatch table, when it should not be. This is how I know that the references to $self are not where they should be. The functions think that $type is $self.
I have tried editing the hash table references so they look like \$self->functionName, but that only results in a compilation error for $self not being properly defined on that line.
Can anyone guide me to the right syntax for this, please?
Thanks!
EDIT: After much more work, I finally found a solution. It's some very interesting syntax, a lot more complicated than I thought. Essentially, I'm building the hash from the inside out:
my $self = {
DISPATCH => undef
};
$self->{DISPATCH} = {
ONE => sub { $self->funcOne(#_); },
TWO => sub { $self->funcTwo(#_); },
THREE => sub { $self->funcThree(#_); },
FOUR => sub { $self->funcFour(#_); }
};
It works, but it seems like a lot of hassle for what it is. If anyone knows of an easier way to do this, I would still be very interested in it. If there isn't an easier way, on the other hand, I hope this can help somebody.
What follows are four approaches for implementing a method-based dispatch table. The differences explained afterwards.
my %DISPATCH = (
ONE => \&funcOne,
TWO => \&funcTwo,
THREE => \&funcThree,
FOUR => \&funcFour,
);
sub runTesting {
my ($self, $type) = #_;
my $method = $DISPATCH{$type};
return $self->$method("string");
}
or
my %DISPATCH = (
ONE => __PACKAGE__->can('funcOne'),
TWO => __PACKAGE__->can('funcTwo'),
THREE => __PACKAGE__->can('funcThree'),
FOUR => __PACKAGE__->can('funcFour'),
);
sub runTesting {
my ($self, $type) = #_;
my $method = $DISPATCH{$type};
return $self->$method("string");
}
or
my %DISPATCH = (
ONE => 'funcOne',
TWO => 'funcTwo',
THREE => 'funcThree',
FOUR => 'funcFour',
);
sub runTesting {
my ($self, $type) = #_;
my $method_name = $DISPATCH{$type};
return $self->$method_name("string");
}
or
my %DISPATCH = (
ONE => sub { shift->funcOne(#_) },
TWO => sub { shift->funcTwo(#_) },
THREE => sub { shift->funcThree(#_) },
FOUR => sub { shift->funcFour(#_) },
);
sub runTesting {
my ($self, $type) = #_;
my $cb = $DISPATCH{$type};
return $cb->($self, "string");
}
All four approaches allow the methods to be defined in the same class.
The last three approaches allow the methods to be defined in a superclass as well.
The last two approaches allow a subclass to provide or override the method as well. These are your best options.
How about passing in $self in the dynamic dispatch method:
sub runTesting {
my ($self, $type) = #_;
($self->{DISPATCH}{$type} || sub {})->($self,"string");
^^^^^
}
I believe the problem is that you are invoking the methods as plain functions and not object methods.
Related
I'm writing a subclass that encapsulates multiple objects of the parent class so I can call functions sort-of like a vector, something like this:
package OriginalClass;
sub new { return bless {bar => 123}, 'OriginalClass' }
sub foo { return shift->{bar}; }
1;
package NewClass;
use parent OriginalClass;
# Return a blessed arrayref of "OriginalClass" objects.
# new() would be called NewClass->new(OriginalClass->new(), ...)
sub new {
my $class = shift;
return bless \#_, 'NewClass';
}
# Vectorized foo(), returns a list of SUPER::foo() results:
sub foo
{
my $self = shift;
my #ret;
push #ret, $_->SUPER::foo() foreach #$self;
return #ret;
}
1;
I don't want to write a new vectorized function in NewClass for each function in OriginalClass, particularly for when OriginalClass adds new functions to be maintained (vectorized) in NewClass.
Question:
As I understand AUTOLOAD is slow, so is there a way to vectorize calls OriginalClass via something like NewClass without AUTOLOAD?
As I understand AUTOLOAD is slow
If AUTOLOAD generates the missing sub, then only the first call is "slow" since subsequent calls of the same method don't result in AUTOLOAD being called at all.
package NewClass;
use strict;
use warnings;
sub new {
my $class = shift;
return bless( \#_, $class );
}
sub AUTOLOAD {
my $method_name = our $AUTOLOAD =~ s/^.*:://sr;
my $method = sub {
my $self = shift;
return map { $_->$method_name( #_ ) } #$self;
};
{
no strict 'refs';
*$method_name = $method;
}
goto &$method;
}
1
Note that I didn't use parent and SUPER::. This isn't an inheritance relationship. And it would prevent AUTOLOAD from getting called since AUTOLOAD is only called when a method doesn't exist.
You can use Sub::Name to "name the sub" for better diagnostics.
use Sub::Name qw( subname );
my $method = subname $method_name => sub { ... };
But yes, AUTOLOAD can be avoided here, as long as you can get a list of the method names in advance.
package NewClass;
use strict;
use warnings;
sub new {
my $class = shift;
return bless( \#_, $class );
}
for my $method_name (qw( foo ... )) {
my $method = sub {
my $self = shift;
return map { $_->$method_name( #_ ) } #$self;
};
no strict 'refs';
*$method_name = $method;
}
1
The above uses a hardcoded list, but more dynamic solutions are possible. For example, the list could be obtained from inspecting the contents of the OriginalClass namespace for subs (filtering out new and anything else inappropriate such as names starting with _).
Module https://metacpan.org/pod/Array::Delegate could be helpful : it delegates method calls to an array of objects.
Is there any way to achieve partial application in Perl?
Suppose, I want to do something like:
sub each_file($arr, $op) {
$op->($_) for #{$arr};
...
}
sub each_line($op, $file) {
...
}
each_file($arr, each_line($op));
I want to partially apply each_line() to only $op, so it'll become a new function can be passed to $each_file, how do I express this in idiomatic Perl?
You can do this in Perl with two approaches combined:
A function which returns a function reference
Closures
Example:
sub each_file {
my ($arr, $line_fn) = #_;
$line_fn->($_) for #{$arr};
...
}
sub each_line {
my ($op, $file) = #_;
...
}
sub make_line_processor {
my ( $op ) = #_;
# This is closed over $op, which effectively becomes
# a constant for the returned function
my $fn = sub {
return each_line( $op, #_ );
};
return $fn;
}
# To call it:
each_file( $arr, make_line_processor($op) );
This can be an even more useful technique in cases where you don't want $op directly, but some expensive-to-fetch derivation of it. In which case you would calculate the derived value just once (in the make_line_processor function) and close over that instead.
# given some $op as implied by your code snippet
each_file($arr, sub { each_line($op, shift) });
# shift op will be applied when anonymous sub { … } is called
(Your code snippet doesn't make it entirely clear what you intend $op to be when you make the call to each_line. It's usually better to present small working programs.)
You can roll this functionality up into a class. Then you can overload the subroutine dereference operator to make it look like your class is really a code reference.
package Partial;
use overload '&{}' => \&call;
sub new {
my $class = shift;
my $code = shift;
bless {code => $code, args => \#_}, $class;
}
sub call {
my ($self) = #_;
return sub{ $self->{code}->(#{$self->{args}}, #_) }
}
You can then use it like this:
sub printArgs {
print join ", ", #_;
print "\n";
}
my $partial = Partial->new(\&printArgs, 'foo', 'bar');
$partial->('baz', 'bat');
# prints foo, bar, baz, bat
I'm creating a user module to extract user information and currently I have:
sub new
{
my $class = shift;
my ( $id ) = #_;
my $self = getUserInfo ($id);
bless $self, $class;
return $self;
}
sub getUserInfo
{
...
}
However, I would like to achieve something to the effect of:
my $self = (getFirstName($id), getLastName($id), getEmpNum($id));
...
sub getFirstName{ return { firstname => $firstname }; }
sub getLastName{ return { lastname => $lastname }; }
sub getEmpNum{ return { empnum => $empnum }; }
How do I go about distributing a parameter to multiple subroutines?
I think your general code architecture has a few problems, but the snippets so far don't offer enough context to suggest an alternative solution – consider posting your complete code on Code Review for a more complete criticism.
Regarding your immediate problem: You could write a function to combine the hash references:
use Carp ();
sub combine_hashrefs {
my %combined;
for my $hashref (#_) {
if (my #conflicts = grep { exists $combined{$_} } keys %$hashref) {
Carp::confess "The keys [#conflicts] are conflicting";
}
#combined{keys %$hashref} = values %$hashref;
}
return \%combined;
}
...
my $self = combine_hashrefs($hashref_a, $hashref_b, $hashref_c, ...);
Do I understand correctly that you want to avoid the repetition of $id in the following line?
my $self = (getFirstName($id), getLastName($id), getEmpNum($id));
$self is a scalar, so you should rather use the anonymous array [...]. To specify $id only once, you can use
my $self = [ map $_->($id), \&getFirstName, \&getLastName, \&getEmpNum ];
I have a set of fields with each field having different set of validation rules.
I have placed the subroutine reference for validating a hash-ref.
Currently its in my constructor, but I want to take it out of my constructor in a private sub.
I have done it as below
sub new {
my $class = shift;
my $self = {#_};
$class = (ref($class)) ? ref $class : $class;
bless($self, $class);
$self->{Validations} = {
Field1 => {name => sub{$self->checkField1(#_);},args => [qw(a b c)]}
Field2 => {name => sub{$self->checkField2(#_);},args => {key1, val1}}
..
..
..
..
};
return $self;
}
Now I want to take out all this validation rules out of my constructor and want to do some thing like below, so that I have some better control over my validation rules based on types fields.(Say some rules are common in one set of fields and I can overwrite rules for other rules just by overwriting the values of fields.)
bless($self, $class);
$self->{Validations} = $self->_getValidation($self->{type});
return $self;
}
sub _getValidation{
my ($self,$type) = #_;
my $validation = {
Field1 => {name => sub {$self->checkField1(#_);}, args => {key1 => val1}},};
return $validation;
}
But I am getting Can't use string ("") as a subroutine ref while "strict refs" in use at... Can anybody tell me why is this behavior with sub ref. If I check my name key, its coming to be null or sub {DUMMY};
It looks to me like you are getting close to reinventing Moose poorly. Consider using Moose instead of building something similar, but less useful.
The error message means that you are passing in a string in a place where your code expects a code reference. Get a stack trace to figure out where the error is coming from.
You can do this by using Carp::Always, overriding the $SIG{__DIE__} handler to generate a stack trace, or inserting a Carp::confess into your code.
Here's a sigdie solution, stick this in your code where it will run before your module initialization:
$SIG{__DIE__} = sub { Carp::confess(#_) };
You may need to put it in a BEGIN block.
I'd really like to discourage you from taking this approach to building objects. You happily bless any random crap passed in to the constructor as part of your object! You blithely reach into your object internals. Field validation rules *do not belong in the constructor--they belong in the attribute mutators.
If you must use a DIY object, clean up your practices:
# Here's a bunch of validators.
# I set them up so that each attribute supports:
# Multiple validators per attribute
# Distinct error message per attribute
my %VALIDATORS = (
some_attribute => [
[ sub { 'foo1' }, 'Foo 1 is bad thing' ],
[ sub { 'foo2' }, 'Foo 2 is bad thing' ],
[ sub { 'foo3' }, 'Foo 3 is bad thing' ],
],
other_attribute => [ [ sub { 'bar' }, 'Bar is bad thing' ] ],
);
sub new {
my $class = shift; # Get the invocant
my %args = #_; # Get named arguments
# Do NOT make this a clone method as well
my $self = {};
bless $class, $self;
# Initialize the object;
for my $arg ( keys %args ) {
# Make sure we have a sane error message on a bad argument.
croak "Bogus argument $arg not allowed in $class\n"
unless $class->can( $arg );
$self->$arg( $args{$arg} );
}
return $self;
}
# Here's an example getter/setter method combined in one.
# You may prefer to separate get and set behavior.
sub some_attribute {
my $self = shift;
if( #_ ){
my $val = shift;
# Do any validation for the field
$_->[0]->($val) or croak $_->[1]
for #{ $VALIDATORS{some_attribute} || [] };
$self->{some_attribute} = $val;
}
return $self->{some_attribute};
}
All this code is very nice, but you have to repeat your attribute code for every attribute. This means a lot of error-prone boilerplate code. You can get around this issue by learning to use closures or string eval to dynamically create your methods, or you can use one of Perl's many class generation libraries such as Class::Accessor, Class::Struct, Accessor::Tiny and so forth.
Or you can learn [Moose][3]. Moose is the new(ish) object library that has been taking over Perl OOP practice. It provides a powerful set of features and dramatically reduces boilerplate over classical Perl OOP:
use Moose;
type 'Foo'
=> as 'Int'
=> where {
$_ > 23 and $_ < 42
}
=> message 'Monkeys flew out my butt';
has 'some_attribute' => (
is => 'rw',
isa => 'Foo',
);
I haven't read everything you had, but this struck me:
sub new {
my $class = shift;
my $self = {#_};
$class = (ref($class)) ? ref $class : $class;
bless($self, $class);
Normally, when you create a new object, the user doesn't pass $self as one of the objects. That's what you're creating.
You usually see something like this:
sub new {
my $class = shift; #Contains the class
my %params = #_; #What other parameters used
my $self = {}; #You're creating the $self object as a reference to something
foreach my $param (keys (%params)) {
$self->{$param} = $params{$param};
}
bless ($self, $class) #Class is provided. You don't have to check for it.
return $self #This is the object you created.
}
Now, $self doesn't have to be a reference to a hash as in the above example. It could be a reference to an array. Or maybe to a function. But, it's usually a reference. The main point, is that the user doesn't pass in $self because that's getting created by your new subroutine.
Nor, do you have to check the value of $class since that's given when the new subroutine is called.
If you want to do your verification in a private class (an excellent idea, by the way), you can do so after the bless:
sub new {
my $class = shift; #Contains the class
my %params = #_; #What other parameters used
my $self = {}; #You're creating the $self object as a reference to something
foreach my $param (keys (%params)) {
$self->{$param} = $params{$param};
}
bless ($self, $class) #Class is provided. You don't have to check for it.
#Now you can run your verifications since you've blessed the object created
if (not $self->_validate_parameters()) {
croak qq(Invalid parameters passed in class $class);
}
return $self #This is the object you created.
}
I have a class with several variables, one of which is a hash (_runs):
sub new
{
my ($class, $name) = #_;
my $self = {
_name => $name,
...
_runs => (),
_times => [],
...
};
bless ($self, $class);
return $self;
}
Now, all I'm trying to do is create an accessor/mutator, as well as another subroutine that pushes new data into the hash. But I'm having a hell of a time getting all the referencing/dereferencing/$self calls working together. I've about burned my eyes out with "Can't use string ("blah") as a HASH ref etc etc" errors.
For the accessor, what is 'best practice' for returning hashes? Which one of these options should I be using (if any)?:
return $self->{_runs};
return %{ $self->{_runs} };
return \$self->{_runs};
Further, when I'm using the hash within other subroutines in the class, what syntax do I use to copy it?
my #runs = $self->{_runs};
my #runs = %{ $self->{_runs} };
my #runs = $%{ $self->{_runs} };
my #runs = $$self->{_runs};
Same goes for iterating over the keys:
foreach my $dt (keys $self->{_runs})
foreach my $dt (keys %{ $self->{_runs} })
And how about actually adding the data?
$self->{_runs}{$dt} = $duration;
%{ $self->{_runs} }{$dt} = $duration;
$$self->{_runs}{$dt} = $duration;
You get the point. I've been reading articles about using classes, and articles about referencing and dereferencing, but I can't seem to get my brain to combine the knowledge and use both at the same time. I got my _times array working finally, but mimicking my array syntax over to hashes didn't work.
You are storing references to array or hashes in your object. To use them with standard functions you'll need to dereference them. For example:
#{ $self->{_array_ref_key} };
%{ $self->{_hash_ref_key} };
If you need pass parameters to standard function:
push( #{ $self->{_array_ref_key} }, $some_value );
for my $hash_key ( keys %{ $self->{_hash_ref_key} }) {
$self->{_hash_ref_key}{$hash_key}; ## you can access hash value by reference
}
Also $self->{_hash_ref_key}{$hash_key} syntax is shortcut for $self->{_hash_ref_key}->{$hash_key} (which can make for sense if you see it first time).
Also take a look at corresponding manual page.
Might as well take my comments and make a proper answer out of it. I'll illustrate exactly why your sample code failed.
use warnings;
my $self = {
_name => $name,
_runs => (),
_times => [],
};
bless ($self, $class);
use Data::Dump::Streamer; DumpLex $self;
__END__
Odd number of elements in anonymous hash at …
$self = bless( {
_name => undef,
_runs => '_times',
"ARRAY(0x88dcb8)" => undef,
}, '…' );
All the elements in the list form the key/value pairs for the hash whose reference is going to be blessed. () is an empty list, so what you're really expressing is the list '_name', $name, '_runs', '_times', []. You can see that _times moves up to become a value, and the reference [] is stringified as hash key. You get the warning because there's no value left for it; this will be automatically coerced to undef. (Always always enable the warnings pragma.)
Now for the guts part: hash values must be a scalar value. Arrays and hashes aren't; but references to them are. Thus:
my $self = {
_name => $name,
_runs => {},
_times => [],
};
First, you have to figure out what you actually want to return and what you want the higher level to be able to do with the data.
If you want to return a copy of the data or any changes to the returned data don't affect the copy in the object, you can't do the simple solutions that the other answers tell you because they return shallow copies which will still share internal references. You need to make a deep copy then return the disconnected data structure. Storable makes this easy with dclone:
use Storable qw( dclone );
sub some_method {
my( $self, ... ) = #_;
...;
my $clone = dclone( $self->{_runs} );
$clone;
}
If you want the higher level to change the object by changing the returned data structure, just return the reference that you already store. You don't need to do anything fancy for that:
sub some_method {
my( $self, ... ) = #_;
...;
$self->{_runs};
}
Beyond that, it's your job to create an interface so that people don't have to think about your data structure at the higher level. You encapsulate everything so your implementation details don't show themselves. That way, you can change the implementation without disturbing the higher level code (as long as the interface is stable).
You create a runs method that returns a list of runs:
sub get_run_keys {
my( $self ) = #_;
keys %{ $self->{_runs} };
}
Or maybe you just want the values:
sub get_run_values {
my( $self ) = #_;
values %{ $self->{_runs} };
}
Or maybe the whole thing:
sub get_run_hash {
my( $self ) = #_;
$self->{_runs}; # subject to the cloning stuff I mentioned earlier
}
When you want to get the values for a particular run, you access it through another method:
sub get_run {
my( $self, $key ) = #_;
$self->{_runs}{$key};
}
Setting a run value is similar:
sub set_run {
my( $self, $key, $value ) = #_;
$self->{_runs}{$key} = $value;
}
Now your higher level doesn't know anything about the infrastructure, and the method names describe what you are trying to do instead of how the infrastructure has to do it:
foreach my $key ( $self->get_run_keys ) {
my $run = $self->get_run( $key );
...;
$self->set_run( $key, $new_value );
}
Object-oriented design is a big topic, and there is a lot you can do. This is just enough to get you started. You can wrap other operations too:
sub does_run_exist {
my( $self, $key ) = #_;
exists $self->{_runs}{$key};
}
sub delete_runs {
my( $self, #keys ) = #_;
delete $self->{_runs}{$key} foreach my $keys ( #keys );
}
sub reset_runs {
my( $self, $key ) = #_;
$self->{_runs} = {};
}