perl - ¿Sobrescribir una función definida en un módulo pero antes utilizada en su fase de tiempo de ejecución?

compilation

Question

Tomemos algo muy simple,

# Foo.pm
package Foo {
my $baz = bar();
sub bar { 42 }; ## Overwrite this
print $baz; ## Before this is executed
}

¿Hay alguna forma de que pueda desde test.pl ejecutar el código que cambia lo que $baz está configurado y hace que Foo.pm imprima algo más en la pantalla?

# maybe something here.
use Foo;
# maybe something here

¿Es posible con las fases del compilador forzar lo anterior para imprimir 7 ?

Answer 1

¡Hagamos un concurso de golf!

sub _override { 7 }
BEGIN {
my ($pm)= grep -f, map "$_/Foo.pm", @INC or die "Foo.pm not found";
open my $fh, "<", $pm or die;
local $/= undef;
eval "*Foo::bar= *main::_override;/n#line 1 $pm/n".<$fh> or die $@;
$INC{''Foo.pm''}= $pm;
}
use Foo;

Esto solo antepone el código del módulo con un reemplazo del método, que será la primera línea de código que se ejecuta después de la fase de compilación y antes de la fase de ejecución.

Luego, complete la entrada %INC para que futuras cargas de use Foo no tiren del original.

Answer 2

Aquí hay una solución que combina el enganche del proceso de carga del módulo con las capacidades de creación de solo lectura del módulo Readonly:

$ cat Foo.pm
package Foo {
my $baz = bar();
sub bar { 42 }; ## Overwrite this
print $baz; ## Before this is executed
}
$ cat test.pl
#!/usr/bin/perl
use strict;
use warnings;
use lib qw(.);
use Path::Tiny;
use Readonly;
BEGIN {
my @remap = (
''$Foo::{bar} => /&mybar''
);
my $pre = join '' '', map "Readonly::Scalar $_;", @remap;
my @inc = @INC;
unshift @INC, sub {
return undef if $_[1] ne ''Foo.pm'';
my ($pm) = grep { $_->is_file && -r } map { path $_, $_[1] } @inc
or return undef;
open my $fh, ''<'', /($pre. "#line 1 $pm/n". $pm->slurp_raw);
return $fh;
};
}
sub mybar { 5 }
use Foo;
$ ./test.pl
5

Answer 3

Dado que las únicas opciones aquí serán profundamente extravagantes, lo que realmente queremos aquí es ejecutar código después de que la subrutina se haya agregado al %Foo:: stash:

use strict;
use warnings;
# bless a coderef and run it on destruction
package RunOnDestruct {
sub new { my $class = shift; bless shift, $class }
sub DESTROY { my $self = shift; $self->() }
}
use Variable::Magic 0.58 qw(wizard cast dispell);
use Scalar::Util ''weaken'';
BEGIN {
my $wiz;
$wiz = wizard(store => sub {
return undef unless $_[2] eq ''bar'';
dispell %Foo::, $wiz; # avoid infinite recursion
# Variable::Magic will destroy returned object *after* the store
return RunOnDestruct->new(sub { no warnings ''redefine''; *Foo::bar = sub { 7 } });
});
cast %Foo::, $wiz;
weaken $wiz; # avoid memory leak from self-reference
}
use lib::relative ''.'';
use Foo;

Answer 4

Esto emitirá algunas advertencias, pero imprime 7:

sub Foo::bar {}
BEGIN {
$SIG{__WARN__} = sub {
*Foo::bar = sub { 7 };
};
}

Primero, definimos Foo::bar . Su valor será redefinido por la declaración en Foo.pm, pero se activará la advertencia "Subrutina Foo :: barra redefinida", que llamará al controlador de señal que redefine la subrutina nuevamente para devolver 7.

Answer 5

Se requiere un pirateo porque require (y por lo tanto use ) compila y ejecuta el módulo antes de regresar.

Lo mismo vale para eval . eval no se puede usar para compilar código sin ejecutarlo también.

La solución menos intrusiva que he encontrado sería anular DB::postponed . Esto se llama antes de evaluar un archivo requerido compilado. Desafortunadamente, solo se llama cuando se depura ( perl -d ).

Otra solución sería leer el archivo, modificarlo y evaluar el archivo modificado, algo así como lo siguiente:

use File::Slurper qw( read_binary );
eval(read_binary("Foo.pm") . <<''__EOS__'') or die $@;
package Foo {
no warnings qw( redefine );
sub bar { 7 }
}
__EOS__

Lo anterior no establece correctamente %INC , desordena el nombre de archivo utilizado por las advertencias y demás, no llama a DB::postponed , etc. La siguiente es una solución más sólida:

use IO::Unread qw( unread );
use Path::Class qw( dir );
BEGIN {
my $preamble = ''
UNITCHECK {
no warnings qw( redefine );
*Foo::bar = sub { 7 };
}
'';
my @libs = @INC;
unshift @INC, sub {
my (undef, $fn) = @_;
return undef if $_[1] ne ''Foo.pm'';
for my $qfn (map dir($_)->file($fn), @libs) {
open(my $fh, ''<'', $qfn)
or do {
next if $!{ENOENT};
die $!;
};
unread $fh, "$preamble/n#line 1 $qfn/n";
return $fh;
}
return undef;
};
}
use Foo;

UNITCHECK (que se llama después de la compilación pero antes de la ejecución) porque antepuse la anulación (usando unread ) en lugar de leer todo el archivo y agregar la nueva definición. Si desea utilizar ese enfoque, puede obtener un identificador de archivo para volver utilizando

open(my $fh_for_perl, ''<'', /$modified_code);
return $fh_for_perl;

Felicitaciones a @Grinnz por mencionar los ganchos @INC .

Answer 6

Si la sub bar dentro de Foo.pm tiene un prototipo diferente al de una función Foo::bar existente, ¿Perl no lo sobrescribirá? Ese parece ser el caso, y hace que la solución sea bastante simple:

# test.pl
BEGIN { *Foo::bar = sub () { 7 } }
use Foo;

o algo parecido

# test.pl
package Foo { use constant bar => 7 };
use Foo;

Actualización: no, la razón por la que esto funciona es que Perl no redefinirá una subrutina "constante" (con prototype () ), por lo que esta es solo una solución viable si su función simulada es constante.

Answer 7

Tomé el código de mi respuesta original y lo reescribí para un enfoque más modular, lo que resultó en un método limpio del módulo desde el cual se usa esto y Foo.pm.

Foo.pm ( igual que en la publicación de apertura )

package Foo {
my $baz = bar();
sub bar { 42 }; ## Overwrite this
print $baz; ## Before this is executed
}

OverrideSubs.pm

package OverrideSubs;
use strict;
use warnings;
use Readonly;
use Path::Tiny;
use List::Util qw(first);
sub import {
my (undef, %overrides) = @_;
my @remap;
for my $what (keys %overrides) {
my $with = $overrides{$what};
my ($what_pkg, $what_sub) = $what =~ /^(.*)::([^:]+)$/
or die ''Namespace required for target subroutine.'';
push @remap, [
$what_pkg =~ s{::}{/}rg. ''.pm'', # Compute file path for later.
sprintf ''$%s::{%s} => //&%s'', $what_pkg, $what_sub, $with
];
}
my $pre = join '' '', map "Readonly::Scalar $_->[1];", @remap;
my @inc = grep !ref, @INC; # Just plain strings, no CODE refs.
unshift @INC, sub {
return undef # Only continue for desired files.
unless grep { $_->[0] eq $_[1] } @remap;
my $pm = first { $_->is_file && -r } map { path $_, $_[1] } @inc
or return undef;
open my $fh, ''<'', /($pre. "#line 1 $pm/n". $pm->slurp_raw);
return $fh;
};
}
1;

test2.pl

#!/usr/bin/env perl
use strict;
use warnings;
use lib qw(.); # Needed for newer Perls that typically exclude . from @INC by default.
use OverrideSubs
''Foo::bar'' => ''mybar'';
sub mybar { 5 } # This can appear before or after ''use OverrideSubs'',
# but must appear before ''use Foo''.
use Foo;

Ejecutar y salida:

$ ./test2.pl
5