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

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 test.plejecutar el código que cambia lo que $bazestá configurado y hace Foo.pmque se imprima algo más en la pantalla?

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

¿Es posible con las fases del compilador forzar la impresión anterior 7?

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

Lo mismo vale para eval . evalno 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 se establece correctamente %INC, desordena el nombre de archivo utilizado por las advertencias y demás, no llama 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;

Usé UNITCHECK(que se llama después de la compilación pero antes de la ejecución) porque antepuse la anulación (usandounread ) 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 @INCganchos.

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

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;

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.

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

He revisado mi solución aquí, para que ya no dependa de ella Readonly.pm, después de enterarme de que me había perdido una alternativa muy simple, basada en la respuesta de m-conrad , que he reelaborado en el enfoque modular que había comenzado aquí.

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
}
# Note, even though print normally returns true, a final line of 1; is recommended.

OverrideSubs.pm Actualizado

package OverrideSubs;

use strict;
use warnings;

use Path::Tiny;
use List::Util qw(first);

sub import {
    my (undef, %overrides) = @_;
    my $default_pkg = caller; # Default namespace when unspecified.

    my %remap;

    for my $what (keys %overrides) {
        ( my $with = $overrides{$what} ) =~ s/^([^:]+)$/${default_pkg}::$1/;

        my $what_pkg  = $what =~ /^(.*)\:\:/ ? $1 : $default_pkg;
        my $what_file = ( join '/', split /\:\:/, $what_pkg ). '.pm';

        push @{ $remap{$what_file} }, "*$what = *$with";
    }

    my @inc = grep !ref, @INC; # Filter out any existing hooks; strings only.

    unshift @INC, sub {
        my $remap = $remap{ $_[1] } or return undef;
        my $pre = join ';', @$remap;

        my $pm = first { $_->is_file && -r } map { path $_, $_[1] } @inc
            or return undef;

        # Prepend code to override subroutine(s) and reset line numbering.
        open my $fh, '<', \( $pre. ";\n#line 1 $pm\n". $pm->slurp_raw );
        return $fh;
   };
}

1;

test-run.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:

$ ./test-run.pl 
5

Si el sub barinterior Foo.pmtiene un prototipo diferente que una Foo::barfunción 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 prototipo ()), por lo que esta es solo una solución viable si su función simulada es constante.

¡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 %INCentrada para que futuras cargas de use Foono tiren del original.