Получение всех аргументов, переданных подпрограмме в виде строки в Perl

Question

Я пытаюсь написать функцию, которая может принимать все свои аргументы и печатать их как строку точно так же, как они были введены.

Например с помощью следующей функции:

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

Я хотел бы получить следующую строку внутри функции отформатированный ТОЧНО, как показано ниже:

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

Я хочу сделайте это, чтобы я мог распечатать все аргументы так же, как они были введены для целей отладки/тестирования.

Answer 1

Perl предоставляет специальные debugging hooks, которые позволяют видеть исходные строки скомпилированных исходных файлов. Вы можете написать собственный отладчик, который печатает исходную строку каждый раз при вызове подпрограммы.

Ниже вы можете указать одну или несколько подпрограмм, которые вы хотите сопоставить; каждый раз, когда вызывается соответствующая подпрограмма, выводится соответствующая строка.

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/); 

Run:

$ 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); 

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); 

Вы получите это как выход:

тест (время);