كيف يمكنني القرد طريقة مثيل في بيرل؟

Question

أحاول القرد (Duck-Punch :-) 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].

كما أتذكر (من برمجة بيرل) ، يتم إجراء عملية البحث بشكل ديناميكي بناءً على الحزمة المباركة (ref($agent), ، أعتقد) ، لذلك لست متأكدًا من كيفية عمل حالة ترقيع القرد دون التأثير على الحزمة المباركة.

أعلم أنه يمكنني الفئة الفرعية UserAgent, ، لكني أفضل النهج الأكثر إيجازا القرد. الموافقة على البالغين وماذا لديك. ؛-)

Answer 1

إذا كان النطاق الديناميكي (باستخدام 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!

Answer 2

كما أجاب من قبل فيلاند لام, ، بناء الجملة الصحيح هو:

    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;
}

Answer 3

بروح بيرل "جعل الأشياء الصعبة ممكنة" ، إليك مثال على كيفية القيام بالقرد المفرد دون أن يختلط بالميراث.

أنا لاتفعل نوصيك بالفعل بذلك في أي رمز سيتعين على أي شخص آخر دعمه أو تصحيحه أو الاعتماد عليه (كما قلت ، البالغين الموافقة):

#!/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}->(@_);
        }
    };
}

Answer 4

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 ، ولكن مشكلتين هنا ، لأن هذا ما تفعله:

( $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 (قد أكون مخطئًا إلى حد ما ، شخص ما يصححني)

اذا أنت حقًا تحتاج إلى القيام بذلك على أساس في الثقة ، ربما يمكنك القيام ببعض الميراث للصف وإنشاء فئة مشتقة بدلاً من ذلك ، و/أو إنشاء حزم جديدة ديناميكيًا.

Answer 5

يعتقد بيرل أنك تحاول الاتصال بالروتين الفرعي على يسار المهمة ، وهذا هو السبب في أنه يشكو. أعتقد أنك قد تكون قادرًا على ضرب جدول رمز Perl مباشرة (باستخدام *LWP::UserAgent::get_basic_credentials أو شيء من هذا القبيل) ، لكني افتقر إلى Perl-Fu لجعل هذا التعويذة بشكل صحيح.

Answer 6

http://www.google.com/codesearch/p؟hl=en#tgg5_3lxifm/authen-simple-http-0.1/lib/authen/simple/http.pm&q=get_basic_credities

Answer 7

Building upon John Siracusa's answer… I found that I still wanted a reference to the original function. So I did this:

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

It's the same as in the original answer, except I pass through some parameters $self and $oldFunction.

This lets us invoke $self's $oldFunction as usual, but decorate additional code around it.

Answer 8

Edit: This was an incorrect attempt at a solution that I'm keeping for posterity. Look at the upvoted/accepted answers. :-)

Ah, I just realized that the syntax needs a little bit of adjustment:

$agent->{get_basic_credentials} = _user_agent_get_basic_credentials_patch;

Without the {} delimiters it looks like a method invocation (which would not be a valid l-value).

I'd still like to know how the instance method gets bound/looked up via this syntax. TIA!