Como faço para acessar o método original de um método monkeypatched em Perl?

Question

Eu estou tentando monkey patch uma classe Perl: Eu quero mudar o comportamento de um método existente.

Este nó na PerlMonks mostra como Adicionar a função para uma classe existente. Descobri que esse padrão também pode ser usado para fornecer uma nova implementação de uma função existente.

No entanto, eu gostaria de saber como chamar a função original.

Eu estou procurando algo como isto:

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

Answer 1

Typeglob atribuição

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

rápida e suja. Este alias todos os símbolos existingFunction para oldExistingFunction. Isso inclui o sub você está em interessado, mas também quaisquer escalares, arrays, hashes, alças que pode acontecer de ter o mesmo nome.

• Vantagens: sem pensar, ele simplesmente funciona. "Quick"
• Desvantagens: "sujo"

coderef atribuição

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

Isso só aliases do sub. Ainda é feito no estoque de pacote, então o símbolo oldExistingFunction é globalmente visível, que pode ou não ser o que quiser. Provavelmente não.

• Vantagens:. Que aliasing não 'vazar' para outros tipos de variáveis ??
• Desvantagens: mais pensar, mais de digitação. Muito mais pensando se vai para o * ... {CODE} sintaxe (I personnally não usá-lo todos os dias)

Lexical coderef

my $oldFunction = \&ExistingClass::existingFunction;

Usando my mantém uma referência à antiga função que só é visível para o bloco / arquivo currrent. Não há nenhuma maneira para o código externo para se apossar dela sem a sua ajuda mais. Cuidado com a convenção de chamada:

$self->$oldFunction(@args);
$oldFunction->($self, @args);

• Vantagens: sem problemas de visibilidade digitamos mais
• Desvantagens: mais difícil de obter direito

Moose

de jrockway resposta . Tem que ser o caminho certo, uma vez que não há nenhuma perder tempo com bolhas e / ou referências mais, mas eu não sei o suficiente para explicá-lo.

Answer 2

Você deve usar Moose ou Class :: Method :: Modificadores .

Nesse caso, você pode simplesmente dizer:

around 'some_method' => sub {
    my ($orig, $self, @args) = @_;
    # ... before original ...
    $self->$orig(@_);
    # ... after original ...
};

Answer 3

Além das outras respostas, olhar para módulos, tais como:

• Sub :: Override
• Gancho :: LexWrap

Eu também falar sobre isso no capítulo "Linguagens Dinâmicas" em Mastering Perl .

Answer 4

Memoize é um bom exemplo disso.

Answer 5

Apenas copie-o para uma variável lexical e chamá-lo.

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

Se você se sentir melhor sobre isso com OO-sintaxe, você pode criar um método UNIVERSAL::apply (ou em qualquer classe base que você escolheu).

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

Dessa forma, você pode chamá-lo assim:

my @returns = $self->apply( $existing_function_ref, @_ );

Answer 6

Para Moose , você pode simplesmente fazer o que jrockway diz ; para as classes não-alces, faça o seguinte:

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

Answer 7

Como um alterative, o que há de errado com:

package NewClass;
use base qw/ExistingClass/;

sub existingFunction {
# ....
}

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