我怎样才能在Perl中修补实例方法？

Question

我正在试图修补(duck-punch :-)一个LWP::UserAgent实例,如下所示:

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;

这不是正确的语法 - 它产生:

无法在[module] line [lineno]修改非左值子程序调用.

我记得(来自Programming Perl),调度查找是基于受祝福的包动态执行的(ref($agent)我相信),所以我不确定实例猴子修补如何在不影响受祝福的包的情况下工作.

我知道我可以继承它UserAgent,但我更喜欢更简洁的猴子修补方法.同意成年人和你有什么.;-)

Answer 1

正如Fayland Lam所回答的,正确的语法是:

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

但这是修补(动态范围)整个类而不仅仅是实例.你可以在你的情况下逃脱这一点.

如果您确实只想影响实例,请使用您描述的子类.这可以"动态"完成,如下所示:

{
   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

如果动态范围(使用local)不令人满意,您可以自动化自定义包重新生成技术:

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
  }
}

用法示例:

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!

Answer 3

本着Perl的"让困难成为可能"的精神,这里有一个如何进行单实例猴子修补而不会遗传继承的例子.

我不建议你在任何其他人必须支持,调试或依赖的代码中实际执行此操作(如您所说,同意成人):

#!/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}->(@_);
        }
    };
}

Answer 4

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;

你在这里没有1,但有2个问题,因为这就是你在做的事情:

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

在双方的情况下,你打电话给潜艇,而不是简单地指他们.

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

等效逻辑:

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

所以难怪它的抱怨.

您的答案中的"固定"代码也是错误的,出于同样的原因,您可能没有意识到另一个问题:

 $agent->{get_basic_credentials} = _user_agent_get_basic_credentials_patch;

这是一个相当有缺陷的逻辑,认为它的工作方式就像你认为的那样.

它真正做的是:

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

您根本没有分配任何功能.

{
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; 

猴子补丁当然是相当邪恶的,我自己也没有看到如何在类似的东西上覆盖一个方法.

但是,你能做的是:

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

     }; 
  }

哪个将全局替换get_basic_credentials代码段的行为(我可能有点错误,有人纠正我)

如果你真的需要在每个实例的基础上进行,你可能会做一些类继承,而只是构建一个派生类,和/或动态创建新的包.