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