Menimpa fungsi yang didefinisikan dalam modul tetapi sebelum digunakan dalam fase runtime?

Mari kita ambil sesuatu yang sangat sederhana,

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

Apakah ada yang saya dapat dari test.plmenjalankan kode yang mengubah apa $bazyang diatur dan menyebabkan Foo.pmuntuk mencetak sesuatu yang lain ke layar?

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

Apakah mungkin dengan fase kompiler untuk memaksa yang di atas untuk mencetak 7?

Peretasan diperlukan karena require(dan karenanya use) mengkompilasi dan mengeksekusi modul sebelum kembali.

Sama berlaku untuk eval. evaltidak dapat digunakan untuk mengkompilasi kode tanpa juga menjalankannya.

Solusi paling tidak mengganggu yang saya temukan adalah menimpanya DB::postponed. Ini disebut sebelum mengevaluasi file yang diperlukan dikompilasi. Sayangnya, ini hanya dipanggil saat debugging ( perl -d).

Solusi lain adalah dengan membaca file, memodifikasinya, dan mengevaluasi file yang dimodifikasi, seperti yang berikut ini:

use File::Slurper qw( read_binary );

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

Di atas tidak diatur dengan benar %INC, itu mengacaukan nama file yang digunakan oleh peringatan dan semacamnya, itu tidak memanggil DB::postponed, dll. Berikut ini adalah solusi yang lebih kuat:

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;

Saya menggunakan UNITCHECK(yang dipanggil setelah kompilasi tetapi sebelum eksekusi) karena saya mendahulukan override (menggunakan unread) daripada membaca di seluruh file dan menambahkan definisi baru. Jika Anda ingin menggunakan pendekatan itu, Anda bisa mendapatkan pegangan file untuk kembali menggunakan

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

Kudos to @ Grinnz karena menyebutkan @INCkait.

Karena satu-satunya opsi di sini akan sangat terjal, apa yang sebenarnya kita inginkan di sini adalah menjalankan kode setelah subrutin ditambahkan ke %Foo::simpanan:

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;

Ini akan memancarkan beberapa peringatan, tetapi mencetak 7:

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

Pertama, kami mendefinisikan Foo::bar. Nilainya akan didefinisikan ulang oleh deklarasi di Foo.pm, tetapi peringatan "Subroutine Foo :: bar redefined" akan dipicu, yang akan memanggil pengendali sinyal yang mendefinisikan kembali subrutin untuk mengembalikan 7.

Berikut ini adalah solusi yang menggabungkan mengaitkan proses pemuatan modul dengan kemampuan membuat-baca dari modul 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

Saya telah merevisi solusi saya di sini, sehingga tidak lagi bergantung pada Readonly.pm, setelah mengetahui bahwa saya telah melewatkan alternatif yang sangat sederhana, berdasarkan jawaban m-conrad , yang telah saya ulang ke pendekatan modular yang saya mulai di sini.

Foo.pm ( Sama seperti pada posting pembuka )

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 Diperbarui

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;

Jalankan dan hasilkan:

$ ./test-run.pl 
5

Jika bagian sub bardalam Foo.pmmemiliki prototipe yang berbeda dari Foo::barfungsi yang ada , Perl tidak akan menimpanya? Sepertinya itulah masalahnya, dan membuat solusinya cukup sederhana:

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

atau sejenisnya

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

Pembaruan: tidak, alasan ini berhasil adalah Perl tidak akan mendefinisikan ulang subrutin "konstan" (dengan prototipe ()), jadi ini hanya solusi yang layak jika fungsi tiruan Anda konstan.

Ayo ikuti kontes 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;

Ini hanya mengawali kode modul dengan penggantian metode, yang akan menjadi baris kode pertama yang berjalan setelah fase kompilasi dan sebelum fase eksekusi.

Kemudian, isi %INCentri tersebut agar nantinya use Footidak ada yang menarik yang asli.