I have a module foo that has extended sub-modules bar and baz. I want bar and baz to modify the same set of hashes that are in foo.
Right now I have something like:
my $foo = new foo;
my $bar = new foo::bar( $foo );
$bar->doStuff();
$bar->printSelf();
my $baz = new foo::bar( $foo );
$baz->doOtherStuff();
$baz->printSelf();
Inside one of the sub-modules the constructor looks like:
sub new {
my $class = shift;
my $self = shift;
--stuff--
bless $self, $class;
return $self;
}
Please don't laugh too hard. Is there a way I can do this without passing in $foo?
Thanks for reading. :)
I prefer to share things through methods. That way, no one has to know anything about the data structures or variables names (although you do need to know the method name):
{
package SomeParent;
my %hash1 = ();
my %hash2 = ();
sub get_hash1 { \%hash1 }
sub get_hash2 { \%hash2 }
sub set_hash1_value { ... }
sub set_hash1_value { ... }
}
Since SomeParent provides the interface to get at the private data structures, that's what you use in SomeChild:
{
package SomeChild;
use parent 'SomeParent';
sub some_method {
my $self = shift;
my $hash = $self->get_hash1;
...;
}
sub some_other_method {
my $self = shift;
$self->set_hash2_value( 'foo', 'bar' );
}
}
Your question is not very clear nor there is any code with hashes. But if you need module variables modified, you can use fully qualified name:
package Foo; # don't use lowercase named, they are reserved for pragmas
our %hash1 = ();
our %hash2 = ();
package Foo::Bar;
use Data::Dump qw(dd);
sub do_stuff {
$Foo::hash1{new_item} = 'thing';
}
sub do_other_stuff {
dd \%Foo::hash1;
}
package main;
Foo::Bar->do_stuff();
Foo::Bar->do_other_stuff();
But if you need to modify instance variables, you need to have reference to this instance. I see some strategies that would work:
inherit from Foo, so the hashes will be in instance of Foo::Bar
pass reference to Foo in constructor and store it as property in Foo::Bar
pass Foo reference as parameter to method
Proper solution depends on what you are trying to do and how you going to use it.
Related
I'd like to be able to "inject" methods in a class on the fly, similarly to what happens with Mojolicious helpers. Something like this:
my $s = SomeThing->new;
$s->helper(do_this => sub {
my $self = shift;
$foo = shift;
});
$s->do_this('bar');
I've made it some distance, but I would like the subs that get injected to be operating in the namespace of the class they get injected into, not in the main one. In other words this currently works as follows:
$s->do_this('bar');
print 'in main: ', $foo;
this prints "bar" - and I'd like it not to, while I'd like this
print 'in SomeThing: ', $SomeThing::foo;
to print "bar" instead
while this works but seems clunky to me
$s->helper(do_this => sub {
my $self = shift;
${(ref $self) . '::foo'} = shift;
});
$s->do_this('foo');
print 'in SomeThing: ', $SomeThing::foo; # now this prints "foo"
The package where all this happens looks like this:
package SomeThing {
use Mojo::Base -base;
use Carp;
sub helper {
my $self = shift;
my $name = shift || croak "The helper name is required";
my $sub = shift || sub {};
my $namespace = __PACKAGE__;
no strict 'refs';
{
*{"$namespace\::$name"} = $sub
}
}
};
Is there a way to do this? I suspect I'd be messing up strictness real bad - but I kind of don't want to give up just yet (and it'd be a nice trick to learn).
You are asking to change the package associated with an already-compiled anon sub for the purpose of variable lookups. I don't know if that's possible.
Even if it was possible, it's not something you want to do because your code still wouldn't work. You'd have to add use vars qw( foo ); to the file in which the sub { } literal is found. And that's in addition to using our $foo; or use vars qw( $foo ); in Something.pm if you accessed it there.
That's pretty magical and messy. And it's easily avoided by using accessors. Simple replace
$s->helper(
do_this => sub {
my $self = shift;
$foo = shift;
},
);
with
$s->helper(
do_this => sub {
my $self = shift;
$self->foo(shift);
},
);
If you also need to add the accessor, you can use the following:
$s->helper(
foo => sub {
shift;
state $foo;
$foo = shift if #_;
$foo
},
do_this => sub {
my $self = shift;
$self->foo(shift);
},
);
As an aside, monkey_patch from Mojo::Util can be used as a replacement for helper. (Credit to #brian d foy for bringing it up.) It does the same thing, but it has the two added benefits:
You don't need to support it.
It sets the name of the anon sub so that stack traces use a meaningful name instead of __ANON__.
Switching to monkey_patch doesn't address your problem, but I do recommend using it (or similar) in addition to the change of approach I mentioned above.
use Mojo::Util qw( );
sub helper { shift; Mojo::Util::monkey_patch(__PACKAGE__, #_); }
Consider roles.
# role module
package SomeThing::Role::Foo;
use Role::Tiny;
sub foo { 42 }
1;
# user
use strict;
use warnings;
use SomeThing;
use With::Roles;
my $something_with_foo = SomeThing->with::roles('+Foo');
# new subclass of SomeThing, doesn't affect other usage of SomeThing
my $obj = $something_with_foo->new;
# can also dynamically apply to an existing object
my $obj = SomeThing->new->with::roles('+Foo');
print $obj->foo;
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 a way to fetch the objects of a particular class in perl ?
Example :
use <class1>;
use <class2>
sub Main {
my $call1 = <class1>->new(<ARGS>)->(<Routine call>);
my $call2 = <class1>->new(<ARGS>)->(<Routine call>);
my $call3 = <class1>->new(<ARGS>)->(<Routine call>);
.
.
.
my $call4 = <class2>->new(<ARGS>)->(<Routine call>);
}
Would one be able to fetch the objects of <class1> ?
$call1
$call2
and
$call3
There are a few pointers here:
How can I list all variables that are in a given scope?
With this tool: http://search.cpan.org/dist/PadWalker/PadWalker.pm you can access all of the package and lexcial variables in a given scope.
Or you can access the symbol table also directly for a given scope: keys %{'main::'}
And you can get the type/class of a variable with ref(). http://perldoc.perl.org/functions/ref.html
I don't think there are direct solutions for your problem.
Perhaps you could extend the class and collect the instances to a hash table in an overridden constructor.
The normal technique would be to write Class1 in such a way that its constructor keeps a (presumably weak) reference to each object that is constructed in an array or hash somewhere. If you're using Moose, there's an extension called MooseX::InstanceTracking that makes that very easy to do:
package Class1 {
use Moose;
use MooseX::InstanceTracking;
# ... methods, etc here.
}
package Class2 {
use Moose;
extends 'Class1';
}
my $foo = Class1->new;
my $bar = Class1->new;
my $baz = Class2->new;
my #all = Class1->meta->get_all_instances;
If you're not using Moose; then it's still pretty easy:
package Class1 {
use Scalar::Util qw( weaken refaddr );
my %all;
sub new {
my $class = shift;
my $self = bless {}, $class;
# ... initialization stuff here
weaken( $all{refaddr $self} = $self );
return $self;
}
sub get_all_instances {
values %all;
}
sub DESTROY {
my $self = shift;
delete( $all{refaddr $self} );
}
# ... methods, etc here.
}
package Class2 {
our #ISA = 'Class1';
}
my $foo = Class1->new;
my $bar = Class1->new;
my $baz = Class2->new;
my #all = Class1->get_all_instances;
I have a legacy project and I would like to extend a couple of classes in it with a few attributes and methods. I have access to the source code and know that the class uses a blessed hashref. I can of course go ahead and extend that hashref adding the keys that I want and re-bless into my class. But obviously this breaks encapsulation and I would like to avoid it as much as I can.
Is there a way to extend a (non-Moose) Perl class with attributes, not just methods, in a way that does not break encapsulation of the orginal class? The option to use Moose to do this is not available. Thank you.
First, one best practice for writing objects based on hashrefs is to prefix all fields with the package name, e.g.
package Parent;
sub new {
my ($class, $x, $y) = #_;
bless { "Parent::x" => $x, "Parent::y" => $y } => $class;
}
sub x { shift()->{"Parent::x"} }
sub y { shift()->{"Parent::y"} }
In that case, the issue doesn't arise, as every class has its own attribute namespace. But who writes his classes that way?
There are two ways I can think of to circumvent any problems: Proxying the original object via Autoload, or using inside-out object patterns. The third solution is to use prefixed attributes in your class, and hope that the parent never ever uses these names.
Inside-Out Objects
An inside-out object uses the blessed reference as an ID, and stores the attributes in lexical variables inside your class:
package Child;
use Scalar::Util qw/refaddr/;
use parent 'Parent';
my %foo;
sub new {
my ($class, $foo, #args) = #_;
my $self = $class->SUPER::new(#args);
$foo{refaddr $self} = $foo;
return $self;
}
sub foo {
my ($self) = #_;
$foo{refaddr $self};
}
sub set_foo {
my ($self, $val) = #_;
$foo{refaddr $self} = $val;
}
sub DESTROY {
my ($self) = #_;
# remove entries for this object
delete $foo{refaddr $self};
$self->SUPER::DESTROY if $self->SUPER::can('DESTROY');
}
This is a slightly dated pattern, but it works extremely well for your use case.
Proxy objects
We can contain a parent instance in a field of our class (i.e. both has-a and is-a relationship). Whenever we encounter unknown methods, we delegate to that object:
package Child;
use Parent ();
our $SUPER = 'Parent';
use Carp;
sub new {
my ($class, $foo, #args) = #_;
bless {
parent => $SUPER->new(#args),
foo => $foo,
} => $class;
}
sub foo {
my ($self) = #_;
$self->{foo};
}
sub set_foo {
my ($self, $val) = #_;
$self->{foo} = $val;
}
# manually establish pseudo-inheritance
# return true if our class inherits a given package
sub isa {
my ($self, $class) = #_;
return !!1 if $class eq __PACKAGE__;
return +(ref $self ? $self->{parent} : $SUPER)->isa($class);
}
# return a coderef to that method, or false
sub can {
my ($self, $meth) = #_;
my %methods = (new => \&new, foo => \&foo, set_foo => \&set_foo, DESTROY => \&DESTROY);
if (my $code = $methods{$meth}) {
return $code;
}
# check parent
my $code = ( ref $self ? $self->{parent} : $SUPER)->can($meth);
return undef unless $code;
return sub {
my $self = shift;
unshift #_, ref $self ? $self->{parent} : $self;
goto &$code;
};
}
# write explicit destroy to satisfy autoload
sub DESTROY {
my ($self) = #_;
$self->{parent}->DESTROY if ref $self and $SUPER->can('DESTROY');
}
sub AUTOLOAD {
# fetch appropriate method coderef
my $meth = our $AUTOLOAD;
$meth =~ s/.*:://; # clean package name from name
my $code = $_[0]->can($meth);
$code or croak qq(Can't locate object method "$meth" via package "#{[__PACKAGE__]}");
goto &$code;
}
The ugly part is to fake methods defined in superclasses in the can code: We have to wrap the actual method inside a anonymous sub that unpacks our object to call the method on the proxied object. The gotos make our extra levels invisible to the called code, which is neccessary when somebody uses caller.
Most of this boilerplate proxying code can be abstracted into another module (and probably is, somewhere on CPAN).
How would I create my class such that some methods will exist in the instance only if certain values were passed to the constructor?
Perhaps a more generic way of asking is: How can I add a method to an existing class instance?
You can attach an anonymous sub to an object based on flags:
use strict;
use warnings;
package Object;
sub new {
my $class = shift;
my $self = bless {}, $class;
my %args = #_;
if ($args{method}) {
$self->{method} = sub { print "hello\n" }
}
return $self;
}
sub method {
my $self = shift;
if (not defined $self->{method}) {
warn "Not bound\n";
return;
}
$self->{method}->();
}
1;
to use:
use Object;
my $obj1 = Object->new(method=>1);
$obj1->method();
my $obj2 = Object->new();
$obj2->method();
You can extend this to a number of methods through the same interface.
You can use Moose to apply a role at runtime.
package My::Class;
use Moose;
has foo => ( isa => 'Str', is => 'ro', required => 1 );
sub BUILD {
my $self = shift;
if ($self->foo eq 'bar') {
My::Class::Role->meta->apply($self);
}
}
no Moose;
package My::Class::Role;
use Moose::Role;
sub frobnicate {
my $self = shift;
print "Frobnicated!\n";
}
no Moose;
my $something = My::Class->new( foo => 'bar' );
print $something, "\n";
$something->frobnicate;
my $something_else = My::Class->new( foo => 'baz' );
print $something_else, "\n";
$something_else->frobnicate;
Gives:
Moose::Meta::Class::__ANON__::SERIAL::1=HASH(0x2fd5a10)
Frobnicated!
My::Class=HASH(0x2fd2c08)
Can't locate object method "frobnicate" via package "My::Class" at testmoose.pl line 32.
use AUTOLOAD to define the function. As a example method foo is called if $self->{foo} exists
sub AUTOLOAD {
my $methodname = $AUTOLOAD;
if ($methodname eq "foo" && exists($_[0]->{foo})){
goto &fooimplementationsub;
}
return;
}
An alternative technique is to use globs to define a new method at runtime
*PACKAGE::method = sub {
#code here
};
This has the disadvantage that the method is now visible to all instances of the class so is not quite what you want.
A third and possibly more risky/inefficient method is to use string eval
eval <<EOF
sub foo {
#code here
};
EOF
Again this has the disadvantage that the method is now visible to all instances of the class so is not quite what you want.
Methods are just subroutines in a package, and a package is just a hash holding typeglobs. And hashes can be modified at runtime.
So you could, in theory, add or remove methods given values in a constructor.
package WeirdClass;
sub new {
my ($class, $name, $code) = #_;
if ($name) {
no strict;
*{__PACKAGE__ . "::$name"} = $code;
}
bless {} => $class;
}
And then use it like:
my $object = WeirdClass->new(foo => sub {say "foo"});
$object->foo(); # prints "foo\n";
However, this method is available for all objects of that class:
my $another_object = WeirdClass->new();
$another_object->foo; # works too.
Using autoload, one can mock arbitrary methods:
package BetterClass;
sub new {
my ($class, %args) = #_;
bless \%args => $class;
}
# destructor will be called at cleanup, catch with empty implementation
sub DESTROY {};
sub AUTOLOAD {
my $self = shift;
(my $method = our $AUTOLOAD) =~ s/.*://; # $AUTOLOAD is like "BetterClass::foo"
# check if method is allowed
die "forbidden method $method" unless $self->{can}{$method};
# mock implementations
given ($method) {
say "foo" when "foo";
say "bar" when "bar";
when ("add") {
my ($x, $y) = #_;
return $x + $y;
}
default { die "unknown method $method" }
}
}
Then:
my $o = BetterClass->new(can => { foo => 1, bar => 0});
$o->foo;
my $p = BetterClass->new(can => {bar => 1, add => 1});
$p->bar;
say $p->add(5, 6);
Of course, these techniques can be combined freely.
Edit: can()
To make the AUTOLOAD work with can, the protected methods should be moved into a data structure:
my %methods;
BEGIN {
%methods = (
foo => sub {say "foo"},
bar => sub {say "bar"},
add => sub {
my ($self, $x, $y) = #_;
$x + $y;
},
);
}
Then override the can method:
# save a reference to the origional `can` before we override
my $orig_can;
BEGIN{ $orig_can = __PACKAGE__->can("can") }
sub can {
my ($self, $meth) = #_;
# check if we have a special method
my $code = $methods{$meth} if ref $self and $self->{can}{$meth};
return $code if $code;
# check if we have a normal method
return $self->$orig_can($meth);
}
And AUTOLOAD would change to
my ($self) = #_; # do not `shift`
(my $method = our $AUTOLOAD) =~ s/.*://;
my $code = $self->can($method) or die "unknown method $method";
goto &$code; # special goto. This is a AUTOLOAD idiom, and avoids extra call stack frames
Don't do too much magic. I've gotten away from AUTOLOAD because it causes maintenance issues where mysterious methods suddenly appear and disappear.
One way to handle what you want is to define all the methods you need, and if a particular object is of the wrong type, simply cause that method to croak:
sub Foo {
my $self = shift;
my $parameter = shift;
if ( $self->Class_type ne "Foo" ) {
croak qq(Invalid method 'Foo' on object #{[ref $self]});
}
print "here be dragons\";
return "Method 'Foo' successfully called";
}
The above will not allow method Foo to be called unless the class type is Foo.
If your objects won't change (or you don't want them to change) once an object is created, you can define that object as a sub-class.
Before you bless a newly created object, check that special value and decide whether or not you need to create a specific sub-class instead.
package My_class;
sub new {
my $class = shift;
my $class_type = shift;
my $self = shift;
if ( $class_type eq "Foo" ) {
bless $self, "My_class::Foo";
}
else {
bless $self, $class;
}
package My_class::Foo;
use base qw(My_class);
sub Foo {
my $self = shift;
return "Foo Method successfully called!";
}
Notice that my class My_class::Foo is a sub-class of My_class via the use base pragma. That means all methods for My_class are valid with objects of My_class::Foo. However, only objects of My_class::Foo can call the Foo method.
When I create my object (via the new subroutine), I look at the $class_type parameter. If it's a type Foo, I bless the class as My_class::Foo.
Here's an example where I use sub-classes to do what you want.
Every object is a class type of Question. You can see my constructor on line 1129. I pass in a question type as one of the parameters to my constructor.
In line 1174 to 1176, I create my object, but then append the question type to the class, and then bless the question as that sub-class type. All of my subclasses are a type Question (see my use base qw(Question); below each package declaration. However, only questions of sub-class Question::Date and Question::Regex have a method Format. And, only objects of type Question::Words have a method Force.
Hope this helps.
None of the answers so far given actually handle the question actually asked.
Adding methods to an instance in Perl is not directly supported. Object instances are always instances of some class, and that class is the thing that actually has methods. You cannot add a method to a single instance of a class, without making that method also available on every other instance of the same class.
For your problem you have two basic solutions:
Provide the methods always, but test a flag to see whether the method should apply to the given instance or not. This is by far the simplest.
Bless each object into subclasses depending on the flags. Subclass the main class to provide those methods as appropriate.
If you truely want to add methods on individual instances, then what you'll have to do is arrange that every instance is a single instance of a newly-derived class for every object. This gets harder to arrange for, doubly-so if you want to avoid leaking memory and cleaning up the classes once the objects are DESTROYed. This would however allow truely per-instance methods.
Since it is highly unlikely you'll truely need this third option it is far better to go with one of the first.