在Perl中将传递给子例程的所有参数作为字符串获取

Question

我正在编写一个函数，可以将所有参数作为字符串打印出来，与输入的格式完全相同。

例如使用以下函数：

test('arg1' => $arg1, 'arg2' => $arg2);

我希望在函数中获取以下字符串，格式要求完全与下面的样式相同：

"'arg1' => $arg1, 'arg2' => $arg2"

我希望能够这样做，以便于调试/测试目的，将所有参数以它们被输入的方式进行打印。

- tjwrona1992

---

另一个例子：假设你想要执行 test(time)。仅仅打印 @_ 将会输出当前时间的时代值，这非常不清晰（乍一看）你实际上是在测试当前时间。 - tjwrona1992

使用 Devel::Trace，或者直接使用常规调试器，在调用该函数的行处打断点。 - ThisSuitIsBlackNot

另请参阅Debug::Show，PadWalker，Data::Dumper::Names，Data::Dumper::Lazy和Debug::ShowStuff::ShowVar。 - Håkon Hægland

还可以使用PPI解析该行，使用caller的信息。但是这会遇到其他一些问题，比如确定源文件的文件名。有关更多信息，请参见此讨论。 - Håkon Hægland

Answer 1

Perl提供了特殊的调试钩子，让您可以查看编译后源文件的原始行。您可以编写自定义调试器，在每次调用子例程时打印出原始行。

以下内容允许您指定一个或多个要匹配的子例程；每次调用匹配的子例程时，相应的行将被打印出来。

package Devel::ShowCalls;

our %targets;

sub import {
    my $self = shift;

    for (@_) {
        # Prepend 'main::' for names without a package specifier
        $_ = "main::$_" unless /::/;
        $targets{$_} = 1;        
    }
}

package DB;

sub DB {
    ($package, $file, $line) = caller;
}

sub sub {
    print ">> $file:$line: ",
          ${ $main::{"_<$file"} }[$line] if $Devel::ShowCalls::targets{$sub};
    &$sub;
}

1;

---

为了追踪以下程序中函数foo和Baz::qux的调用：

sub foo {}
sub bar {}
sub Baz::qux {}

foo(now => time);
bar rand;
Baz::qux( qw/unicorn pony waffles/ );

运行：

$ perl -d:ShowCalls=foo,Baz::qux myscript.pl 
>> myscript.pl:5: foo(now => time);
>> myscript.pl:7: Baz::qux( qw/unicorn pony waffles/ );

请注意，这只会打印调用的第一行，因此对于像...这样的调用无效。

foo( bar,
     baz );

- ThisSuitIsBlackNot

---

唯一的问题是我想使用这个来编写单元测试脚本。基本上，我希望我的测试每个都以其关联的函数和参数命名，这样我就不需要手动命名每个测试。有没有一种方法可以在不显式运行 Perl 调试模式的情况下实现这一点？或者也许从测试脚本本身调用调试模式？ - tjwrona1992

@tjwrona1992 如果您想对相同输入和函数运行多个测试，那么这种方法将失败。例如，使用 $foo->connect(); $foo->close(); $foo->close();，您可能希望第一个 close 关闭连接，但是您可能希望第二个 close 警告。不同的行为，但在您的方案中，两者都具有完全相同的测试名称。测试名称应该是一个描述预期行为的可读字符串。对未来的维护程序员（包括您自己！）友好一点，编写具有描述性的测试名称。 - ThisSuitIsBlackNot

Answer 2

我知道这可能不是最好的解决方案，但它能够工作：

sub test {
    my (undef, $file_name, $line_number) = caller;
    open my $fh, '<', $file_name or die $!;
    my @lines = <$fh>;
    close $fh;

    my $line = $lines[$line_number - 1];
    trim($line);

    print $line."\n";
}

sub trim {
    return map { $_ =~ s/^\s+|\s+$//g } @_;
}

现在当你运行这个：

test(time);

你将会得到以下输出：

test(time);

- tjwrona1992