当前包声明的子程序列表

Question

需要收集当前包本身声明的子例程列表 - 没有导入。
我看过 Package::Stash，但它列出了导入的名称（当然）。

想出了以下内容，但我不喜欢将包含内容移动到文件底部。

有人看到我如何收集相同的列表，但仍将我的包含内容保持在顶部附近吗？

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;

输出（使用“perl”-E 'use Foo;'）：

foo_1, foo_2, foo_3

如果 BEGIN 移动到另一个包含之后，我们会看到 Dumper、encode_json 等。

Answer 1

我的Devel::Examine::Subs可以做到这一点。查看允许您排除检索到的潜艇的方法（和 new() 的参数）的文档。

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

输出：

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

one, two, three

Answer 2

Deparse from core 完全可以做到这一点，所以你可以做 B::Deparse.pm 正在做的事情，即使用 B 模块来窥探 perl 的内部结构：

# 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);
        }
    }
}

示例用法：

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

应该导致：

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

如果您对 is not main 包感兴趣，您不关心空原型（如上例中的 bar），您只需要一个姓名列表，您可以将其剪切为：

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

当前包声明的子程序列表

List of subroutines current package declares

perl

symbol-table