views:

935

answers:

7

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. ;-)

A: 

Edit: This was an incorrect attempt at a solution that I'm keeping for posterity. Look at the upvoted/accepted answers. :-)

Ah, I just realized that the syntax needs a little bit of adjustment:

$agent->{get_basic_credentials} = _user_agent_get_basic_credentials_patch;

Without the {} delimiters it looks like a method invocation (which would not be a valid l-value).

I'd still like to know how the instance method gets bound/looked up via this syntax. TIA!

cdleary
Actually, the method seems to get called, but without any parameters this way.
cdleary
Is it an attempt to get the Peer Pressure badge?
dolmen
+2  A: 

Perl thinks you're trying to call the subroutine on the left of the assignment, which is why it's complaining. I think you may be able to whack the Perl symbol table directly (using *LWP::UserAgent::get_basic_credentials or something), but I lack the Perl-fu to correctly make that incantation.

Greg Hewgill
+2  A: 

http://www.google.com/codesearch/p?hl=en#tgg5_3LXifM/Authen-Simple-HTTP-0.1/lib/Authen/Simple/HTTP.pm&q=get_basic_credentials

Fayland Lam
Nice reference -- I should remember Google Code Search more often.
cdleary
+5  A: 
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;

You have not 1, but 2 problems here, because this is what you are doing:

( $agent->get_basic_credentials() ) = _user_agent_get_basic_credentials_patch();

on both sides cases, you're calling the subs instead of simply referring to them.

assign the result of 
              '_user_agent_get_basic_credentials_patch' 
to the value that was returned from
              'get_basic_credentials';

Equivalent logic :

{
   package FooBar; 
   sub foo(){ 
         return 5; 
   }
   1;
}
my $x =  bless( {}, "FooBar" ); 
sub baz(){ 
      return 1; 
}
$x->foo() = baz(); 
#   5 = 1;

So its no wonder its complaining.

Your "fixed" code in your answer is also wrong, for the same reason, with another problem you may not realise:

 $agent->{get_basic_credentials} = _user_agent_get_basic_credentials_patch;

This is rather flawed logic thinking it works like you think it does.

What it is really doing, is:

1. Dereference $agent, which is a HashRef
2. Set the hash-key 'get_basic_credentials' to the result from _user_agent_get_basic_credentials_patch

You didn't assign any function at all.

{
package FooBar; 
sub foo(){ 
     return 5; 
} 
1;
}
my $x =  bless( {}, "FooBar" ); 
sub baz(){ 
  return 1; 
}
$x->{foo} = baz(); 
#  $x is now  = ( bless{ foo => 1 }, "FooBar" ); 
#  $x->foo(); # still returns 5
#  $x->{foo}; # returns 1;

Monkey patching is rather evil of course, and I have not myself seen how to override a method on a singular instance of something like that.

However, what you can do is this:

  {
     no strict 'refs'; 
     *{'LWP::UserAgent::get_basic_credentials'} = sub { 
         # code here 

     }; 
  }

Which will globally replace the get_basic_credentials code sections behaviour ( I might be wrong somewhat, somebody correct me )

If you really need to do it on a per-instance basis you could probably do a bit of class inheritance and just build a derived class instead, and/or dynamically create new packages.

Kent Fredric
Monkey patching isn't really evil in isolated cases like mine -- I have a specific case for a throwaway user agent with HTTP auth. It's when you start doing it all over the place and not documenting it that it becomes hellish. That aside, thanks for the help! Nice analysis.
cdleary
+10  A: 

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;
}
Rather than:our @ISA ...can't you douse base 'LWP::UserAgent' instead?looks more readable to me.
singingfish
Nice solution blixtor. Simple, readable and solves the problem exactly.
j_random_hacker
Agreed -- so what I take away from this is that there isn't really a way to monkey patch an *instance's* instance method in Perl, but you can create an anonymous package with the method overridden OR modify the package-bound method.
cdleary
cdleary, I would say that "creating an anonymous package with the method overridden" for just a single instance **is** monkey-patching an instance's method. What I mean is, how is that *not* monkey-patching? Is there some other requirement that is not being satisfied?
j_random_hacker
@j_random_hacker: I meant it in the sense that you can't take a blessed object without knowing its associated package and inject a method into its resolution order. You might be able to do some additional trickery with anonymous packages and AUTOLOAD to delegate to the associated package, though.
cdleary
Actually, saying that, John Siracusa did something like that in his answer.
cdleary
+5  A: 

In the spirit of Perl's "making hard things possible", here's an example of how to do single-instance monkey patching without mucking with the inheritance.

I DO NOT recommend you actually doing this in any code that anyone else will have to support, debug or depend on (like you said, consenting adults):

#!/usr/bin/perl

use strict;
use warnings;
{

    package Monkey;

    sub new { return bless {}, shift }
    sub bar { return 'you called ' . __PACKAGE__ . '::bar' }
}

use Scalar::Util qw(refaddr);

my $f = Monkey->new;
my $g = Monkey->new;
my $h = Monkey->new;

print $f->bar, "\n";    # prints "you called Monkey::bar"

monkey_patch( $f, 'bar', sub { "you, sir, are an ape" } );
monkey_patch( $g, 'bar', sub { "you, also, are an ape" } );

print $f->bar, "\n";    # prints "you, sir, are an ape"
print $g->bar, "\n";    # prints "you, also, are an ape"
print $h->bar, "\n";    # prints "you called Monkey::bar"

my %originals;
my %monkeys;

sub monkey_patch {
    my ( $obj, $method, $new ) = @_;
    my $package = ref($obj);
    $originals{$method} ||= $obj->can($method) or die "no method $method in $package";
    no strict 'refs';
    no warnings 'redefine';
    $monkeys{ refaddr($obj) }->{$method} = $new;
    *{ $package . '::' . $method } = sub {
        if ( my $monkey_patch = $monkeys{ refaddr( $_[0] ) }->{$method} ) {
            return $monkey_patch->(@_);
        } else {
            return $originals{$method}->(@_);
        }
    };
}
Brian Phillips
+5  A: 

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!
John Siracusa
It seems that the re-bless will cause the monkey patched instance to lose all other methods provided by the original class unless you tweak the @ISA:@{$package. '::ISA'} = ref($instance);
Brian Phillips
So, when will you upload MonkeyPatch to CPAN? :) I've often thought this should be easier for users.
brian d foy
Brian: Duh, you're right. Fixed now, thanks.
John Siracusa
brian: I actually think the "sneaky override tracking via refaddr" technique shown in another answer is more CPANable than the reblessing technique, but I guess it all depends on your tolerance for namespace polution.
John Siracusa
Hey, what happens in Acme, stays in Acme right? :-)
Brian Phillips
Nice... this is more along the lines of the object-level patching I was looking for.
cdleary