Ghi đè một chức năng được xác định trong một mô-đun nhưng trước khi được sử dụng trong giai đoạn thời gian chạy của nó?

Hãy lấy một cái gì đó rất đơn giản,

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

Có cách nào tôi có thể từ test.plmã chạy thay đổi những gì $bazđược đặt thành và nguyên nhân Foo.pmđể in một cái gì đó khác lên màn hình không?

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

Có thể với các giai đoạn biên dịch để buộc ở trên để in 7?

Một hack là cần thiết bởi vì require(và do đó use) cả biên dịch và thực thi mô-đun trước khi quay trở lại.

Cùng đi cho eval. evalkhông thể được sử dụng để biên dịch mã mà không thực thi nó.

Giải pháp ít xâm phạm nhất mà tôi tìm thấy sẽ là ghi đè DB::postponed. Điều này được gọi trước khi đánh giá một tập tin yêu cầu biên dịch. Thật không may, nó chỉ được gọi khi gỡ lỗi ( perl -d).

Một giải pháp khác là đọc tệp, sửa đổi và đánh giá tệp đã sửa đổi, giống như sau:

use File::Slurper qw( read_binary );

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

Ở trên không được đặt đúng %INC, nó làm rối tên tệp được sử dụng bởi các cảnh báo và do đó, nó không gọi DB::postponed, v.v ... Sau đây là một giải pháp mạnh mẽ hơn:

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;

Tôi đã sử dụng UNITCHECK(được gọi sau khi biên dịch nhưng trước khi thực thi) vì tôi đã thêm phần ghi đè (sử dụng unread) thay vì đọc toàn bộ tệp trong và nối thêm định nghĩa mới. Nếu bạn muốn sử dụng phương pháp đó, bạn có thể lấy một tệp xử lý để quay lại sử dụng

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

Kudos đến @Grinnz để đề cập đến @INCmóc.

Vì các tùy chọn duy nhất ở đây sẽ bị hack sâu, điều chúng tôi thực sự muốn ở đây là chạy mã sau khi chương trình con đã được thêm vào %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;

Điều này sẽ phát ra một số cảnh báo, nhưng in 7:

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

Đầu tiên, chúng tôi xác định Foo::bar. Giá trị của nó sẽ được xác định lại bằng khai báo trong Foo.pm, nhưng cảnh báo "Subroutine Foo :: bar redposed" sẽ được kích hoạt, sẽ gọi trình xử lý tín hiệu xác định lại chương trình con một lần nữa để trả về 7.

Đây là một giải pháp kết hợp móc nối quá trình tải mô-đun với khả năng đọc chỉ của mô-đun 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

Tôi đã sửa đổi giải pháp của mình ở đây, để nó không còn dựa vào Readonly.pm, sau khi biết rằng tôi đã bỏ lỡ một giải pháp thay thế rất đơn giản, dựa trên câu trả lời của m-conrad , mà tôi đã làm lại theo cách tiếp cận mô-đun mà tôi đã bắt đầu ở đây.

Foo.pm ( Giống như trong bài mở đầu )

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.

OverrideSub.pm Cập nhật

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;

thử nghiệm

#!/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;

Chạy và xuất:

$ ./test-run.pl 
5

Nếu sub barbên trong Foo.pmcó một nguyên mẫu khác với Foo::barchức năng hiện có , Perl sẽ không ghi đè lên nó? Đó có vẻ là trường hợp, và làm cho giải pháp khá đơn giản:

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

hoặc loại tương tự

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

Cập nhật: không, lý do điều này hoạt động là vì Perl sẽ không định nghĩa lại chương trình con "không đổi" (với nguyên mẫu ()), vì vậy đây chỉ là một giải pháp khả thi nếu chức năng giả của bạn không đổi.

Hãy có một cuộc thi 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;

Điều này chỉ tiền tố mã của mô-đun với sự thay thế của phương thức, đây sẽ là dòng mã đầu tiên chạy sau giai đoạn biên dịch và trước giai đoạn thực thi.

Sau đó, điền vào %INCmục để tải trong tương lai use Fookhông kéo vào bản gốc.