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.
