perl - एक मॉड्यूल में परिभाषित फ़ंक्शन को ओवरराइट करना लेकिन इसके रनटाइम चरण में उपयोग करने से पहले?




compilation (5)

चलो कुछ बहुत सरल है,

# 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 को प्रिंट करने के लिए मजबूर करना संभव है?


चलो एक गोल्फ प्रतियोगिता है!

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 [email protected];
  $INC{'Foo.pm'}= $pm;
}
use Foo;

यह सिर्फ विधि के प्रतिस्थापन के साथ मॉड्यूल के कोड को उपसर्ग करता है, जो कोड की पहली पंक्ति होगी जो संकलन चरण के बाद और निष्पादन चरण से पहले चलती है।

फिर, %INC प्रविष्टि भरें ताकि भविष्य के use Foo मूल में न खींचे।


चूँकि यहाँ एकमात्र विकल्प गहराई से हैक होने वाले हैं, हम वास्तव में यहाँ चाहते हैं कि सबरूटीन को %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;

यदि Foo.pm अंदर sub bar मौजूदा Foo::bar फ़ंक्शन की तुलना में एक अलग प्रोटोटाइप है, तो पर्ल इसे अधिलेखित नहीं करेगा? यह मामला प्रतीत होता है, और समाधान को काफी सरल बनाता है:

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

या एक ही तरह की चीज

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

अद्यतन: नहीं, इसका कारण यह है कि पर्ल एक "निरंतर" उप-रेखा (प्रोटोटाइप () साथ () फिर से परिभाषित नहीं करेगा, इसलिए यह केवल एक व्यवहार्य समाधान है यदि आपका नकली फ़ंक्शन स्थिर है।


यह कुछ चेतावनियों का उत्सर्जन करेगा, लेकिन प्रिंट 7:

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

सबसे पहले, हम Foo::bar को परिभाषित करते हैं। इसे Foo.pm में घोषणा द्वारा फिर से परिभाषित किया जाएगा, लेकिन "सबरूटीन फू :: बार पुनर्परिभाषित" चेतावनी को ट्रिगर किया जाएगा, जो सिग्नल हैंडलर को कॉल करेगा जो सबरूटीन को फिर से 7 पर लौटने के लिए फिर से परिभाषित करता है।


हैक की आवश्यकता होती है क्योंकि (और इस प्रकार use ) दोनों संकलित करते हैं और लौटने से पहले मॉड्यूल को निष्पादित करते हैं।

एक ही eval लिए जाता है। eval उपयोग कोड को संकलित किए बिना भी करने के लिए नहीं किया जा सकता है।

कम से कम घुसपैठ समाधान मैंने पाया है कि DB::postponed को ओवरराइड करना होगा DB::postponed । यह एक संकलित आवश्यक फ़ाइल का मूल्यांकन करने से पहले कहा जाता है। दुर्भाग्य से, इसे केवल डिबगिंग ( perl -d ) कहा जाता है।

एक अन्य उपाय यह होगा कि फाइल को पढ़ें, इसे संशोधित करें और संशोधित फाइल का मूल्यांकन करें, निम्न की तरह थोड़े:

use File::Slurper qw( read_binary );

eval(read_binary("Foo.pm") . <<'__EOS__')  or die [email protected];
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 का उपयोग करते हुए) को UNITCHECK किया था। यदि आप उस दृष्टिकोण का उपयोग करना चाहते हैं, तो आप का उपयोग करके वापस जाने के लिए एक फ़ाइल हैंडल प्राप्त कर सकते हैं

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

कुदोस @INC हुक का उल्लेख करने के लिए @INC





compilation