モジュールで定義されているが、ランタイムフェーズで使用される前の関数を上書きしますか?


20

非常にシンプルなものを考えてみましょう。

# 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ですか?


1
これは内部関数ではありません。としてグローバルにアクセスできますFoo::barが、use Fooはコンパイル段階(以前に何か定義されていた場合はバーを再定義)とFooのランタイム段階の両方を実行します。私が考えられる唯一のこと@INCは、Fooのロード方法を変更するための非常にハックなフックです。
グリンツ

1
関数を完全に再定義したいですか?(その印刷のように、操作の一部を変更するだけではありませんか?)実行前に再定義する特定の理由はありますか?タイトルはそれを求めていますが、質問の本文は言っていません/詳しく述べていません。確かにあなたはそれを行うことができますが、私はそれが合うかどうかの目的を確信していません。
-zdim

1
@zdimはい、理由があります。別のモジュールで使用される関数を、そのモジュールのランタイムフェーズの前に再定義できるようにしたい。まさにグリンツが示唆したこと。
Evan Carroll、

@グリンツそのタイトルは良いですか?
Evan Carroll

1
ハックが必要です。require(したがってuse)戻る前にモジュールをコンパイルして実行します。同じことが当てはまりますevaleval実行せずにコードをコンパイルするために使用することはできません。
池上

回答:


8

ハックがあるため必要とされるrequire(従って、use戻る前に両方のコンパイルおよび実行するモジュール)。

同じことが当てはまりますevaleval実行せずにコードをコンパイルするために使用することはできません。

私が見つけた最も邪魔にならない解決策は、オーバーライドすること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;

@INCフックについて言及している@Grinnzへの称賛。


7

ここでの唯一のオプションは非常にハックになるため、ここで本当に必要なのは、サブルーチンが%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;

6

これはいくつかの警告を出しますが、7を出力します:

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

まず、を定義しますFoo::bar。その値はFoo.pmの宣言によって再定義されますが、「サブルーチンFoo :: bar redefined」警告がトリガーされ、サブルーチンを再定義するシグナルハンドラーを呼び出して7を返します。


3
Wellllそれは私が今まで見たことがなければハックです。
エヴァンキャロル

2
これはハックなしでは不可能です。サブルーチンが別のサブルーチンで呼び出された場合、はるかに簡単になります。
チョロバ

ロードされるモジュールで警告が有効になっている場合にのみ機能します。Foo.pmは警告を有効にしないため、これが呼び出されることはありません。
szr

@szr:で呼び出しますperl -w
チョロバ

@choroba:はい、動作します。-wはどこでも警告を有効にします(iirc)。しかし、私のポイントは、ユーザーがそれをどのように実行するか確信が持てないということです。たとえば、ワンライナーは通常、制限または警告を実行しません。
szr

5

以下は、モジュール読み込みプロセスのフックと、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

1
@ikegamiありがとう、あなたが推奨した変更を行いました。良いキャッチ。
gordonfish

3

ここで解決策を修正し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

1

場合は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が「プロトタイプ」を使用して「定数」サブルーチンを再定義しない()ためです。これは、モック関数が定数の場合にのみ実行可能なソリューションです。


BEGIN { *Foo::bar = sub () { 7 } }より良いように書かれているsub Foo::bar() { 7 }
池上

1
Perlは "定数"サブルーチンを再定義しない」についても、そうではありません。定数サブであっても、サブは42に再定義されます。ここで機能するのは、再定義の前に呼び出しがインライン化されるためです。Evanがのsub bar { 42 } my $baz = bar();代わりに一般的なものを使用していた場合my $baz = bar(); sub bar { 42 }、機能しません。
池上

非常に狭い状況でも機能しますが、警告を使用すると非常にうるさくなります。(Prototype mismatch: sub Foo::bar () vs none at Foo.pm line 5.およびConstant subroutine bar redefined at Foo.pm line 5.
池上

1

ゴルフコンテストをしましょう!

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元のものが読み込まれないようにします。


とても良い解決策です。私が最初に始めたとき、私は最初にこのようなものを試しましたが、あなたがうまく接続した注入部分+ BEGINアスペクトがありませんでした。私はこれを以前に投稿した私の回答のモジュラーバージョンにうまく組み込むことができました。
gordonfish

あなたのモジュールは明らかに設計の勝者ですが、stackoverflowもミニマリストの答えを提供する場合も気に入っています。
データレス
弊社のサイトを使用することにより、あなたは弊社のクッキーポリシーおよびプライバシーポリシーを読み、理解したものとみなされます。
Licensed under cc by-sa 3.0 with attribution required.