মডিউলে সংজ্ঞায়িত কোনও ফাংশন ওভাররাইট করা কিন্তু রানটাইম পর্বে ব্যবহৃত হওয়ার আগে?


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এটি সংকলন পর্ব (পূর্বে সেখানে কিছু সংজ্ঞায়িত করা থাকলে পুনরায় সংজ্ঞাকরণ বার) এবং ফু-র রানটাইম পর্ব উভয়ই চালিত করবে। আমি কেবল যে জিনিসটি ভাবতে পারি তা হ'ল গভীরভাবে হ্যাক @INCহুক হ'ল ফু কীভাবে বোঝা যায় তা পরিবর্তন করতে।
গ্রিন্জ

1
আপনি পুরোপুরি ফাংশনটির নতুন সংজ্ঞা দিতে চান, হ্যাঁ? (কেবলমাত্র তার মুদ্রণের মতো এর ক্রিয়াকলাপের অংশটি পরিবর্তন করবেন না?) রানটাইমের আগে পুনরায় সংজ্ঞার জন্য নির্দিষ্ট কারণ রয়েছে? শিরোনামটি এর জন্য জিজ্ঞাসা করে তবে প্রশ্ন সংস্থায় / বিস্তৃত নয়। নিশ্চিত যে আপনি এটি করতে পারেন তবে উদ্দেশ্য সম্পর্কে আমি নিশ্চিত নই যাতে এটি ফিট হয় কিনা।
zdim

1
@zdim হ্যাঁ এর কারণ আছে। আমি সেই মডিউলটির রানটাইম পর্বের আগে অন্য মডিউলে ব্যবহৃত একটি ফাংশন নতুন করে সংজ্ঞায়িত করতে সক্ষম হতে চাই। গ্রিন্জ ঠিক কী পরামর্শ দিয়েছেন।
ইভান ক্যারল

@ গ্রিন্জ কি এই শিরোনামটি আরও ভাল?
ইভান ক্যারল

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, ইত্যাদি etc. নীচে আরও দৃ solution় সমাধান:

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


7

যেহেতু এখানে কেবলমাত্র বিকল্পগুলি গভীরভাবে হ্যাকী হতে চলেছে, আমরা সাব্রুটিন স্ট্যাশগুলিতে যুক্ত হওয়ার পরে কোড চালানো এখানে যা করতে চাই তা হল %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;

6

এটি কিছু সতর্কতা নিঃসরণ করবে তবে প্রিন্ট 7:

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

প্রথমত, আমরা সংজ্ঞায়িত করি Foo::bar। Foo.pm এ ঘোষণার মাধ্যমে এর মানটি পুনরায় সংজ্ঞায়িত হবে, তবে "সাব্রুটাইন ফু :: বার পুনরায় সংজ্ঞায়িত" সতর্কতা ট্রিগার করা হবে, যা আবার সাব্রোটিনকে পুনরায় সংজ্ঞায়িত করে এমন সিগন্যাল হ্যান্ডলারকে কল করে 7 এ ফিরে আসবে।


3
ওয়েল এটি হ্যাক আমি যদি কখনও দেখি।
ইভান ক্যারল

2
হ্যাক ছাড়া এটি সম্ভব নয়। সাব্রোটিন যদি অন্য সাবরুটিনে ডাকা হয় তবে এটি অনেক সহজ হবে।
চোরোবা

এটি কেবল তখনই কাজ করবে যখন লোড করা মডিউলটিতে সতর্কতা সক্ষম করা হয়েছে; Foo.pm সতর্কতা সক্ষম করে না এবং এইভাবে কখনই ডাকা হবে না।
szr

@ এসজার: সুতরাং এটি দিয়ে কল করুন perl -w
চোরোবা

@ চোরোবা: হ্যাঁ, এটি কার্যকর হবে, যেহেতু আমরা সর্বত্র সতর্কতা সক্ষম করব। তবে আমার বক্তব্যটি কোনও ব্যবহারকারী কীভাবে এটি চালাবেন তা আপনি নিশ্চিত হতে পারবেন না। উদাহরণস্বরূপ, ওয়ান-লাইনারগুলি সাধারণত সান স্টাফার বা সতর্কতা চালায়।
szr

5

এখানে এমন একটি সমাধান দেওয়া হয়েছে যা মডিউল লোডিং প্রক্রিয়াটিকে পঠনযোগ্য মডিউলটির পঠন-নির্ধারণের ক্ষমতাগুলির সাথে সংযুক্ত করে:

$ 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
@ ইকগামি ধন্যবাদ, আমি আপনার প্রস্তাবিত পরিবর্তনগুলি করেছি। ভালো বল ধরা.
গর্ডনফিশ

3

আমি এখানে আমার সমাধানটি সংশোধন করেছি, যাতে এটি আর নির্ভর না করে Readonly.pm, এম-কনরাডের উত্তরের উপর ভিত্তি করে আমি একটি খুব সহজ বিকল্পটি মিস করেছি, যা আমি এখানে যে মডুলার পদ্ধতির সাথে শুরু করেছি তা পুনরায় শুরু করেছি।

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.

ওভাররাইডসবস.পিএম আপডেট হয়েছে

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ফাংশনের চেয়ে আলাদা প্রোটোটাইপ থাকে তবে পার্ল এটি ওভাররাইট করে না? এটি কেস বলে মনে হচ্ছে এবং সমাধানটি বেশ সহজ করে তুলেছে:

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

বা একই জিনিস

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

আপডেট: না, এই কাজ করার কারণটি হ'ল পার্ল একটি "ধ্রুবক" সাব্রোটিন (প্রোটোটাইপ সহ ()) পুনরায় সংজ্ঞায়িত করবে না , সুতরাং যদি আপনার মক ফাংশন স্থির থাকে তবে এটি কেবলমাত্র একটি কার্যকর সমাধান।


BEGIN { *Foo::bar = sub () { 7 } }আরও ভাল হিসাবে লেখা হয়েছেsub Foo::bar() { 7 }
ikegami

1
পুনরায় " পার্ল" ধ্রুবক "সাবরুটাইন " পুনরায় সংজ্ঞা দেবেন না , এটিও সত্য নয়। সাবটি 42 টির মধ্যে পুনরায় সংজ্ঞায়িত হয় এমনকি এটি যখন ধ্রুবক সাব হয় তখনও। এটি এখানে কাজ করার কারণ হ'ল পুনরায় সংজ্ঞা দেওয়ার আগে কলটি ইনলাইনড হয়ে যায়। ইভান যদি এর 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না টান।


খুব সুন্দর সমাধান। আমি প্রথম শুরু করার সময় আমি প্রথমে এরকম কিছু চেষ্টা করেছি, তবে আপনি ভালভাবে সংযুক্ত করেছেন এমন ইনজেকশন অংশটি + বিগিন দিকটি অনুপস্থিত ছিল। আমি আগে পোস্ট করা আমার উত্তরটির মডুলার সংস্করণে এটিকে সুন্দরভাবে অন্তর্ভুক্ত করতে সক্ষম হয়েছি।
গর্ডনফিশ

আপনার মডিউলটি ডিজাইনের স্পষ্ট বিজয়ী, তবে স্ট্যাকওভারফ্লো এছাড়াও একটি সংক্ষিপ্ততর উত্তর সরবরাহ করলে আমি এটি পছন্দ করি।
ডেটালেস
আমাদের সাইট ব্যবহার করে, আপনি স্বীকার করেছেন যে আপনি আমাদের কুকি নীতি এবং গোপনীয়তা নীতিটি পড়েছেন এবং বুঝতে পেরেছেন ।
Licensed under cc by-sa 3.0 with attribution required.