22

我正在尝试猴子补丁（鸭拳:-）一个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] 行 [lineno] 处的非左值子例程调用。

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

我知道我可以子类化UserAgent，但我更喜欢更简洁的猴子补丁方法。同意的成年人和你有什么。;-)

4

8 回答 8

20

正如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;
}
于 2009-01-16T07:50:04.970 回答
17

如果动态范围（使用local）不令人满意，您可以自动化自定义包 reblessing 技术：

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!
于 2009-01-16T17:25:45.477 回答
7

本着 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}->(@_);
        }
    };
}
于 2009-01-16T14:51:27.953 回答
6 
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();

在双方的情况下，您都在调用 subs 而不是简单地引用它们。

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 代码部分的行为（我可能有些错误，有人纠正我）

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

于 2009-01-16T07:35:49.040 回答
2

Perl 认为您正在尝试调用赋值左侧的子例程，这就是它抱怨的原因。我认为您也许可以直接（使用*LWP::UserAgent::get_basic_credentials或其他方式）敲击 Perl 符号表，但我缺乏 Perl-fu 来正确制作该咒语。

于 2009-01-16T06:45:36.363 回答
1

基于John Siracusa 的回答……我发现我仍然想要对原始函数的引用。所以我这样做了：

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';
    my $oldFunction = \&{ref($instance).'::'.$method};
    @{$package . '::ISA'} = (ref($instance));
    *{$package . '::' . $method} = sub {
        my ($self, @args) = @_;
        $code->($self, $oldFunction, @args);
    };
    bless $_[0], $package; # sneaky re-bless of aliased argument
  }
}

# let's say you have a database handle, $dbh
# but you want to add code before and after $dbh->prepare("SELECT 1");

monkey_patch_instance($dbh, prepare => sub {
    my ($self, $oldFunction, @args) = @_;

    print "Monkey patch (before)\n";
    my $output = $oldFunction->(($self, @args));
    print "Monkey patch (after)\n";

    return $output;
    });

它与原始答案中的相同，除了我传递了一些参数$self和$oldFunction.

这让我们像往常一样调用$self's $oldFunction，但在它周围装饰额外的代码。

于 2017-07-25T16:42:12.500 回答
-1

编辑：这是我为后代保留的解决方案的错误尝试。查看赞成/接受的答案。:-)

啊，我才意识到语法需要一点调整：

$agent->{get_basic_credentials} = _user_agent_get_basic_credentials_patch;

没有{}分隔符，它看起来像一个方法调用（这不是一个有效的左值）。

我仍然想知道如何通过这种语法绑定/查找实例方法。蒂亚！

于 2009-01-16T06:44:25.760 回答