Getting all arguments passed to a subroutine as a

问题:

I am trying to write a function that can take all of its arguments and print them as a string exactly as they were entered.

For example using the following function:

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

I would like to get the following string inside of the function formatted EXACTLY as seen below:

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

I want to do this so I can print all of the arguments the same way that they were entered for debugging/testing purposes.

回答1:

Perl provides special debugging hooks that let you see the raw lines of compiled source files. You can write a custom debugger that prints the original line every time a subroutine is invoked.

The following lets you specify one or more subroutines you want to match; every time a matching subroutine is invoked, the corresponding line is printed.

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;

---

To trace invocations of functions foo and Baz::qux in the following program:

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

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

Run:

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

Note that this will only print the first line of the invocation, so it won't work for calls like

foo( bar,
     baz );

回答2:

I know this is probably not the best solution, but it works:

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 } @_;
}

Now when you run this:

test(time);

You will get this as the output:

test(time);