如何在运行时获取子例程的签名?

Question

Perl通过CORE::prototype提供了一个API，允许你得到一个原型。这进一步记录在案Sub::Util这是处理潜艇的记录方法，

Sub::Util::prototype，

以字符串形式返回给定$code引用的原型(如果有)。这与CORE::prototype运算符相同;这里包含它只是为了与其他函数的对称性和完整性。

但是，我在任何地方都没有看到有关如何在运行时获取签名的任何内容？perl 是否提供此功能？

Answer 1

这是非常...间接，但反解析 sub 并解析签名代码。

sub foo ($bar) { return 0 }
use B::Deparse;
$foo = B::Deparse->new->coderef2text(&foo);
# contents of foo:
# BEGIN {${^WARNING_BITS} = "x10x01x00x00x00x50x04x00x00x00x00x00x00x55x50x55x50x51x01"}
# 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 (Ww+) = /;
push @sig,$sig if $sig;
$n++;
} while ($sig);
print "Signature is (", join(",",@sig), ")n";
}

Answer 2

这目前是不可能的，原因与传统参数解析(my ($foo, $bar) = @_;)不是的原因相同：它是子例程的内部。

之前有人建议添加这样的东西，但目前似乎不太可能。

Answer 3

从 Perl 5.36 开始(至少在我的环境中)，mob 的答案不再有效，因为有多个"引导线"：

$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 (Ww+) =/ ) {
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)";
}

Answer 4

从 irc.freenode.net/#perl，

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

---

这几乎是一个perl半老板。他向我指出了 2019 年 11 月的这项工作，它开始了"签名内省 API"的道路。