Perlでインスタンスメソッドをモンキーパッチするにはどうすればよいですか？
https://stackoverflow.com/questions/449690
-
19-08-2019 - |
italiano
english
français
española
中国
日本の
العربية
Deutsch
한국어
Português
Russian質問
次のように、LWP::UserAgentインスタンスをmonkey-patch（duck-punch :-)しようとしています：
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]で呼び出します。
思い出すと（ Programming Perl から）、ディスパッチルックアップは祝福されたパッケージ（ref($agent)、私は信じる）に基づいて動的に実行されるため、インスタンスモンキーパッチが祝福されたパッケージに影響を与えずに動作します。
UserAgentをサブクラス化できることは知っていますが、より簡潔な猿パッチのアプローチを好むでしょう。同意する大人とあなたは何を持っています。 ;-）
解決
ダイナミックスコープ（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!
他のヒント
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;
}
Perlの<！> quot;難しいことを可能にする<！> quot;の精神で、継承をいじらずに単一インスタンスのモンキーパッチを適用する方法の例を次に示します。
私は、他の誰かがサポート、デバッグ、または依存しなければならないコードで実際にこれを行うことをお勧めしません（あなたが言ったように、大人に同意します）：
#!/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;
だから文句を言うのも不思議ではありません。
あなたの<！> quot; fixed <！> quot;あなたの答えのコードも間違っています、同じ理由で、あなたが気付かないかもしれない別の問題で：
$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-fuが欠けています。
ジョンシラクサの答え <！>＃8230;私はまだ元の関数への参照が必要であることを発見しました。だから私はこれをしました：
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を通過させる点が異なります。
これにより、通常どおり<=>の<=>を呼び出すことができますが、その周りに追加のコードを装飾できます。
編集：これは、私が後世のために残している解決策の誤った試みでした。賛成/受け入れられた答えを見てください。 ：-）
ああ、構文を少し調整する必要があることに気付きました。
$agent->{get_basic_credentials} = _user_agent_get_basic_credentials_patch;
{}区切り文字がないと、メソッド呼び出しのように見えます（有効なl値ではありません）。
この構文を介してインスタンスメソッドがどのようにバインド/検索されるかを引き続き知りたいです。 TIA！
