Como é que um objeto acessar a tabela de símbolo para o pacote atual?

Question

Como eu poderia acessar a tabela de símbolo para o pacote atual um objeto foi instanciado no? Por exemplo, eu tenho algo parecido com isto:

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;

Se na implementação de do_your_job eu uso __PACKAGE__, ele irá procurar no pacote MyModule. Como eu poderia torná-la no pacote certo?

EDIT: Eu vou tentar fazer isso mais claro. Suponha que eu tenho o seguinte código:

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;

Agora, $x deve de alguma forma perceber que main é o pacote atual, e busca-lo do símbolo mesa. Eu tentei usar Scalar::Util do abençoado, mas ainda me deu MyModule vez de main. Felizmente, isso é um pouco mais claro agora.

Answer 1

Você só quer caller

caller diz-lhe o pacote de onde foi chamado. (Aqui eu adicionei um pouco de perl padrão.)

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;

Para procurá-lo e ver se ele está definido e, em seguida, ela olha para cima para chamar seria duplicá-lo como perl padrão não faz Comum Subexpressão Eliminação, então você pode muito bem 1) recolhê-lo e 2) verificação definedness de a ranhura, e 3) executá-la, se for definido.

Agora, se você criar um objeto em um pacote e usá-lo em outro, isso não vai ser muita ajuda. Você provavelmente precisará adicionar um campo adicional como 'owning_package' no construtor.

package MyMod;

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

Agora $x->{owning_package} conterá 'main'.

Answer 2

perldoc -f chamador :

#!/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;

Output:

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