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.

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

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.

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).

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]