如何在 Perl 中对实例方法进行猴子修补？
https://stackoverflow.com/questions/449690
-
19-08-2019 - |
italiano
english
français
española
中国
日本の
العربية
Deutsch
한국어
Português
Russian题
我正在尝试猴子补丁（鸭子打孔:-) 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;
这不是正确的语法——它会产生：
无法修改[模块]线[Lineno]的非效率子例程调用。
我记得（从 Perl编程），调度查找是基于被祝福的包动态执行的（ref($agent), ，我相信），所以我不确定实例猴子修补如何在不影响受祝福的包的情况下工作。
我知道我可以将 UserAgent, ，但我更喜欢更简洁的猴子补丁方法。同意成年人，你有什么。;-)
解决方案
如果动态范围（使用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!
其他提示
作为回答 Fayland榄时，正确的语法是：
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;
}
在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}->(@_);
}
};
}
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代码段的行为（我可能是错一些，有人指正）
如果您的真正的需要做它，你可能会做一些类继承的，只是建立一个派生类，而不是每个实例的基础上，和/或动态创建新的软件包。
Perl的认为你试图调用的任务，这就是为什么它的抱怨左侧的子程序。我想，你可以直接重击Perl的符号表（使用*LWP::UserAgent::get_basic_credentials或某事），但我缺乏的Perl福正确地作出这样的咒语。
在约翰锡拉库扎的回答大厦......我发现，我还是想原函数的引用。所以我这样做：
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的$oldFunction像往常一样，但装饰它周围额外的代码。
编辑：这是当时我保持为后人解决了不正确的尝试。看看upvoted /接受的答案。 ： - ）
啊，我只是意识到语法需要调整的一点点：
$agent->{get_basic_credentials} = _user_agent_get_basic_credentials_patch;
没有{}定界符它看起来像一个方法调用（这不会是一个有效的L值）。
我还是想知道实例方法得到如何绑定通过这句法/抬起头来。 TIA！
