¿Cómo puedo anular las funciones de Perl, habilitando múltiples reemplazos?

Question

Hace un tiempo, le pregunté This question sobre la anulación de las funciones de construcción perl.

¿Cómo hago esto de una manera que permite varias sustituciones? El siguiente código produce una recursión infinita.

¿Cuál es la forma correcta de hacerlo? Si redefino una función, no quiero pisar la redefinición de otra persona.

package first; 

my $orig_system1; 
sub mysystem { 
    my @args = @_; 
    print("in first mysystem\n"); 
    return &{$orig_system1}(@args); 
} 

BEGIN { 

    if (defined(my $orig = \&CORE::GLOBAL::system)) { 
    $orig_system1 = $orig; 
    *CORE::GLOBAL::system = \&first::mysystem; 
    printf("first defined\n"); 
    } else { 
    printf("no orig for first\n"); 
    } 
} 

package main; 

system("echo hello world"); 

Answer 1

La forma correcta de hacerlo es no hacerlo. Encuentra otra forma de lograr lo que estás haciendo. Esta técnica tiene todos los problemas de una variable global, cuadrada. A menos que obtenga su reescritura de la función exactamente correcta, podría romper todo tipo de código que ni siquiera sabía que existía. Y si bien es posible que seas cortés al no rebasar una anulación existente, es probable que otra persona no lo haga.

Anulación system es particularmente delicada porque no tiene un prototipo adecuado. Esto se debe a que hace cosas que no se pueden expresar en el sistema prototipo. Esto significa que su anulación no puede hacer algunas cosas que system puede hacer. A saber ...

system {$program} @args; 

Ésta es una forma válida para llamar system, aunque es necesario leer los documentos exec para hacerlo. Podrías pensar "oh, bueno, simplemente no haré eso", pero si lo hace algún módulo que utilizas, o cualquier módulo que usa, entonces no tienes suerte.

Dicho esto, hay poco diferente de anular cualquier otra función cortésmente. Debes atrapar la función existente y asegurarte de llamarla a la nueva. Si lo hace antes o después depende de usted.

El problema en su código es que la forma correcta de comprobar si una función está definida es defined &function. Tomar un código ref, incluso de una función indefinida, siempre devolverá una verdadera referencia de código. No estoy seguro de por qué, tal vez sea como \undef devolverá una referencia escalar. ¿Por qué llamar a este código ref está causando que mysystem() sea infinitamente recursivo?

Existe una complejidad adicional en el sentido de que no se puede hacer referencia a una función central. \&CORE::system no hace lo que quieres decir. Tampoco se puede llegar a eso con una referencia simbólica. Por lo tanto, si desea llamar al CORE::system o una anulación existente según la definición, no puede asignar una u otra a un código ref. Tienes que dividir tu lógica.

Aquí hay una manera de hacerlo.

package first; 

use strict; 
use warnings; 

sub override_system { 
    my $after = shift; 

    my $code; 
    if(defined &CORE::GLOBAL::system) { 
     my $original = \&CORE::GLOBAL::system; 

     $code = sub { 
      my $exit = $original->(@_); 
      return $after->($exit, @_); 
     }; 
    } 
    else { 
     $code = sub { 
      my $exit = CORE::system(@_); 
      return $after->($exit, @_); 
     }; 
    } 

    no warnings 'redefine'; 
    *CORE::GLOBAL::system = $code; 
} 

sub mysystem { 
    my($exit, @args) = @_; 
    print("in first mysystem, got $exit and @args\n"); 
} 

BEGIN { override_system(\&mysystem) } 

package main; 

system("echo hello world"); 

Tenga en cuenta que he cambiado misistema() para ser simplemente un gancho que se ejecuta después de que el sistema real. Obtiene todos los argumentos y el código de salida, y puede cambiar el código de salida, pero no cambia lo que realmente hace el system(). Agregar anotaciones antes/después es lo único que puede hacer si desea respetar una anulación existente. Es bastante más seguro de todos modos. El lío del sistema predominante está ahora en una subrutina para evitar que BEGIN se sature demasiado.

Debería poder modificar esto para sus necesidades.