كيف كائن الوصول إلى جدول الرموز لحزمة الحالية؟

Question

وكيف يمكن لي الوصول إلى جدول الرموز لحزمة الحالية تم إنشاء مثيل كائن في؟ على سبيل المثال، لدي شيء من هذا القبيل:

my $object = MyModule->new;
# this looks in the current package, to see if there's a function named run_me
# I'd like to know how to do this without passing a sub reference
$object->do_your_job;

إذا في تنفيذ do_your_job يمكنني استخدام __PACKAGE__، فإنه سيتم البحث في حزمة MyModule. كيف يمكن أن جعلها تبدو في حزمة الصحيحة؟

وتحرير: سأحاول لجعل هذا أكثر وضوحا. لنفترض لدي البرمجية التالية:

package MyMod;

sub new {
    return bless {},$_[0]
}

sub do_your_job {
    my $self = shift;
    # of course find_package_of is fictional here
    # just for this example's sake, $pkg should be main
    my $pkg = find_package_of($self);
    if(defined &{ $pkg . '::run_me' }) {
        # the function exists, call it.
    }
}

package main;

sub run_me {
   print "x should run me.\n";
}

my $x = MyMod->new;

# this should find the run_me sub in the current package and invoke it.
$x->do_your_job;

والآن، $x يجب إشعار بطريقة أو بأخرى أن main هو حزمة الحالية، والبحث أنها جدول الرموز. حاولت استخدام Scalar::Util والمباركة، لكنه لا يزال أعطاني MyModule بدلا من main. نأمل، وهذا هو أكثر وضوحا قليلا الآن.

Answer 1

وأنت فقط تريد caller

وcaller يخبرك حزمة من الذي كان يطلق عليه. (وهنا أضفت بعض بيرل قياسي).

use Symbol qw<qualify_to_ref>;
#...
my $pkg = caller;

my $symb   = qualify_to_ref( 'run_me', $pkg );
my $run_me = *{$symb}{CODE};
$run_me->() if defined $run_me;

لننظر إليه ومعرفة ما إذا كان تعريفه ومن ثم البحث عنه أن نسميها أن تكرار أنها بيرل قياسي لا تفعل المشتركة التعبير الجزئي القضاء، وذلك بالاضافة الى انك قد 1) استرجاعها، و 2) تحقق definedness من الفتحة، و3) تشغيله إذا تم تعريفه.

والآن إذا قمت بإنشاء كائن في حزمة واحدة واستخدامها في بلد آخر، وهذا لن يكون الكثير من المساعدة. ربما كنت في حاجة لإضافة حقل إضافي مثل 'owning_package' في منشئ.

package MyMod;

#...
sub new { 
    #...
    $self->{owning_package} = caller || 'main';
    #...
}

والآن سوف تحتوي $x->{owning_package} 'main'.

Answer 2

perldoc -f المتصل :

#!/usr/bin/perl

package A;
use strict; use warnings;

sub do_your_job {
    my ($self) = @_;
    my ($pkg) = caller;
    if ( my $sub = $pkg->can('run_me') ) {
        $sub->();
    }
}

package B;
use strict; use warnings;

sub test {
    A->do_your_job;
}

sub run_me {
    print "No, you can't!\n";
}

package main;

use strict; use warnings;

B->test;

وإخراج:

C:\Temp> h
No, you can't!