list all subs in a package

a little drop-in subroutine for your symbol table perusing pleasure...

sub get_coderefs_href ($) {  # get hashref of all coderefs in package
   my $pkg=shift;
   my $rv;
   no strict 'refs';
   my $stash = $pkg . '::';
   for my $name (keys %$stash ) {
      my $sub = $pkg->can( $name );   # use UNIVERSAL::can
      next unless defined $sub;
      my $proto = prototype( $sub );
      next if defined $proto and length($proto)==0;
      $rv->{$name}++;
   }
   $rv;
}
[download]

Note that it will exclude constants in the specified package and oddballs like BEGIN blocks. This was modified from clever source I saw in CPAN module Package::Constants. Note that it will list also all imported subs from packages use'd by the target package.

Hope that helps a fellow Perl monk!
SSF

Comment on list all subs in a package Download Code

Replies are listed 'Best First'.
Re: list all subs in a package by ikegami (Patriarch) on Jan 01, 2009 at 23:44 UTC
I found two bugs. Given `{ package TestA; sub foo {} sub bar; sub baz() { time } sub moo {} } { package TestB; our @ISA = 'TestA'; our $bar = 1; } use Data::Dumper; print Dumper get_coderefs_href $_ for qw( TestA TestB );` [download] `baz` isn't listed as a TestA sub (false negative). `bar` is listed as a TestB sub (false positive). `bar` shows that stubs are listed. That's fine — I'd even say it's a good thing — but it's worth documenting.	[reply] [d/l] [select]
Re^2: list all subs in a package by sflitman (Hermit) on Jan 02, 2009 at 02:04 UTC
Thank you. I think baz isn't listed by design because it is a constant function with a length zero prototype. If the lines `my $proto...` and `next if defined` are commented out, baz is listed. bar should be listed, even though it is a stub, since its symbol table glob will have something in its CODE slot, and then package TestB inherits a glob *bar which gets vivified by inheritance (is that right?) when you mention `our $bar` SSF	[reply] [d/l] [select]
Re^3: list all subs in a package by ikegami (Patriarch) on Jan 02, 2009 at 02:56 UTC
I think baz isn't listed by design because it is a constant function with a length zero prototype. It's not. It has a length zero prototype, but it's not constant. The intent of the code is to remove constants since someone listing the subs in a package probably doesn't consider them to be subs. But there's no doubt that they would consider `baz` to be a sub. It should be listed. bar should be listed Depending on the purpose of the function, either both `foo` and `bar` should be listed or neither should be listed. It doesn't make sense to list one (`foo`) and not the other (`bar`). Turns out `foo` does get listed as part of TestB some of the time. If it hasn't been called yet, it won't show in TestB. If it has been called via TestB, it'll show in TestB. That doesn't make sense either. Either `foo` is a subroutine or method of TestB or its not. That's not dependent on whether it's been called or not.	[reply] [d/l] [select]
Re^4: list all subs in a package by sflitman (Hermit) on Jan 02, 2009 at 09:55 UTC
Re^5: list all subs in a package by ikegami (Patriarch) on Jan 02, 2009 at 10:26 UTC
Re: list all subs in a package by tilly (Archbishop) on Jan 02, 2009 at 08:31 UTC
First thing that leaps out at me is that prototypes are generally a bad idea. My bigger comment is that when someone tells me they are finding coderefs in a package I understand that to mean only things that I can call as subroutines rather than as methods. Therefore rather than using `$pkg->can` you should use `*{"$pkg\::$name"}{CODE}` (see perlref for an explanation).	[reply] [d/l] [select]
Re: list all subs in a package by tdlewis77 (Sexton) on Aug 06, 2017 at 14:49 UTC
You might like the results of this subroutine better: use B; collectCode(\%CODE); # collect all subroutines collectCode(\%CODE,\%Term::,"Term::"); # collect from package Term sub collectCode { my ($CODE,$pkg,$prefix) = @_; $pkg = \%:: unless defined($pkg); $prefix = "" unless defined($prefix); foreach my $key (keys %$pkg) { if ($key =~ m/^\w+::$/) { collectCode($CODE,$pkg->{$key},"$prefix$key") unless $prefix eq "" && $key eq "main::"; } else { my $cv; if (ref($pkg->{$key}) eq "CODE") { $cv = B::svref_2object($pkg->{$key}); } elsif (reftype(\$pkg->{$key}) eq "GLOB" && defined({$pkg->{$key}}{CODE})) { $cv = B::svref_2object({$pkg->{$key}}{CODE}); } $CODE->{"$prefix$key"} = { file => $cv->START->file, line => $cv->START->line } if defined($cv) && ref($cv->START) ne "B::NULL"; } } } [download]	[reply] [d/l]