Sovrascrivere una funzione definita in un modulo ma prima utilizzata nella sua fase di runtime?

Prendiamo qualcosa di molto semplice,

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

Esiste un modo per test.pleseguire il codice che modifica ciò che $bazè impostato e fa Foo.pmstampare qualcos'altro sullo schermo?

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

È possibile con le fasi del compilatore forzare la stampa di cui sopra 7?

È richiesto un hack perché require(e quindi use) entrambi compila ed esegue il modulo prima di tornare.

Lo stesso vale per eval. evalnon può essere utilizzato per compilare il codice senza eseguirlo.

La soluzione meno invadente che ho trovato sarebbe quella di scavalcare DB::postponed. Viene chiamato prima di valutare un file richiesto compilato. Sfortunatamente, viene chiamato solo quando debugging ( perl -d).

Un'altra soluzione sarebbe quella di leggere il file, modificarlo e valutare il file modificato, un po 'come il seguente:

use File::Slurper qw( read_binary );

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

Quanto sopra non è impostato correttamente %INC, confonde il nome del file utilizzato dagli avvisi e simili, non chiama DB::postponed, ecc. Di seguito è una soluzione più solida:

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;

Ho usato UNITCHECK(che viene chiamato dopo la compilazione ma prima dell'esecuzione) perché ho anteposto l'override (usando unread) anziché leggere l'intero file e aggiungere la nuova definizione. Se si desidera utilizzare tale approccio, è possibile ottenere un handle di file da restituire utilizzando

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

Complimenti a @Grinnz per aver menzionato i @INCganci.

Dal momento che le uniche opzioni qui saranno profondamente confuse, quello che vogliamo davvero qui è eseguire il codice dopo che la subroutine è stata aggiunta allo %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;

Questo emetterà alcuni avvisi, ma stampa 7:

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

Innanzitutto, definiamo Foo::bar. Il valore verrà ridefinito dalla dichiarazione in Foo.pm, ma verrà attivato l'avviso "Subroutine Foo :: bar ridefinito", che chiamerà il gestore del segnale che ridefinisce nuovamente la subroutine per restituire 7.

Ecco una soluzione che combina l'aggancio del processo di caricamento del modulo con le capacità di sola lettura del modulo 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

Ho rivisto la mia soluzione qui, in modo da non fare più affidamento Readonly.pm, dopo aver appreso che avevo perso un'alternativa molto semplice, basata sulla risposta di m-conrad , che ho rielaborato nell'approccio modulare che avevo iniziato qui.

Foo.pm ( Come nel post di 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 Aggiornato

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;

Esegui e genera:

$ ./test-run.pl 
5

Se l' sub barinterno Foo.pmha un prototipo diverso rispetto a una Foo::barfunzione esistente , Perl non lo sovrascriverà? Questo sembra essere il caso e rende la soluzione abbastanza semplice:

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

o tipo della stessa cosa

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

Aggiornamento: no, la ragione per cui funziona è che Perl non ridefinirà una subroutine "costante" (con prototipo ()), quindi questa è una soluzione praticabile solo se la tua funzione di simulazione è costante.

Facciamo una gara di 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;

Questo prefigura semplicemente il codice del modulo con una sostituzione del metodo, che sarà la prima riga di codice che verrà eseguita dopo la fase di compilazione e prima della fase di esecuzione.

Quindi, inserisci la %INCvoce in modo che i carichi futuri use Foonon vengano inseriti nell'originale.