Как мне получить доступ к оригинальному методу monkeypatched в Perl? - PullRequest
Новая
       13

Как мне получить доступ к оригинальному методу monkeypatched в Perl?

4 голосов
/ 22 февраля 2009

Я пытаюсь monkey patch класс Perl: я хочу изменить поведение существующего метода.

Этот узел в perlmonks показывает, как добавить функцию в существующий класс. Я обнаружил, что этот шаблон также можно использовать для предоставления новой реализации существующей функции.

Однако я хотел бы знать, как вызвать исходную функцию.

Я ищу что-то вроде этого: 

use ExistingClass;

# TODO: Somehow rename existingFunction() to oldExistingFunction().

sub ExistingClass::existingFunction {
    my $self = shift;

    # New behavior goes here.
    $self->oldExistingFunction(@_); # Call old behavior.
    # More new behavior here.
}

Ответы [ 7 ]

10 голосов
/ 22 февраля 2009

Назначение Typeglob 

*ExistingClass::oldExistingFunction = *ExistingClass::existingFunction;

Быстро и грязно. Это объединяет все символы existingFunction в oldExistingFunction. Это включает интересующую вас подпрограмму, а также любые скаляры, массивы, хэши, дескрипторы, которые могут иметь одно и то же имя.

  • Преимущества: не думая, это просто работает. "Быстрый"
  • Недостатки: "грязный"

Кодовое задание 

*ExistingClass::oldExistingFunction = \&ExistingClass::existingFunction;
# or something using *ExistingClass::symbol{CODE}

Этот псевдоним только псевдоним. Это все еще делается в пакете, поэтому символ oldExistingFunction виден глобально, что может быть, а может и не быть тем, что вы хотите. Вероятно, нет.

  • Преимущества: псевдонимы не «просачиваются» в другие типы переменных.
  • Недостатки: больше мышления, больше печатания. Намного больше размышлений, если использовать синтаксис * ... {CODE} (лично я не использую его каждый день)

Лексическая кодовая ссылка 

my $oldFunction = \&ExistingClass::existingFunction;

Использование my сохраняет ссылку на старую функцию, которая видна только текущему блоку / файлу. Для внешнего кода больше нет возможности получить его без вашей помощи. Имейте в виду соглашение о вызовах: 

$self->$oldFunction(@args);
$oldFunction->($self, @args);
  • Преимущества: больше нет проблем с видимостью
  • Недостатки: сложнее понять

Муз

См. ответ jrockway . Должно быть, это правильный путь, так как больше нет никаких шуток с шариками и / или ссылками, но я не знаю этого достаточно, чтобы объяснить это.

8 голосов
/ 23 февраля 2009

Вы должны использовать Moose или Class :: Method :: Modifiers .

В этом случае вы можете просто сказать: 

around 'some_method' => sub {
    my ($orig, $self, @args) = @_;
    # ... before original ...
    $self->$orig(@_);
    # ... after original ...
};
4 голосов
/ 23 февраля 2009

Помимо других ответов, посмотрите на такие модули, как:

Я также говорю об этом в главе «Динамические языки» в Освоение Perl .

2 голосов
/ 23 февраля 2009

Просто скопируйте его в лексическую переменную и вызовите его. 

my $existing_function_ref = \&ExistingClass::existingFunction;
*ExistingClass::existingFunction = sub { 
    my $self = shift;
    $self->go_and_do_some_stuff();
    my @returns = $existing_function_ref->( $self, @_ );
    $self->do_some_stuff_with_returns( @returns );
    return wantarray ? @returns : shift @returns;
};

Если бы вы чувствовали себя лучше с OO-синтаксисом, вы можете создать метод UNIVERSAL::apply (или в любом выбранном вами базовом классе). 

sub UNIVERSAL::apply { 
    my ( $self, $block ) = splice( @_, 0, 2 );
    unshift @_, $self;
    goto &$block;
}

Таким образом, вы можете назвать это так: 

my @returns = $self->apply( $existing_function_ref, @_ );
2 голосов
/ 22 февраля 2009

Memoize является хорошим примером этого.

1 голос
/ 24 июля 2012

Для Moose классов вы можете просто делать то, что jrockway говорит ; для классов без лося, сделайте это: 

use Class::MOP ();
use ExistingClass;

Class::MOP::Class->initialize('ExistingClass')->add_around_method_modifier(
    existingFunction => sub {
        my $orig = shift;

        # new behaviour goes here

        # call old behaviour
        my $result = $orig->(@_);

        # more new behaviour goes here
    }
);
0 голосов
/ 23 февраля 2009

Как альтернатива, что не так с: 

package NewClass;
use base qw/ExistingClass/;

sub existingFunction {
# ....
}

sub oldExistingFunction {
    my $self = shift;
    return $self->SUPER::existingFunction(@_);
}
...