I have this perl object. After the object is instantiated, I'm trying to add a new method to the object within a loader method, that can then be called later.
I've tried a whole bunch of stuff that hasn't worked. Examples include:
sub loader {
my ($self) = @_;
sub add_me {
my ($self, $rec) = @_
warn "yayyyyyy";
return $rec;
}
#here are the things I've tried that dont work:
# &{$self->{add_me}} = \&add_me;
# \&{$self->{add_me}} = \&add_me;
# assuming the class definition is in Holder::Class try to add it to symblol table
# *{Holder::Class::add_me} = \&add_me;
}
EDIT:
The reason that I need to do this is I'm adding a hook in my code where the user of my software will have the ability to inject their own sub to edit a data structure as they will.
To do this, they will be able to edit a secondary file that will only contain one sub and get the data structure in question passed in, so something like:
sub inject_a_sub {
my ($self, $rec) = @_;
#do stuff to $rec
return $rec;
}
then inside my original object upon its instantiation, I check to see if the above mentioned file exists, and if so read its contents and eval them. Lastly, I want to make the eval'd code which is just a sub, a method of my object. To be precise, my object is already inheriting a method called do_something and i want to make the sub read in by the eval override the do_something method being inherited so that when called the sub from the external file runs.
its a weird problem :/
and it hurts me :(
Obi wan kenobi you're my only hope!
Cheers!
If you just want to attach functionality to a specific object, and don't need inheritance, you can store a code ref in the object and call it.
# Store the code in the object, putting it in its own
# nested hash to reduce the chance of collisions.
$obj->{__actions}{something} = sub { ... };
# Run the code
my @stuff = $obj->{__actions}{something}->(@args);
Problem is, you need to check that $obj->{__actions}{something} contains a code reference. What I would suggest is to wrap a method around this procedure.
sub add_action {
my($self, $action, $code) = @_;
$self->{__actions}{$action} = $code;
return;
}
sub take_action {
my($self, $action, $args) = @_;
my $code = $self->{__actions}{$action};
return if !$code or ref $code ne 'CODE';
return $code->(@$args);
}
$obj->add_action( "something", sub { ... } );
$obj->take_action( "something", \@args );
If you already know the class name you want to inject a method into, write the subroutine as normal but use the fully qualified name.
sub Some::Class::new_method {
my $self = shift;
...
}
Note that any globals inside that subroutine will be in the surrounding package, not in Some::Class. If you want persistent variables use state inside the subroutine or my outside the subroutine.
If you don't know the name at compile time, you'll have to inject the subroutine into the symbol table, so you were close with that last one.
sub inject_method {
my($object, $method_name, $code_ref) = @_;
# Get the class of the object
my $class = ref $object;
{
# We need to use symbolic references.
no strict 'refs';
# Shove the code reference into the class' symbol table.
*{$class.'::'.$method_name} = $code_ref;
}
return;
}
inject_method($obj, "new_method", sub { ... });
Methods in Perl are associated with a class, not an object. In order to assign a method to a single object, you have to put that object into its own class. Similar to the above, but you have to create a subclass for every instance.
my $instance_class = "_SPECIAL_INSTANCE_CLASS_";
my $instance_class_increment = "AAAAAAAAAAAAAAAAAA";
sub inject_method_into_instance {
my($object, $method_name, $code_ref) = @_;
# Get the class of the object
my $old_class = ref $object;
# Get the special instance class and increment it.
# Yes, incrementing works on strings.
my $new_class = $instance_class . '::' . $instance_class_increment++;
{
# We need to use symbolic references.
no strict 'refs';
# Create its own subclass
@{$new_class.'::ISA'} = ($old_class);
# Shove the code reference into the class' symbol table.
*{$new_class.'::'.$method_name} = $code_ref;
# Rebless the object to its own subclass
bless $object, $new_class;
}
return;
}
I left out the code to check whether or not the instance has already had this treatment by checking if its class matches /^${instance_class}::/. I leave that as an exercise for you. Creating a new class for every object is not cheap and will cost memory.
There are valid reasons to do this, but they are exceptional. You should really, really question whether you should be doing this sort of monkey patching. In general, action at a distance should be avoided.
Can you accomplish the same thing using a subclass, delegation or role?
There already exist Perl OO systems which will do this for you and much much more. You should be using one. Moose, Moo (via Role::Tiny) and Mouse can all add roles to an instance.
