I have the following code in my class :
sub new {
my $class = shift;
my %args = #_;
my $self = {};
bless( $self, $class );
if ( exists $args{callback} ) {
$self->{callback} = $args{callback};
}
if ( exists $args{dir} ) {
$self->{dir} = $args{dir};
}
return $self;
}
sub test {
my $self = shift;
my $arg = shift;
&$self->{callback}($arg);
}
and a script containing the following code :
use strict;
use warnings;
use MyPackage;
my $callback = sub {
my $arg = shift;
print $arg;
};
my $obj = MyPackage->new(callback => $callback);
but I receive the following error:
Not a CODE reference ...
What am I missing? Printing ref($self->{callback}) shows CODE. It works if I use $self->{callback}->($arg), but I would like to use another way of invoking the code ref.
The ampersand is binding just to $self and not the whole thing. You can do curlies around the part that returns the reference:
&{$self->{callback}}($arg);
But the
$self->{callback}->($arg);
is generally considered cleaner, why don't you want to use it?
Related
Given a syntax like
$c->routes->get($path)->to("$controller#$sub");
I would like to know which sub $controller#$sub resolves to on dispatch. Is there a simple method to get the ref of the sub? You can hard-set ->namespaces() so I assume it's not always as simple as $controller::$sub because you could have namespace::$controller::$sub.
I could not find a way to do this using the api, but there is a private method _class() that will give the controller object that contains the sub. Here is an example:
./lib/MyApp/Controller/Foo.pm:
package MyApp::Controller::Foo;
use Mojo::Base 'Mojolicious::Controller';
sub welcome {
my $self = shift;
$self->render(text => 'Hello there.');
}
1;
./myapp.pl:
use strict;
use warnings;
use Mojolicious::Lite;
use lib './lib';
get '/' => sub {
my $c = shift;
$c->render(text => 'Hello World!');
};
my $namespaces = app->routes->namespaces;
push #$namespaces, 'MyApp::Controller';
app->routes->get('/welcome')->to('foo#welcome');
app->hook(
before_dispatch => sub {
my $c = shift;
my $field = { action => "welcome", controller => "foo" };
my $obj = $c->app->routes->_class( $c, $field );
my $method = $field->{action};
my $subref = sub { $obj->$method( #_ ) };
}
);
app->start;
I have a base class that is instantiated with a complex data structure with a three-digit number of entries, all of them constants. A few of those constants are class-specific and should be instantiated with different constants. I am having trouble achieving this. It boils down to this:
tstbase.pm:
package tstbase;
my $THISCLASSCONSTANT = "baseconstant.2";
my %complexdatastructure = (
"attribute.1" => "baseconstant.1",
"attribute.2" => $THISCLASSCONSTANT,
);
sub new {
my $class = shift;
my $self = { };
bless ($self, $class);
$self->_init( $THISCLASSCONSTANT );
return $self;
};
sub _init {
my $self = shift;
$THISCLASSCONSTANT = shift;
foreach (keys %complexdatastructure) {
$self->{$_} = $complexdatastructure{$_};
};
};
tstsubclass.pm:
package tstsubclass;
use parent "tstbase";
my $THISCLASSCONSTANT = "subclassconstant.2";
sub _init {
my $self = shift;
$self->SUPER::_init( $THISCLASSCONSTANT );
};
tst.pl:
#!/usr/bin/perl
use tstbase;
use tstsubclass;
my $baseobj = tstbase->new;
print "Testbase ".$baseobj->{"attribute.1"}." ".$baseobj->{"attribute.2"}."\n";
my $subobj = tstsubclass->new;
print "Testsubclass ".$subobj->{"attribute.1"}." ".$subobj->{"attribute.2"}."\n";
Right now the output is
Testbase baseconstant.1 baseconstant.2
Testsubclass baseconstant.1 baseconstant.2
whereas I want it to be
Testbase baseconstant.1 baseconstant.2
Testsubclass baseconstant.1 subclassconstant.2
Is that possible? I am happy to use
sub THISCLASSCONSTANT = { "subclassconstant.2" }
if it helps. tstsubclass shall not have any baseconstant values.
Right now I instantiate the class with magic strings and do a search & replace. It works, but seems less elegant and performant.
Any help is greatly appreciated. I have asked this question before ( Perl: Using common constructor for base and subclass ) but have over-simplified the example, hence the response could only hint at a possible solution.
Thanks,
Marcus
The simplest way would be to work with references in your %complexdatastructure.
But note that when doing this, $THISCLASSCONSTANT will be changed after the first call to tstsubclass->new.
package tstbase;
my $THISCLASSCONSTANT = "baseconstant.2";
my %complexdatastructure = (
"attribute.1" => \ "baseconstant.1",
"attribute.2" => \ $THISCLASSCONSTANT,
);
sub new {
my $class = shift;
my $self = { };
bless ($self, $class);
$self->_init( $THISCLASSCONSTANT );
return $self;
};
sub _init {
my $self = shift;
$THISCLASSCONSTANT = shift;
foreach (keys %complexdatastructure) {
$self->{$_} = ${$complexdatastructure{$_}};
};
};
Now your output is the desired one, but if you alter the order of the new calls like this:
my $subobj = tstsubclass->new;
print "Testsubclass ".$subobj->{"attribute.1"}." ".$subobj->{"attribute.2"}."\n";
my $baseobj = tstbase->new;
print "Testbase ".$baseobj->{"attribute.1"}." ".$baseobj->{"attribute.2"}."\n";
You'll get:
Testsubclass baseconstant.1 subclassconstant.2
Testbase baseconstant.1 subclassconstant.2
What you could do now is to write your "own" little local (i don't know why the normal local isn't working even with altering the declarations of $THISCLASSCONSTANT to our)
change your tstbase::_init into:
sub _init {
my $self = shift;
my $oldconstant = $THISCLASSCONSTANT;
$THISCLASSCONSTANT = shift;
foreach (keys %complexdatastructure) {
$self->{$_} = ${$complexdatastructure{$_}};
};
$THISCLASSCONSTANT = $oldconstant;
};
Now i think you have what you want.
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);
I'm writing a download sub module, I would like it looks like this:
Download.pm
Download/Wget.pm
Download/LWP.pm
Download/Curl.pm
Download/Socket.pm
My Download.pm should provide an api sub download($url). It will look for LWP module, then wget command, then curl command, if non of these exist, it will use Socket.
How can I write wrapper module?
Here is some example, how i did it:
How it works? It checks for some condition, and creates object depends on this condition. And subroutine also checks for reference type and calls the right method
file /tmp/Adapt/Base.pm (base module):
#!/usr/bin/perl
package Adapt::Base;
use strict;
use warnings;
sub new {
my $class = shift;
my $self;
if ( time % 3 ) {
require "/tmp/Adapt/First.pm";
$self = \Adapt::First->new(#_);
}
elsif ( time % 2 ){
require "/tmp/Adapt/Second.pm";
$self = \Adapt::Second->new(#_);
}
else {
require "/tmp/Adapt/Default.pm";
$self = \Adapt::Default->new(#_);
}
bless( $self, $class );
}
sub somesub {
my $s = shift;
my $self = $$s;
if ( ref( $self ) eq 'Adapt::First' ) {
$self->firstsub();
}
elsif ( ref( $self ) eq 'Adapt::Second' ) {
$self->secondsub();
}
else {
$self->defaultsub();
}
}
1;
file /tmp/Adapt/First.pm (some module):
#!/usr/bin/perl
package Adapt::First;
use strict;
use warnings;
sub new {
my $class = shift;
my $self = {};
bless( $self, $class );
}
sub firstsub {
print "I am 1st sub.\n";
}
1;
file /tmp/Adapt/Second.pm (another module):
#!/usr/bin/perl
package Adapt::Second;
use strict;
use warnings;
sub new {
my $class = shift;
my $self = {};
bless( $self, $class );
}
sub secondsub {
print "I am 2nd sub.\n";
}
1;
and file /tmp/Adapt/Default.pm (default module):
#!/usr/bin/perl
package Adapt::Default;
use strict;
use warnings;
sub new {
my $class = shift;
my $self = {};
bless( $self, $class );
}
sub defaultsub {
print "I am default sub.\n";
}
1;
and test script:
#!/usr/bin/perl
use strict;
use warnings;
require '/tmp/Adapt/Base.pm';
for (0..10) {
my $test = Adapt::Base->new;
$test->somesub;
sleep 1;
}
output:
dev# perl /tmp/adapt.pl
I am default sub.
I am 1st sub.
I am 1st sub.
I am 2nd sub.
I am 1st sub.
I am 1st sub.
I am default sub.
I am 1st sub.
I am 1st sub.
I am 2nd sub.
I am 1st sub.
dev#
I am reading code snippets like below:
sub new {
my $pkg = shift;
my $args = shift;
my #keys = keys %$args;
my $self = bless \%{$args}, $pkg;
$self->{'__properties'} = \#keys;
my $class = ref($self);
foreach my $meth (#keys) {
if (! $self->can($meth)) {
no strict "refs";
*{ $class . "::" . $meth } = sub {
my $instance = shift;
return $instance->{$meth};
};
}
}
return $self;
}
In the foreach loop, it seems that it creates some methods according to the parameters. There are two lines which I don't understand.Could someone help me? What's the * and {} used for?
no strict "refs";
*{ $class . "::" . $meth }
Best Regards,
This creates a symbol table alias.
The right side contains a reference to a function, so Perl will alias it to the subroutine $meth in the package $class.
See Symbol Tables in perlmod.
As eugene y have already explained, those lines manipulate the symbol table. In practical terms, they do so in order to create read-only accessor methods in the class based on whatever arbitrary list of attributes get passed into the constructor:
#!/usr/bin/env perl
use strict;
use warnings;
use 5.10.0;
package SomeClass;
sub new {
my $pkg = shift;
my $args = shift;
my #keys = keys %$args;
my $self = bless \%{$args}, $pkg;
$self->{'__properties'} = \#keys;
my $class = ref($self);
foreach my $meth (#keys) {
if (!$self->can($meth)) {
no strict "refs";
*{$class . "::" . $meth} = sub {
my $instance = shift;
return $instance->{$meth};
};
}
}
return $self;
}
package main;
my $foo = SomeClass->new({foo => 5}); # Creates SomeClass::foo
say $foo->foo; # 5
my $bar = SomeClass->new({foo => 3, bar => 7}); # Creates SomeClass::bar
say $bar->foo; # 3
say $bar->bar; # 7
say $foo->bar; # undef - ::bar was added to all instances of SomeClass
say $foo->baz; # Boom! No such method.
Personally, I think this is questionable OO practice (a class should generally have a known set of attributes instead of potentially adding new ones each time an instance is constructed), but that's what it does...