Eine in einem Modul definierte Funktion überschreiben, aber zuvor in der Laufzeitphase verwendet?

Nehmen wir etwas sehr Einfaches,

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

Gibt es überhaupt eine Möglichkeit, test.plCode auszuführen, der die $bazEinstellungen ändert und dazu führt Foo.pm, dass etwas anderes auf dem Bildschirm gedruckt wird?

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

Ist es mit den Compiler-Phasen möglich, das Drucken der oben genannten zu erzwingen 7?

Ein Hack ist erforderlich, da require(und damit use) das Modul vor der Rückkehr kompiliert und ausgeführt wird.

Gleiches gilt für eval. evalkann nicht zum Kompilieren von Code verwendet werden, ohne ihn auch auszuführen.

Die am wenigsten aufdringliche Lösung, die ich gefunden habe, wäre das Überschreiben DB::postponed. Dies wird aufgerufen, bevor eine kompilierte erforderliche Datei ausgewertet wird. Leider wird es nur beim Debuggen aufgerufen ( perl -d).

Eine andere Lösung wäre, die Datei zu lesen, zu ändern und die geänderte Datei auszuwerten, ähnlich wie im Folgenden:

use File::Slurper qw( read_binary );

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

Das oben Gesagte ist nicht richtig eingestellt %INC, es bringt den Dateinamen durcheinander, der von Warnungen und dergleichen verwendet wird, es ruft nicht auf DB::postponedusw. Das Folgende ist eine robustere Lösung:

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;

Ich habe verwendet UNITCHECK(was nach der Kompilierung, aber vor der Ausführung aufgerufen wird), weil ich die Überschreibung (using unread) vorangestellt habe, anstatt die gesamte Datei einzulesen und die neue Definition anzuhängen. Wenn Sie diesen Ansatz verwenden möchten, können Sie ein Dateihandle erhalten, mit dem Sie zurückkehren können

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

Ein großes Lob an @Grinnz für die Erwähnung von @INCHooks.

Da die einzigen Optionen hier sehr hackig sein werden, möchten wir hier wirklich Code ausführen, nachdem das Unterprogramm zum %Foo::Stash hinzugefügt wurde :

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;

Dies gibt einige Warnungen aus, druckt jedoch 7:

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

Zuerst definieren wir Foo::bar. Sein Wert wird durch die Deklaration in Foo.pm neu definiert, aber die Warnung "Subroutine Foo :: bar redefined" wird ausgelöst, wodurch der Signalhandler aufgerufen wird, der die Subroutine erneut definiert, um 7 zurückzugeben.

Hier ist eine Lösung, die das Einbinden des Modulladevorgangs mit den Readonly-Making-Funktionen des Readonly-Moduls kombiniert:

$ 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

Ich habe meine Lösung hier überarbeitet, so dass sie nicht mehr darauf beruht Readonly.pm, nachdem ich erfahren habe, dass ich eine sehr einfache Alternative verpasst habe, basierend auf der Antwort von m-conrad , die ich in den modularen Ansatz überarbeitet habe, den ich hier begonnen hatte.

Foo.pm ( wie im Eröffnungsbeitrag )

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 Aktualisiert

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;

Ausführen und ausgeben:

$ ./test-run.pl 
5

Wenn das sub barInnere Foo.pmeinen anderen Prototyp als eine vorhandene Foo::barFunktion hat, wird Perl ihn nicht überschreiben? Das scheint der Fall zu sein und macht die Lösung ziemlich einfach:

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

oder so ähnlich

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

Update: Nein, der Grund dafür ist, dass Perl eine "konstante" Unterroutine (mit Prototyp ()) nicht neu definiert. Dies ist also nur dann eine praktikable Lösung, wenn Ihre Scheinfunktion konstant ist.

Lass uns einen Golfwettbewerb veranstalten!

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;

Dies stellt dem Code des Moduls lediglich eine Ersetzung der Methode voran. Dies ist die erste Codezeile, die nach der Kompilierungsphase und vor der Ausführungsphase ausgeführt wird.

Füllen Sie dann den %INCEintrag aus, damit zukünftige Ladungen use Foodas Original nicht einlesen.