Как я могу обезопасить метод экземпляра в Perl? - PullRequest
Новая
       12

Как я могу обезопасить метод экземпляра в Perl?

22 голосов
/ 16 января 2009

Я пытаюсь сделать обезьянку-патч (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;

Это неправильный синтаксис - он выдает:

Невозможно изменить функцию без значения Позвоните на линию [module] [lineno].

Насколько я помню (из Programming Perl ), поиск диспетчеризации выполняется динамически на основе благословенного пакета (я считаю, что ref($agent)), поэтому я не уверен, как будет работать исправление экземпляра обезьяны не затрагивая благословенную посылку.

Я знаю, что могу выделить подкласс UserAgent, но я бы предпочел более лаконичный подход, залатанный обезьянами. Согласие взрослых и то, что ты. ; -)

Ответы [ 8 ]

20 голосов
/ 16 января 2009

Как ответил Фэйлэнд Лэм , правильный синтаксис: 

    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;
}
16 голосов
/ 16 января 2009

Если динамическая область действия (с использованием 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!
7 голосов
/ 16 января 2009

В духе 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}->(@_);
        }
    };
}
6 голосов
/ 16 января 2009 
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 (я могу ошибаться, кто-то меня поправит)

Если вам действительно нужно сделать это для каждого экземпляра, вы, вероятно, могли бы немного наследовать классы и просто вместо этого создать производный класс и / или динамически создавать новые пакеты.

2 голосов
/ 16 января 2009

Perl считает, что вы пытаетесь вызвать подпрограмму слева от назначения, поэтому он жалуется. Я думаю, что вы можете ударить таблицу символов Perl напрямую (используя *LWP::UserAgent::get_basic_credentials или что-то в этом роде), но мне не хватает Perl-fu, чтобы правильно сделать это заклинание.

1 голос
/ 16 января 2009
0 голосов
/ 25 июля 2017

Опираясь на Ответ Джона Сиракузы ... Я обнаружил, что мне все еще нужна ссылка на исходную функцию. Итак, я сделал это: 

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 как обычно, но украшать дополнительный код вокруг него.

0 голосов
/ 16 января 2009

Редактировать: Это была неправильная попытка найти решение, которое я оставляю для потомков. Посмотрите на одобренные / принятые ответы. : -)

Ах, я только что понял, что синтаксис нуждается в небольшой корректировке: 

$agent->{get_basic_credentials} = _user_agent_get_basic_credentials_patch;

Без разделителей {} это выглядит как вызов метода (который не может быть допустимым l-значением).

Я все еще хотел бы знать, как метод экземпляра связывается / просматривается с помощью этого синтаксиса. ТИА!

...