List of subroutines current package declares

Question

Need to gather a list of the subroutines that the current package itself declares - no imports.
I've seen Package::Stash, but it lists imported names (of course).

Came up with the following, but I don't like having to move the includes to the bottom of the file.

Anyone see how I can gather the same list, but still keep my includes near the top ?

package Foo;
use common::sense;
use Function::Parameters;
        # Must import at least "fun" and "method" first for them to work.
        # See bottom of file for rest of includes.


our %package_functions;

say join q{, }, sort keys %package_functions;


sub    foo_1    { ; }
fun    foo_2 () { ; }
method foo_3 () { ; }

BEGIN {
        # This block must be kept *after* the sub declarations, and *before* imports.
        no strict 'refs';
        %package_functions = map { $_ => 1 }                 # Hash offers more convenient lookups when/if checked often.
                grep { !/^(can|fun|method)$|^_/ }            # Exclude certain names or name patterns.
                grep { ref __PACKAGE__->can($_) eq 'CODE' }  # Pick out only CODEREFs.
                keys %{__PACKAGE__ . '::'};                  # Any functions above should have their names here.
}

use JSON;
use Data::Dumper;
# use ...

1;

Outputs (with "perl" -E 'use Foo;') :

foo_1, foo_2, foo_3

If BEGIN is moved after the other includes, we see Dumper, encode_json, etc..

See also [Devel::Examine::Sub](https://metacpan.org/pod/Devel::Examine::Subs) — Håkon Hægland, Oct 08 '21 at 17:09
The problem you're encountering is that Exporter actually shoves stuff into your package's symbol table. From at point on, they're part of your package. You'll have to either keep the pattern you're currently using or prevent any imports by saying `use Bar ();` and then calling functions using the fully-qualified `Bar::baz()`. — plentyofcoffee, Oct 08 '21 at 20:39
Haven't seen Devel::Examine::Subs, thanks @HåkonHægland. Looks like it (re)reads the file from disk though ? Seems a bit silly to do, since all the info I need exists in memory already, around compile time. — robut, Oct 12 '21 at 11:58
@plentyofcoffee Wouldn't call it a problem per se, and it's not really feasible or desirable to drop all imports. I do want 'em imported, just able to pick out "mine" on compile. — robut, Oct 12 '21 at 11:59

score 3 · Accepted Answer · 2021-10-12T05:08:28.747

Deparse from core is perfectly able to do that, so you can do what B::Deparse.pm is doing, namely use the B module to peek into perl's innards:

# usage: for_subs 'package', sub { my ($sub_name, $pkg, $type, $cv) = @_; ... }
sub for_subs {
    my ($pkg, $sub) = (@_, sub { printf "%-15s %-15s %-15s%.0s\n", @_ });
    use B (); no strict 'refs';
    my %stash = B::svref_2object(\%{$pkg.'::'})->ARRAY;
    while(my($k, $v) = each %stash){
        if($v->FLAGS & B::SVf_ROK){
            my $cv = $v->RV;
            if($cv->isa('B::CV')){
                $sub->($k, $pkg, sub => $cv);
            }elsif(!$cv->isa('B::SPECIAL') and $cv->FLAGS & B::SVs_PADTMP){
                $sub->($k, $pkg, const => $cv);
            }
        }elsif($v->FLAGS & B::SVf_POK){
            $sub->($k, $pkg, proto => $v->PV);
        }elsif($v->FLAGS & B::SVf_IOK){
            $sub->($k, $pkg, proto => '');
        }elsif($v->isa('B::GV')){
            my $cv = $v->CV;
            next if $cv->isa('B::SPECIAL');
            next if ${$cv->GV} != $$v;
            $sub->($k, $pkg, sub => $cv);
        }
    }
}

Sample usage:

package P::Q { sub foo {}; sub bar; sub baz(){ 13 } }
for_subs 'P::Q';
sub foo {}; sub bar; sub baz(){ 13 }
for_subs __PACKAGE__;

should result in:

foo             P::Q            sub
bar             P::Q            proto
baz             P::Q            sub
baz             main            const
for_subs        main            sub
bar             main            proto
foo             main            sub

If the package you're interested in is not main, you don't care about empty prototypes (like the bar in the example above) and you need just a list of names, you can cut it to:

# usage: @subs = get_subs 'package'
sub get_subs {
    my @subs;
    use B (); no strict 'refs';
    my %stash = B::svref_2object(\%{shift.'::'})->ARRAY;
    while(my($k, $v) = each %stash){
        next unless $v->isa('B::GV');
        my $cv = $v->CV;
        next if $cv->isa('B::SPECIAL');
        next if ${$cv->GV} != $$v;
        push @subs, $k;
    }
    @subs
}

Awesome, this works for me - thanks for the witchcraft. – robut Oct 12 '21 at 16:40 — robut, Oct 12 '21 at 16:40

score 2 · Answer 2 · answered Oct 11 '21 at 16:55

My Devel::Examine::Subs can do this. Review the documentation for methods (and parameters to new()) that allow you to exclude subs that are retrieved.

package TestLib;

use strict;
use warnings;
use feature 'say';

use Data::Dumper;    
use Devel::Examine::Subs;
use JSON;

my $des = Devel::Examine::Subs->new(file => __FILE__);
my $sub_names = $des->all;

say join ', ', @$sub_names;

sub one {}
sub two {}
sub three {}

Output:

perl -E 'use lib "."; use TestLib'

one, two, three

List of subroutines current package declares

2 Answers2