Modülde tanımlanan, ancak daha önce çalışma zamanı aşamasında kullanılan bir işlevin üzerine yazılıyor mu?

Çok basit bir şey alalım,

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

Yine de ayarlanan ve ekrana başka bir şey yazdırmak için nedenleri test.pldeğiştiren çalışma kodundan yapabilir miyim ?$bazFoo.pm

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

Derleyici aşamaları ile yukarıdakileri baskı yapmaya zorlamak mümkün mü 7?

Bir kesmek gereklidir çünkü require(ve böylece use) her iki derlenir ve yürütür modülü dönmeden önce.

Aynı şey geçerli eval. evalkodu yürütmeden de derlemek için kullanılamaz.

Bulduğum en az müdahaleci çözüm geçersiz kılmak olurdu DB::postponed. Bu derlenmiş gerekli bir dosyayı değerlendirmeden önce çağrılır. Ne yazık ki, yalnızca hata ayıklama ( perl -d) sırasında çağrılır .

Başka bir çözüm, dosyayı okumak, değiştirmek ve değiştirilmiş dosyayı değerlendirmek olabilir, örneğin aşağıdakiler gibi:

use File::Slurper qw( read_binary );

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

Yukarıdakiler düzgün ayarlanmamıştır %INC, uyarılar tarafından kullanılan dosya adını karıştırır ve böyle çağırmaz DB::postponed, vb. Aşağıdakiler daha sağlam bir çözümdür:

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;

Ben kullandım UNITCHECK(derleme sonra ama yürütmeden önce denir) çünkü unreadtüm dosyayı okumak ve yeni tanım eklemek yerine geçersiz kılma (kullanarak ) önermiş. Bu yaklaşımı kullanmak istiyorsanız, kullanarak geri dönmek için bir dosya tanıtıcısı alabilirsiniz

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

Horoz bahsettiği için @Grinnz için Kudos @INC.

Buradaki tek seçenek derinlemesine çirkin olacağı için, burada gerçekten istediğimiz şey, alt yordamın %Foo::stash'a eklendikten sonra kodu çalıştırmaktır :

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;

Bu bazı uyarılar gönderir, ancak 7 yazdırır:

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

İlk olarak tanımlarız Foo::bar. Değeri Foo.pm'deki bildirimle yeniden tanımlanacaktır, ancak "Alt yordam Foo :: bar yeniden tanımlandı" uyarısı tetiklenecek, bu da alt rutini yeniden tanımlayan sinyal işleyiciyi 7'ye geri döndürecektir.

Modül yükleme işlemini kanca ile Readonly modülünün salt okunur yapma yeteneklerini birleştiren bir çözüm:

$ 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

Burada çözümümü gözden geçirdim, böylece m-conrad'ın cevabınaReadonly.pm dayanarak çok basit bir alternatifi kaçırdığımı öğrendikten sonra, burada başladığım modüler yaklaşıma yeniden çalıştım.

Foo.pm ( Açılıştaki ile aynı )

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 Güncellendi

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;

Çalışma ve çıkış:

$ ./test-run.pl 
5

sub barİçeride Foo.pmmevcut bir Foo::barişlevden farklı bir prototip varsa , Perl bunun üzerine yazmaz mı? Durum böyle görünüyor ve çözümü oldukça basit hale getiriyor:

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

ya da aynı şey

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

Güncelleme: hayır, bunun işe yaramasının nedeni Perl'in bir "sabit" alt rutini (prototip ile ()) yeniden tanımlamamasıdır , bu yüzden bu sadece sahte işleviniz sabitse geçerli bir çözümdür.

Bir Golf yarışması yapalım!

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;

Bu sadece modülün kodunu, derleme aşamasından sonra ve yürütme aşamasından önce çalışan kodun ilk satırı olacak olan yöntemin yerini alır.

Ardından, %INCgirişi doldurun, böylece gelecekteki yükler use Fooorijinali çekmeyecektir.