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] の非左辺値サブルーチン呼び出しを変更できません。

私が思い出したように ( 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）が不十分な場合は、カスタムパッケージの再祝福手法を自動化できます。

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();

どちらの場合も、単にサブルーチンを参照するのではなく、サブルーチンを呼び出しています。

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 は、割り当ての左側にあるサブルーチンを呼び出そうとしていると考えています。Perl シンボル テーブルを (または何かを使用して) 直接叩くことができると思いますが*LWP::UserAgent::get_basic_credentials、その呪文を正しく作成するための 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が、その周りに追加のコードを装飾できます。$oldFunction

于 2017-07-25T16:42:12.500 に答える
-1

編集:これは、私が後世のために保持している解決策に対する誤った試みでした。賛成/承認された回答を見てください。:-)

ああ、構文を少し調整する必要があることに気付きました。

$agent->{get_basic_credentials} = _user_agent_get_basic_credentials_patch;

区切り文字がない{}と、メソッド呼び出しのように見えます (これは有効な左辺値ではありません)。

この構文を介してインスタンスメソッドがどのようにバインド/ルックアップされるかを知りたいです。ティア！

于 2009-01-16T06:44:25.760 に答える