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

Answer 1

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
}

Answer 2

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