How can I monkey-patch an instance method in Perl?

Question

I'm trying to monkey-patch (duck-punch :-) a LWP::UserAgent instance, like so:

sub _user_agent_get_basic_credentials_patch {   return ($username, $password); }  my $agent = LWP::UserAgent->new(); $agent->get_basic_credentials = _user_agent_get_basic_credentials_patch; 

This isn't the right syntax -- it yields:

Can't modify non-lvalue subroutine call at [module] line [lineno].

As I recall (from Programming Perl), dispatch lookup is performed dynamically based on the blessed package (ref($agent), I believe), so I'm not sure how instance monkey patching would even work without affecting the blessed package.

I know that I can subclass the UserAgent, but I would prefer the more concise monkey-patched approach. Consenting adults and what have you. ;-)

Answer 1

As answered by Fayland Lam, the correct syntax is:

    local *LWP::UserAgent::get_basic_credentials = sub {         return ( $username, $password );     }; 

But this is patching (dynamically scoped) the whole class and not just the instance. You can probably get away with this in your case.

If you really want to affect just the instance, use the subclassing you described. This can be done 'on the fly' like this:

{    package My::LWP::UserAgent;    our @ISA = qw/LWP::UserAgent/;    sub get_basic_credentials {       return ( $username, $password );    };     # ... and rebless $agent into current package    $agent = bless $agent; } 

Answer 2

If dynamic scope (using local) isn't satisfactory, you can automate the custom package reblessing technique:

MONKEY_PATCH_INSTANCE: {   my $counter = 1; # could use a state var in perl 5.10    sub monkey_patch_instance   {     my($instance, $method, $code) = @_;     my $package = ref($instance) . '::MonkeyPatch' . $counter++;     no strict 'refs';     @{$package . '::ISA'} = (ref($instance));     *{$package . '::' . $method} = $code;     bless $_[0], $package; # sneaky re-bless of aliased argument   } } 

Example usage:

package Dog; sub new { bless {}, shift } sub speak { print "woof!\n" }  ...  package main;  my $dog1 = Dog->new; my $dog2 = Dog->new;  monkey_patch_instance($dog2, speak => sub { print "yap!\n" });  $dog1->speak; # woof! $dog2->speak; # yap!