这真是...间接的，但是反分析sub并解析签名代码。

sub foo ($bar) { return 0 }

use B::Deparse;
$foo = B::Deparse->new->coderef2text(\&foo);

# contents of foo:
# BEGIN {${^WARNING_BITS} = "\x10\x01\x00\x00\x00\x50\x04\x00\x00\x00\x00\x00\x00\x55\x50\x55\x50\x51\x01"}
# use feature 'signatures';
# die sprintf("Too many arguments for subroutine at %s line %d.\n", (caller)[1, 2]) unless @_ <= 1;
# die sprintf("Too few arguments for subroutine at %s line %d.\n", (caller)[1, 2]) unless @_ >= 1;
# my $bar = $_[0];
# return 0;

@foo = split /\n/, $foo;
if ($foo[2] =~ /use feature 'signatures'/ &&
        $foo[3] =~ /Too many arguments/ &&
        $foo[4] =~ /Too few arguments/) {
    @sig = ();
    $n = 5;
    do {
        ($sig) = $foo[$n] =~ /my (\W\w+) = /;
        push @sig,$sig if $sig;
        $n++;
    } while ($sig);
    print "Signature is (", join(",",@sig), ")\n";
}

字符串

这在目前是不可能的，原因与传统的参数解析（my ($foo, $bar) = @_;）不可能的原因相同：它在子程序内部
以前有人建议添加这样的东西，但目前似乎不太可能。

从Perl 5.36开始（至少在我的环境中），mob's answer不再工作，因为有多个“前导行”：

$VAR1 = '{';
$VAR2 = '    do {';
$VAR3 = '        package My::Package;';
$VAR4 = '        BEGIN {${^WARNING_BITS} = "\\x55\\x55\\x55\\x55\\x55\\x55\\x55\\x55\\x55\\x55\\x55\\x55\\x55\\x55\\x54\\x55\\x55\\x55\\x55\\x55\\x55"}';
$VAR5 = '        use strict;';
$VAR6 = '        use feature \'current_sub\', \'evalbytes\', \'fc\', \'say\', \'signatures\', \'state\', \'switch\', \'unicode_strings\', \'unicode_eval\';';
$VAR7 = '        die sprintf("Too few arguments for subroutine at %s line %d.\\n", (caller)[1, 2]) unless @_ >= 1;';
$VAR8 = '        my $class = $_[0];';
$VAR9 = '        my @args = @_[1 .. $#_]';

字符串
下面是我创建的一个快速替代方案，它似乎对我有效：

sub _get_signature ($called_sub) {
    my $signature = q{};
    if (
        !eval {
            require B::Deparse;
            my ( $found_feature, $found_sig, @sig, @lines );
            @lines = split( /\n/, B::Deparse->new->coderef2text( \&$called_sub ) );
            foreach my $line (@lines) {
                if ( $line =~ /\w*\};/ ) {    # we've reach the end of the "do" block or similar
                    last;
                }
                if ( $line =~ /\w*use feature/ ) {
                    if ( $line =~ /signatures/ ) {
                        $found_feature = 1;
                        next;
                    }
                    last;    # no signatures
                }
                if ( $found_feature && $line =~ /^\s*my (\W\w+) =/ ) {
                    push( @sig, $1 );
                    $found_sig = 1;
                    next;
                }
                if ($found_sig) {
                    last; # if we have started to find signatures and then stopped, we've reached the end of them.
                }
            }
            if ($found_sig) {
                $signature = join( q{, }, @sig );
            }
            1;
        }
    ) {
        croak("Unable to produce signatures due to $@");
    }
    return "($signature)";
}

型

来自irc.freenode.net/#perl，

15:03 < Grinnz> there's no perl level api for that

字符串
这差不多就是perl的半老板了。他向我指出了this work from Nov 2019，它从“签名内省API”的路径开始。