Как объект получает доступ к таблице символов для текущего пакета?

Как я могу получить доступ к таблице символов для текущего пакета, в котором был создан экземпляр объекта? Например, у меня есть что-то вроде этого:

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. Надеюсь, теперь это немного яснее.


perl symbol-table
person Geo    schedule 30.11.2009    source источник
comment
Столкнувшись с такой проблемой, я первым делом обращаюсь к разделу Perl Functions by Category в perlfunc. Он имеет красиво сгруппированные списки встроенных модулей, которые позволяют легко просматривать вещи, которые могут быть связаны с рассматриваемой проблемой. В этом случае в разделе «Ключевые слова, связанные с областью действия» нужно проверить 8 пунктов. Первый caller. perldoc.perl.org/perlfunc.html#Perl-Functions-by- Категория   -  person daotoad    schedule 01.12.2009
comment
Теперь, когда мы установили правильный ответ, мне любопытно узнать, почему вы хотите это сделать. Наличие метода, обращающегося к таблице символов для пакета, создавшего экземпляр объекта, кажется мне очень плохой идеей в подавляющем большинстве случаев.   -  person Michael Carman    schedule 02.12.2009
comment
Я видел это руководство search.cpan.org/~ ROBERTMAY/Win32-GUI/docs/GUI/Tutorial/ для Win32::GUI , и я предполагал, что именно так был реализован Main_Terminate.   -  person Geo    schedule 02.12.2009
comment
@Geo: Возможно, ты прав. (По крайней мере, по духу; Win32::GUI — это прежде всего код XS.) Я всегда ненавидел наборы инструментов GUI, которые полагаются на соглашения об именах для реализации обратных вызовов.   -  person Michael Carman    schedule 02.12.2009
comment
Я хотел знать, как это было сделано... знать, что заставляет это работать, казалось довольно интересным. И это :)   -  person Geo    schedule 02.12.2009

Ответы (2)


arrow_upward
6
arrow_downward

Вам просто нужно caller

caller сообщает вам пакет, из которого он был вызван. (Здесь я добавил немного стандартного perl.)

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;

Чтобы найти его и увидеть, определено ли оно, а затем найти его, чтобы вызвать, он будет дублировать его, поскольку стандартный perl не выполняет устранение общего подвыражения, поэтому вы также можете 1) получить его и 2) проверить определенность слота, и 3) запустить его, если он определен.

Теперь, если вы создаете объект в одном пакете и используете его в другом, это не слишком поможет. Вам, вероятно, потребуется добавить в конструктор дополнительное поле, например 'owning_package'.

package MyMod;

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

Теперь $x->{owning_package} будет содержать 'main'.

person Axeman    schedule 30.11.2009
comment
Забавный Синан :) ! Я думаю, очевидно, что это было то, что я хотел с первого раза. - person Geo; 01.12.2009
comment
@Geo Хорошо, что тогда доступна история редактирования. Я имею в виду, что трое в остальном разумных людей неправильно поняли, о чем вы спрашивали, и вам пришлось разъяснить. - person Sinan Ünür; 01.12.2009
comment
Вот почему я добавил дополнительное уточнение. Я заметил, что это не то, о чем я просил. - person Geo; 01.12.2009

arrow_upward
1
arrow_downward

См. perldoc -f caller:

#!/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!
person Sinan Ünür    schedule 30.11.2009