如何在Perl中对实例方法进行猴子补丁？
我试图对一个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上的非lvalue子程序调用.
我还记得(从Perl编程中)，调度查找是基于受祝福的包(我相信是ref($agent))动态执行的，所以我不确定实例猴子补丁会如何工作而不会影响受祝福的包。
我知道我可以子类UserAgent，但我更喜欢更简洁的猴子补丁方法。同意的成年人和你有什么。;-)
回答 8
Stack Overflow用户
发布于 2009-01-16 17:25:45
如果动态范围(使用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!Stack Overflow用户
发布于 2009-01-16 07:50:04
正如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;
}Stack Overflow用户
发布于 2009-01-16 14:51:27
本着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}->(@_);
}
};
}https://stackoverflow.com/questions/449690
复制相似问题
腾讯云开发者
Copyright © 2013 - 2026 Tencent Cloud. All Rights Reserved. 腾讯云 版权所有
深圳市腾讯计算机系统有限公司 ICP备案/许可证号：粤B2-20090059 
粤公网安备44030502008569号
腾讯云计算（北京）有限责任公司 京ICP证150476号 | 京ICP备11018762号