Question

How could I access the symbol table for the current package an object was instantiated in? For example, I have something like this:

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;

If in the implementation of do_your_job I use __PACKAGE__, it will search in the MyModule package. How could I make it look in the right package?

EDIT:I'll try to make this clearer. Suppose I have the following code:

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;

Now, $x should somehow notice that main is the current package, and search it's symbol table. I tried using Scalar::Util's blessed , but it still gave me MyModule instead of main. Hopefully, this is a bit clearer now.

Was it helpful?

Solution

You just want caller

caller tells you the package from which it was called. (Here I added some standard 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;

To look it up and see if it's defined and then look it up to call it would duplicate it as standard perl doesn't do Common Subexpression Elimination, so you might as well 1) retrieve it, and 2) check definedness of the slot, and 3) run it if it is defined.

Now if you create an object in one package and use it in another, that's not going to be too much help. You would probably need to add an additional field like 'owning_package' in the constructor.

package MyMod;

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

Now $x->{owning_package} will contain 'main'.

OTHER TIPS

See 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;

Output:

C:\Temp> h
No, you can't!
Licensed under: CC-BY-SA with attribution
Not affiliated with StackOverflow
scroll top