¿Cómo puedo acceder al método original de un método monkeypatched en Perl?

Question

Estoy intentando una clase Perl: Quiero cambiar el comportamiento de un método existente.

Este nodo en perlmonks muestra cómo añadir a función a una clase existente. He encontrado que este patrón también se puede utilizar para proporcionar una nueva aplicación para una función existente.

Sin embargo, me gustaría saber cómo llamar a la función original.

Estoy buscando algo como esto:

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 asignación

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

Rápido y sucio. Este alias de todos los símbolos existingFunction a oldExistingFunction. Incluye la subfamilia que le interesa, sino también cualquier escalares, arrays, hashes, asas que pueden ocurrirle a tener el mismo nombre.

• Ventajas: sin pensar, simplemente funciona. "Rápida"
• Desventajas: "sucia"

asignación Coderef

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

que sólo los alias del submarino. Todavía se hace en el alijo paquete, por lo que el símbolo oldExistingFunction es visible globalmente, lo que podría o no podría ser lo que quieres. Probablemente no.

• Ventajas:. Aliasing que no lo hace 'fuga' a otros tipos de variables
• Desventajas: más pensamiento, más escribir. Mucho más pensando si ir por el * ... {code} sintaxis (I personalmente no lo uso todos los días)

Léxico coderef

my $oldFunction = \&ExistingClass::existingFunction;

El uso de my mantiene una referencia a la antigua función que sólo es visible al bloque / archivo currrent. No hay forma de código externo de hacerse con ella sin su ayuda nunca más. Cuidado con la convención de llamada:

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

• Ventajas: no hay problemas de visibilidad Anymore
• Desventajas: difícil de conseguir la derecha

Moose

respuesta . Tiene que ser el camino correcto, ya que no hay al rededor del pegotes y / o referencias más, pero no sé lo suficiente como para explicarlo.

Answer 2

Debe utilizar Moose o Clase :: :: Método modificadores .

En ese caso, sólo puede decir:

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

Answer 3

Además de las otras respuestas, mira módulos tales como:

• Sub :: Invalidar
• Gancho :: LexWrap

También hablo de esto en el capítulo "lenguajes dinámicos" en Mastering Perl .

Answer 4

memoize es un buen ejemplo de esto.

Answer 5

Sólo tienes que copiar a una variable léxica y llamarlo.

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

Si desea sentirse mejor con OO-sintaxis, se podría crear un método UNIVERSAL::apply (o en cualquier clase de base que eligió).

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

De esta manera se le puede llamar así:

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

Answer 6

En Moose , sólo puede hacer lo que dice jrockway ; para las clases no alces, hacer esto:

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 una alterativa, lo que está mal con:

package NewClass;
use base qw/ExistingClass/;

sub existingFunction {
# ....
}

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