In my Perl (v5.30.0) script, I have the world's simplest object:
#!/usr/bin/perl
use warnings;
use strict;
use Data::Dumper;
package Thingee;
# Constructor with name new
sub new
{
my $type = shift;
my %params = #_;
my $self = {};
$self->{'somedata'} = $params{'somedata'};
bless $self, $type;
}
sub printMe
{
my ($self) = #_;
printf "Data: \"%s\"\n", $self->{'somedata'}; # LINE 19
}
What could be simpler? Now, in the "main" body of my script, I create a list of Thingee objects. What I'm discovering is that the newly-created Thingees seem to be blessed upon creation... but if I pass the list to a subroutine, the same objects are seen as unblessed. Here's the code:
package main;
sub foo
{
print "foo() ==========================================\n";
my #ObjectArr = #_;
print Dumper(#ObjectArr);
foreach my $obj (#ObjectArr)
{
$obj->printMe(); # LINE 33
}
}
# I make a list of objects:
my #ObjectArr = ();
push #ObjectArr, Thingee->new( 'somedata' => "My dog has fleas" );
push #ObjectArr, Thingee->new( 'somedata' => "My cat is fine" );
foreach my $obj (#ObjectArr)
{
$obj->printMe();
}
foo(\#ObjectArr);
Output is:
Data: "My dog has fleas"
Data: "My cat is fine"
foo() ==========================================
$VAR1 = [
bless( {
'somedata' => 'My dog has fleas'
}, 'Thingee' ),
bless( {
'somedata' => 'My cat is fine'
}, 'Thingee' )
];
Can't call method "printMe" on unblessed reference at ./PassHash6.perl line 33.
Frustrating. In the "main" part of the code, I can iterate through the foreach loop, and the newly-created Thingee objects are accessible. But within the scope of subroutine foo(), the exact same foreach loop throws the Can't call method "printMe" on unblessed reference error. Harmuph!
My favorite explanation for why blessing is necessary comes from this SO post:
An unblessed reference is one where one variable is not a legal
reference to an object[.]
Okay, that makes sense. But then how can all of the following be true:
My Thingees are blessed within the scope of the "main" code
My Thingees are not blessed within the scope of foo()
Within foo(), my Thingees are nonetheless visible in the eyes of Data:Dumper()
Just for giggles, I modified the foreach() block within foo() to this:
foreach my $obj (#ObjectArr)
{
bless $obj, "Thingee"; # New command here
$obj->printMe(); # LINE 34
}
But now the script throws this error:
<EVERYTHING FROM BEFORE...>
Not a HASH reference at ./PassHash6.perl line 19.
Ugh. Line 19 is from the package Thingee section:
sub printMe
{
my ($self) = #_;
printf "Data: \"%s\"\n", $self->{'somedata'}; # LINE 19
}
Does anyone see what I'm doing wrong?
You are passing a reference to an array to foo
foo(\#ObjectArr);
Inside of foo, you do
my #ObjectArr = #_;
#ObjectArr contains a exactly one element, the referenced passed to foo. This is not what you intended.
Option 1: foo accepts a reference to an array.
sub foo {
my $objs = shift;
$_->printMe() for #$objs;
}
foo( \#objs );
Option 2: foo accepts objects.
sub foo {
$_->printMe() for #_;
}
foo( #objs );
Related
I want to create a hash reference with code references mapped to scalars (strings) as its members.
So far I have a map reference that looks something like this:
my $object;
$object = {
'code1' => sub {
print $_[0];
},
'code2' => sub {
return 'Hello, World!';
},
'code3' => sub {
$object->{code1}->($object->{code2}->());
}
};
$object->{code3}->();
I would like to be able to "bless" the 'code3' reference in $object with $object, so I can do something like:
my $object;
$object = {
'code1' => sub {
print $_[0];
},
'code2' => sub {
return 'Hello, World!';
},
'code3' => sub {
$self = shift;
$self->{code1}->($self->{code2}->());
}
};
$object->{code3}->();
However, bless only works with packages, rather than hash tables.
Is there a way to do this in Perl 5 version 22?
Note: now that I think of it, it's better to pass $object to the method explicitly, as it solves JavaScript's "this" problem. I am just too used to Java's "this" which makes sense in Java where everything is a class and therefore all methods have a "this", but in scripting, it really helps to know if the "this" is actually passed, or is it just called as a function(and you end up accidentally polluting global scope or triggering strict warning) passing $self explicitly makes it clear that you are not calling it as a function, but as a method.
You are doing sub calls (not method calls), so you simply forgot to pass $self as a parameter.
my $object = {
code1 => sub {
print $_[0];
},
code2 => sub {
return 'Hello, World!';
},
code3 => sub {
my $self = shift;
$self->{code1}->( $self, $self->{code2}->($self) );
}
};
$object->{code3}->($object);
But I think you're trying to create JavaScript-like objects. You can start with the following:
package PrototypeObject;
sub new {
my $class = shift;
my $self = bless({}, $class);
%$self = #_;
return $self;
}
sub AUTOLOAD {
my $self = shift;
( my $method = our $AUTOLOAD ) =~ s/^.*:://s;
return $self->{$method}->($self, #_);
}
1;
use PrototypeObject qw( );
my $object = PrototypeObject->new(
code1 => sub {
print $_[1];
},
code2 => sub {
return 'Hello, World!';
},
code3 => sub {
my $self = shift;
$self->code1( $self->code2() );
}
);
$object->code3();
Note that this will slow down your method calls as it must call AUTOLOAD before calling your method. This could be addressed by overloading the method call operator.
Check on CPAN. Someone might already have a more complete implementation.
This is not the exact syntax you want, but Perl 5 supports many ways of making method calls, including method calls via strings. So you could say:
#!/usr/bin/perl
{ package Foo;
use strict;
use warnings;
sub new { bless {}, shift }
sub code1 { my $self = shift; print "$_[0]\n" };
sub code2 { "Hello, World!" }
sub code3 {
my $self = shift;
my $method1 = "code1";
my $method2 = "code2";
$self->$method1($self->$method2);
}
}
use strict;
use warnings;
my $o = Foo->new;
print "normal call\n";
$o->code3;
print "via string\n";
my $method = "code3";
$o->$method;
Also, remember that a package's symbol table is a hash: %Foo::, so you can always go spelunking in there yourself:
#!/usr/bin/perl
{ package Foo;
use strict;
use warnings;
sub new { bless {}, shift }
sub code1 { my $self = shift; print "$_[0]\n" };
sub code2 { "Hello, World!" }
sub code3 {
my $self = shift;
my $method1 = "code1";
my $method2 = "code2";
$self->$method1($self->$method2);
}
}
use strict;
use warnings;
print $Foo::{code2}->(), "\n";
However, I would suggest having a really code reason for these techniques as it can make maintenance a nightmare (eg imaging trying to find all of the code calling Foo::approved, you can't just grep for "->approved" because the actual call is ->$state()).
I just read the comments and noticed you said
my concern with packages is that I can't seem to create packages at runtime, but I can create hash tables at runtime
Perl 5 does allow you to create packages at runtime. In fact, depending on how you define runtime, you can do anything at runtime with string eval as it reenters compile time when it is called. But there is also a pure-runtime method of manipulating the symbol tables with typeglobs:
#!/usr/bin/perl
{ package Foo;
use strict;
use warnings;
sub new { bless {}, shift }
}
use strict;
use warnings;
my $o = Foo->new;
# here we add functions at runtime to the package Foo
{
no warnings "once";
*Foo::code1 = sub { my $self = shift; print "$_[0]\n" };
*Foo::code2 = sub { "Hello, World!" };
*Foo::code3 = sub {
my $self = shift;
my $method1 = "code1";
my $method2 = "code2";
$self->$method1($self->$method2);
};
}
$o->code3;
Because Perl 5 is object oriented (and not object based like JavaScript) these methods are attached to all Foo objects. If you want individual objects have their own symbol tables, then I am there are certainly ways to do that. Off the top of my head, AUTOLOAD comes to mind:
#!/usr/bin/perl
{ package Foo;
use strict;
use Carp;
use warnings;
sub new {
bless {
symtab => {}
}, shift
}
sub AUTOLOAD {
my $self = shift;
our $AUTOLOAD;
my $method = $AUTOLOAD =~ s/.*:://r;
my (undef, $file, $line) = caller();
die "$method does not exist at $file line $line"
unless exists $self->{symtab}{$method};
$self->{symtab}{$method}->($self, #_);
}
sub DESTROY {} # prevent DESTROY method from being hijacked by AUTOLOAD
}
use v5.22;
use warnings;
my $o1 = Foo->new;
my $o2 = Foo->new;
$o1->{symtab}{inc} = sub { my $self = shift; $self->{i}++; };
$o1->inc;
$o1->inc;
$o1->inc;
say "inc called on o1 $o1->{i} times";
$o2->inc; #dies because we haven't defined inc for $o2 yet
Perl 5 is very flexible and will let you do just about anything you want (after all the motto is TIMTOWTDI), but you should always keep in mind the future programmer tasked with maintaining your code who may want to hunt you down and wear your skin for doing some of these tricks.
This question has a definite XY problem feel. It seems like you are trying to solve a problem in Perl 5 the same way you would have solved it in JavaScript. While Perl 5 will let you do that (as I have demonstrated), there may be a more idiomatic way of achieving the same effect. Can you describe what you are trying to do (not how you want to do it) in a different question and we can suggest the ways in which we would solve your problem.
I followed what friedo said here.
Now, when I try to call the method testScript I get the error global symbol $obj requires explicit package name and it fails to call testScriptTwo.
use strict;
use warnings;
package Test;
use Method::Signatures;
method new {
my $obj = bless {}, $self;
return $obj;
}
method testScript {
$obj->testScriptTwo(); # Error happens here
}
method testScriptTwo { ... }
Test script:
use Test;
my $class = Test->new();
$class->testScript();
How do I make use of $obj to call methods within the package itself?
Use this instead:
method testScript {
$self->testScriptTwo();
}
The first argument is in the variable $self, not $obj
Your questions seem to indicate you do not understand the basics of scope, and how plain Perl objects work.
In Perl, when you use the ->method syntax on a package name or blessed reference, the subroutine method in that package is invoked. The first argument to the subroutine is the thing on which you invoked method.
So, if you do
My::Friend->new('Alfred');
the new subroutine in the package My::Friend receives two arguments. My::Friend and Alfred.
In a new method, it is customary to refer to the first argument as $class, but that is completely up to you. You could use $basket_case if you were so inclined:
sub new {
my $basket_case = shift;
my $basket = shift;
my $obj = bless { name => $basket } => $basket_case;
return $obj;
}
If you then invoke a method on the returned reference, that method will receive said reference as its first argument, allowing you to access data stored in that reference:
sub blurb {
my $schmorp = shift;
print $schmorp->{name}, "\n";
return;
}
Putting it all together:
#!/usr/bin/env perl
package My::Package;
use strict;
use warnings;
sub new {
my $basket_case = shift;
my $basket = shift;
my $obj = bless { name => $basket } => $basket_case;
return $obj;
}
sub blurb {
my $schmorp = shift;
print $schmorp->{name}, "\n";
return;
}
sub derp {
my $herp = shift;
printf "%s derp derp\n", $herp->{name};
return;
}
package main;
my $x = My::Package->new('Alfred');
$x->blurb;
$x->derp;
Output:
Alfred
Alfred derp derp
You need to understand these basics. Trying to put another layer of abstraction on top of the basics before understanding what is underneath will not make things any easier.
Now, if you are using Method::Signatures, it, by convention, puts that implicit first argument in a lexically scoped variable which, by default, it calls $self.
You can override that name in specific methods, and doing so in new might be a good idea to convey the fact that it doesn't expect an object instance; instead it returns a new instance.
Whatever you called that lexically scoped instance variable in one sub does not affect what it is called in another sub. For example:
#!/usr/bin/env perl
use strict;
use warnings;
sub a_number {
my $number = int(rand(10));
return $number;
}
sub square_that_number {
my $x = shift;
return $x * $x;
}
my $bzzzt = a_number();
my $trrrp = square_that_number($bzzzt);
print $trrrp, "\n";
Output:
$ ./zt.pl
36
OK, you need to backtrack a bit - you're new method is broken in the first place, which indicates that you don't really understand what's going on with OO perl.
A very simple object looks like this:
package Foo;
sub new {
#when Foo -> new is called, then 'Foo' is passed in as the class name
my ( $class ) = #_;
#create an empty hash reference - can be anything, but $self is the convention
my $self = {};
#tell perl that $self is a 'Foo' object
bless ( $self, $class );
#return the reference to your `Foo` object
return $self;
}
sub set_name {
my ( $self, $new_name ) = #_;
$self -> {name} = $new_name;
}
sub get_name {
my ( $self ) = #_;
return $self -> {name};
}
When you call this in your code:
use Foo;
my $new_instance = Foo -> new();
The class is passed into the new method, which you then use bless to create an instantiated object.
Then you can 'do stuff' with it - when you 'call' a method using -> then the first argument into the subroutine is the object reference.
So
$new_instance -> set_name ( "myname" );
print $new_instance -> get_name();
Is equivalent to:
Foo::set_name($new_instance, "myname" );
print Foo::get_name($new_instance);
You act on $new_instance which is a sort of magic hash that allows you to include code.
Method::Signatures is largely irrelevant until you understand the basics of OO. But what that does is 'simply' expand the functions within a module, such that you don't have to extract self/class etc.
By default, a method defined as method provides $self automatically. no $obj like you're using. That's a variable that's local to you new method, and simply doesn't exist outside that.
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 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.
Similar to this question about iterating over subroutine references, and as a result of answering this question about a OO dispatch table, I was wondering how to call a method reference inside a reference, without removing it first, or if it was even possible.
For example:
package Class::Foo;
use 5.012; #Yay autostrict!
use warnings;
# a basic constructor for illustration purposes....
sub new {
my $class = shift;
return bless {#_}, $class;
}
# some subroutines for flavor...
sub sub1 { say 'in sub 1'; return shift->{a} }
sub sub2 { say 'in sub 2'; return shift->{b} }
sub sub3 { say 'in sub 3'; return shift->{c} }
# and a way to dynamically load the tests we're running...
sub sublist {
my $self = shift;
return [
$self->can('sub1'),
$self->can('sub3'),
$self->can('sub2'),
];
}
package main;
sub get_index { ... } # details of how we get the index not important
my $instance = Class::Foo->new(a => 1, b => 2, c => 3);
my $subs = $instance->sublist();
my $index = get_index();
# <-- HERE
So, at HERE, we could do:
my $ref = $subs->[$index];
$instance->$ref();
but how would we do this, without removing the reference first?
Edit:
Changed code example so people don't get hung up on implementation details (sigh, tried my best). The important difference between this and the first link I gave was that the function should be invoked as a method, not as a straight subroutine.
Edit 2:
See the discussion in the linked comment about the technical details, and why the longer way (storing the subref to a variable, then calling it) is probably preferable.
As written, you can get away with
$tests->[$index]();
because the methods in your question aren't using $self.
You could pass $instance explicitly, but that's clunky. Better would be to simulate delegates with closures:
sub sublist {
my $self = shift;
my $sublist;
for (qw/ sub1 sub3 sub2 /) {
my $meth = $_;
push #$sublist => sub { $self->$meth() };
}
return $sublist;
}
If you prefer to be concise, use
sub sublist {
my $self = shift;
return [ map { my $meth = $_; sub { $self->$meth() } }
qw/ sub1 sub3 sub2 / ];
}
Calling one at random is still
$tests->[$index]();
but now the methods get invocants.
Update
Grabbing subrefs via can appears to be unnecessary complexity. If a runtime-determined list of names of methods to call will do, then you can simplify your code greatly:
sub sublist {
my $self = shift;
return [ qw/ sub1 sub3 sub2 / ];
}
Below, we call them all for testing purposes, but you can also see how to call only one:
foreach my $method (#$subs) {
my $x = $instance->$method();
say "$method returned $x";
}
Output:
in sub 1
sub1 returned 1
in sub 3
sub3 returned 3
in sub 2
sub2 returned 2
(Temporary placeholder here until/unless the original poster of the answer returns):
The trick is adding a dereference:
$instance->${\$sublist->[$index]}(#args);
thus you can also do:
$instance->${\$instance->sublist->[$index]}(#args);
otherwise it thinks it's a scalar to dereference. (eg, Not a SCALAR reference at script.pl, line XX).