เขียนทับฟังก์ชันที่กำหนดในโมดูล แต่ก่อนที่จะใช้ในเฟสรันไทม์?

ลองทำอะไรที่ง่ายมาก

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

มีอยู่หรือไม่ที่ฉันสามารถtest.plเรียกใช้โค้ดที่เปลี่ยนแปลงสิ่งที่$bazตั้งไว้และทำให้Foo.pmพิมพ์อย่างอื่นบนหน้าจอได้

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

เป็นไปได้ไหมที่คอมไพเลอร์เฟสจะบังคับให้พิมพ์ด้านบน7?

ต้องการแฮ็กเพราะrequire(และทำให้use) ทั้งคอมไพล์และรันโมดูลก่อนส่งคืน

evalเดียวกันจะไปสำหรับ evalไม่สามารถใช้ในการคอมไพล์รหัสโดยไม่ต้องดำเนินการ

DB::postponedวิธีการแก้ปัญหาล่วงล้ำน้อยฉันได้พบก็จะไปแทนที่ สิ่งนี้ถูกเรียกใช้ก่อนที่จะประเมินไฟล์ที่ต้องการรวบรวม น่าเสียดายที่มันถูกเรียกก็ต่อเมื่อทำการดีบั๊ก ( perl -d)

วิธีแก้ปัญหาอื่นก็คือการอ่านไฟล์แก้ไขและประเมินไฟล์ที่ถูกดัดแปลงเหมือนอย่างที่ทำต่อไปนี้:

use File::Slurper qw( read_binary );

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

ข้างต้นไม่ได้ตั้งค่าอย่างถูกต้อง%INCมันทำให้ชื่อไฟล์ที่ใช้โดยคำเตือนยุ่งเหยิงและมันไม่เรียกใช้DB::postponedฯลฯ สิ่งต่อไปนี้เป็นโซลูชันที่มีประสิทธิภาพมากขึ้น:

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;

ฉันใช้UNITCHECK(ซึ่งเรียกว่าหลังจากการคอมไพล์ แต่ก่อนที่จะดำเนินการ) เพราะฉันได้เตรียมการแทนที่ (โดยใช้unread) แทนที่จะอ่านในไฟล์ทั้งหมดและต่อท้ายนิยามใหม่ หากคุณต้องการใช้วิธีการดังกล่าวคุณจะได้รับการจัดการไฟล์เพื่อกลับไปใช้

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

รุ่งโรจน์ถึง @Grinnz สำหรับการพูดถึง@INChooks

เนื่องจากตัวเลือกเดียวที่นี่จะแฮ็คอย่างลึกซึ้งสิ่งที่เราต้องการจริงๆที่นี่คือการเรียกใช้โค้ดหลังจากเพิ่มรูทีนย่อยลงในที่%Foo::เก็บ:

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;

สิ่งนี้จะส่งคำเตือนบางอย่าง แต่พิมพ์ 7:

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

Foo::barครั้งแรกที่เรากำหนด ค่าของมันจะถูกนิยามใหม่โดยการประกาศใน Foo.pm แต่คำเตือน "Subroutine Foo :: bar redefined" จะถูกเรียกใช้ซึ่งจะเรียกตัวจัดการสัญญาณที่กำหนดรูทีนย่อยอีกครั้งเพื่อกลับ 7

นี่คือโซลูชันที่รวมการเชื่อมโยงกระบวนการโหลดโมดูลเข้ากับความสามารถในการสร้างแบบอ่านอย่างเดียวของโมดูล 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

ฉันได้แก้ไขวิธีการแก้ปัญหาของฉันที่นี่เพื่อที่จะไม่ต้องพึ่งอีกต่อไปReadonly.pmหลังจากเรียนรู้ว่าฉันพลาดทางเลือกที่ง่ายมากขึ้นอยู่กับคำตอบของ m-conradซึ่งฉันได้ปรับใช้วิธีการแบบแยกส่วนที่ฉันเริ่มต้นที่นี่

Foo.pm ( เหมือนกับในโพสต์เปิด )

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 อัปเดตแล้ว

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;

เรียกใช้และส่งออก:

$ ./test-run.pl 
5

หากsub barภายในFoo.pmมีต้นแบบที่แตกต่างจากFoo::barฟังก์ชั่นที่มีอยู่Perl จะไม่เขียนทับมันหรือ ดูเหมือนว่าจะเป็นอย่างนั้นและทำให้การแก้ปัญหานั้นง่าย:

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

หรือสิ่งเดียวกัน

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

อัปเดต: ไม่เหตุผลที่ใช้งานได้คือ Perl จะไม่กำหนดรูทีนย่อย "คงที่" ใหม่ (พร้อมต้นแบบ()) ดังนั้นนี่เป็นเพียงโซลูชันที่ทำงานได้ถ้าฟังก์ชันจำลองของคุณคงที่

ให้มีการแข่งขันกอล์ฟ!

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;

นี่เป็นเพียงคำนำหน้ารหัสของโมดูลที่มีการเปลี่ยนวิธีการซึ่งจะเป็นบรรทัดแรกของรหัสที่ทำงานหลังจากขั้นตอนการรวบรวมและก่อนขั้นตอนการดำเนินการ

จากนั้นกรอกข้อมูลใน%INCรายการเพื่อuse Fooไม่ให้เอกสารต้นฉบับปรากฏขึ้นอีกในอนาคต