Écraser une fonction définie dans un module mais avant d'être utilisée dans sa phase d'exécution?

Prenons quelque chose de très simple,

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

Existe-t-il de toute façon que je peux test.plexécuter du code qui modifie ce qui $bazest défini et provoque l' Foo.pmimpression de quelque chose d'autre à l'écran?

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

Est-il possible avec les phases du compilateur de forcer l'impression ci-dessus 7?

Un hack est nécessaire car require(et donc use) à la fois compile et exécute le module avant de revenir.

Il en va de même eval. evalne peut pas être utilisé pour compiler du code sans l'exécuter également.

La solution la moins intrusive que j'ai trouvée serait de passer outre DB::postponed. Ceci est appelé avant d'évaluer un fichier requis compilé. Malheureusement, il n'est appelé que lors du débogage ( perl -d).

Une autre solution serait de lire le fichier, de le modifier et d'évaluer le fichier modifié, un peu comme ce qui suit:

use File::Slurper qw( read_binary );

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

Ce qui précède n'est pas correctement défini %INC, il gâche le nom de fichier utilisé par les avertissements et autres, il n'appelle pas DB::postponed, etc. La solution suivante est plus robuste:

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;

J'ai utilisé UNITCHECK(qui est appelé après la compilation mais avant l'exécution) parce que j'ai ajouté le remplacement (à l'aide unread) plutôt que de lire le fichier entier et d'ajouter la nouvelle définition. Si vous souhaitez utiliser cette approche, vous pouvez obtenir un descripteur de fichier à retourner en utilisant

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

Félicitations à @Grinnz pour avoir mentionné les @INCcrochets.

Puisque les seules options ici vont être profondément hacky, ce que nous voulons vraiment ici, c'est exécuter du code après que le sous-programme a été ajouté à la %Foo::cachette:

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;

Cela émettra quelques avertissements, mais affiche 7:

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

Tout d'abord, nous définissons Foo::bar. Sa valeur sera redéfinie par la déclaration dans Foo.pm, mais l'avertissement "Subroutine Foo :: bar redefined" sera déclenché, qui appellera le gestionnaire de signaux qui redéfinit la sous-routine pour retourner 7.

Voici une solution qui combine le raccordement du processus de chargement du module avec les capacités de création en lecture seule du module en lecture seule:

$ 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

J'ai révisé ma solution ici, afin qu'elle ne repose plus Readonly.pm, après avoir appris que j'avais manqué une alternative très simple, basée sur la réponse de m-conrad , que j'ai retravaillée dans l'approche modulaire que j'avais commencée ici.

Foo.pm ( comme dans le message d'ouverture )

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 mis à jour

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;

Exécuter et sortir:

$ ./test-run.pl 
5

Si l' sub barintérieur Foo.pma un prototype différent d'une Foo::barfonction existante , Perl ne le remplacera pas? Cela semble être le cas et rend la solution assez simple:

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

ou un peu la même chose

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

Mise à jour: non, la raison pour laquelle cela fonctionne est que Perl ne redéfinira pas un sous-programme "constant" (avec prototype ()), donc ce n'est une solution viable que si votre fonction de simulation est constante.

Laisse avoir un concours 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;

Cela préfixe simplement le code du module avec un remplacement de la méthode, qui sera la première ligne de code qui s'exécute après la phase de compilation et avant la phase d'exécution.

Ensuite, remplissez l' %INCentrée afin que les futures charges de use Foone tirent pas l'original.