nate has asked for the wisdom of the Perl Monks concerning the following question:

Most honorable monks, here is a question to prove your mastery of the symbol table and Perl's intestines:

I have a collection of modules in Everything::Node:: which carry functions for specific nodetypes -- (ie Everything::Node::user contains methods for user objects, Everything::Node::document for documents, etc). All of these modules "use Everything;" which allows them to access necessary functions.

Well, this works fine and dandy -- until I actually want to "see" into a specific module and figure out which subroutines are coming from Everything::Node::user. I can check the symbol table with something like this: 

    my $module = "Everything::Node::user";

    #a bit of code clipped from the perl cookbook
    use no strict;
    local *stash;
    *stash = *{ "${module}::" };
    #this is assuming the module has been "use"d -- which it has
    my @modfuncs;
    foreach(keys %stash) 
    {
       push (@modfuncs, $_) if defined &{ $stash{$_} }; 
    }
    @modfuncs;  #my handy array of module functions

[download]

It gives me all the functions in the module, but it also gives me all the symbols that are exported from Everything.pm (or any other included modules).

All I want is the symbols that are defined by the specific module -- exclusive of exports from other modules. Is there any way I can find which package each sub originated from, so I can discriminate and only show the methods from Everything::Node::user?

Much appreciation for needed wisdoms,

--nate

PS for those of you familiar with Everything core, I'm trying to fix this bug from the "Gigantic Code Lister" in the "showchoicefunc" htmlcode...

Replies are listed 'Best First'.
Re: Can I find out which package a subroutine is from, originally?
by tye (Sage) on Jan 03, 2001 at 06:13 UTC

    In Re: Validating a Code Reference I mention my favorite, Devel::Peek::CvGV(), which I just tested and using it on \&main::ImportedFunction appears to give you the original package name.

    You could also try some of the other solutions mentioned in that thread.

    Update: Now that I got first post (j/k), here is some tested code: 

    #!/usr/bin/perl -w
use strict;
use Devel::Peek "CvGV";

my $x= CvGV(\&CvGV);
print "$x\n";
$x =~ s/^\*//;
$x =~ s/::[^:]+$//;
print "CvGV came from $x.\n";

    [download]
    which prints "*Devel::Peek::CvGV" then "CvGV came from Devel::Peek."

            - tye (but my friends call me "Tye")
[reply]
[d/l]
[select]
      Dang, you so smoove!

      Revised code as so: 

            use Devel::Peek "CvGV";
      my $module = "Everything::Node::user";

      #a bit of code clipped from the perl cookbook
      use no strict;
      local *stash;
      *stash = *{ "${module}::" };
      #this is assuming the module has been "use"d -- which it has
      my @modfuncs;
      foreach(keys %stash) 
      {
         my $glob = CvGV(\&{$stash{$_}});
         $glob =~ s/^\*//;
         push (@modfuncs, $_) if defined &{ $stash{$_} } 
            and $glob eq "$module\:\:$_"; 
      }
      @modfuncs;  #only the functions in my module!

      [download]

      And it works! Thanks...

      --nate

[reply]
[d/l]
Re: Can I find out which package a subroutine is from, originally?
by stephen (Priest) on Jan 03, 2001 at 06:22 UTC
    I'll confess that I can't test this on my box, but you might be able to use Devel::Symdump. The documentation seems to indicate that doing: 
    use Devel::Symdump;

my $dump = Devel::Symdump->new('Everything::node::user');

my @functions = $dump->functions();

    [download]
    Unfortunately, I'm just going by docs here, and don't know if this will work, or if it just encapsulates what you're already doing. Good luck.

    Update: Tested. Doesn't work... prints out all, just like your above code. Sorry.

    stephen

[reply]
[d/l]
      this actually gives me the same data that my code snippet posted above gives me. It looks like it's accessing the symbol table in a similar fashon.

      thanks anyway,

      --nate

[reply]

Back to Seekers of Perl Wisdom