當前包宣告的子程式串列

需要收集當前包本身宣告的子例程串列 - 沒有匯入。
我見過 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 等。

uj5u.com熱心網友回復：

Deparsefrom 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

如果您感興趣的包不是 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
}

uj5u.com熱心網友回復：

我的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

標籤：perl 符号表

上一篇：Perl嵌套哈希匹配和合并

下一篇：如果使用了-eeval開關，則強制Perl停止對命令列引數的特殊處理