string - regulares - Obtener todos los argumentos pasados ​​a una subrutina como una cadena en Perl

reemplazar caracteres en perl

Question

Intento escribir una función que pueda tomar todos sus argumentos e imprimirlos como una cadena exactamente como se ingresaron.

Por ejemplo, usando la siguiente función:

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

Me gustaría obtener la siguiente cadena dentro de la función formateada EXACTAMENTE como se ve a continuación :

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

Quiero hacer esto para poder imprimir todos los argumentos de la misma manera en que se ingresaron para fines de depuración / prueba.

Answer 1

Perl proporciona enlaces de depuración especiales que le permiten ver las líneas sin procesar de los archivos fuente compilados. Puede escribir un depurador personalizado que imprima la línea original cada vez que se invoca una subrutina.

Lo siguiente le permite especificar una o más subrutinas que desea emparejar; cada vez que se invoca una subrutina coincidente, se imprime la línea correspondiente.

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;

Para rastrear las invocaciones de las funciones foo y Baz::qux en el siguiente programa:

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

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

Correr:

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

Tenga en cuenta que esto solo imprimirá la primera línea de la invocación, por lo que no funcionará para llamadas como

foo( bar,
     baz );

Answer 2

Sé que probablemente esta no sea la mejor solución, pero funciona:

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

Ahora cuando ejecutas esto:

test(time);

Obtendrá esto como resultado:

tiempo de prueba);