Pregunta

¿Hay alguna manera de acceder (para imprimir) una lista de sub+módulos con una profundidad arbitraria de subllamadas que preceden a una posición actual en un script Perl?

Necesito realizar cambios en algunos módulos de Perl (.pm).El flujo de trabajo se inicia desde una página web a través de un script cgi, pasando la entrada a través de varios módulos/objetos que terminan en el módulo donde necesito usar los datos.En algún momento los datos cambiaron y necesito averiguar dónde.

¿Fue útil?

Solución

Puede usar Devel :: StackTrace .

use Devel::StackTrace;
my $trace = Devel::StackTrace->new;
print $trace->as_string; # like carp

Se comporta como el rastro de Carp, pero puede obtener más control sobre los marcos.

El único problema es que las referencias están en cadena y si cambia un valor referenciado, no lo verá. Sin embargo, puede preparar algunas cosas con PadWalker para imprimir los datos completos (sería enorme, sin embargo).

Otros consejos

llamador puede hacerlo, aunque es posible que desee aún más información que eso.

Carp::longmess hará lo que quiera, y es estándar.

use Carp qw<longmess>;
use Data::Dumper;
sub A { &B; }
sub B { &C; }
sub C { &D; }
sub D { &E; }

sub E { 
    # Uncomment below if you want to see the place in E
    # local $Carp::CarpLevel = -1; 
    my $mess = longmess();
    print Dumper( $mess );
}

A();
__END__
$VAR1 = ' at - line 14
    main::D called at - line 12
    main::C called at - line 10
    main::B called at - line 8
    main::A() called at - line 23
';

Se me ocurrió este submarino (¡Ahora con acción de bendición opcional!)

my $stack_frame_re = qr{
    ^                # Beginning of line
    \s*              # Any number of spaces
    ( [\w:]+ )       # Package + sub
    (?: [(] ( .*? ) [)] )? # Anything between two parens
    \s+              # At least one space
    called [ ] at    # "called" followed by a single space
    \s+ ( \S+ ) \s+  # Spaces surrounding at least one non-space character
    line [ ] (\d+)   # line designation
}x;

sub get_stack {
    my @lines = split /\s*\n\s*/, longmess;
    shift @lines;
    my @frames
        = map { 
              my ( $sub_name, $arg_str, $file, $line ) = /$stack_frame_re/;
              my $ref =  { sub_name => $sub_name
                         , args     => [ map { s/^'//; s/'$//; $_ } 
                                         split /\s*,\s*/, $arg_str 
                                       ]
                         , file     => $file
                         , line     => $line 
                         };
              bless $ref, $_[0] if @_;
              $ref
          } 
          @lines
       ;
    return wantarray ? @frames : \@frames;
}

También hay Carp::confess y Carp::cluck.

Este código funciona sin módulos adicionales . Simplemente inclúyalo donde sea necesario.

my $i = 1;
print STDERR "Stack Trace:\n";
while ( (my @call_details = (caller($i++))) ){
    print STDERR $call_details[1].":".$call_details[2]." in function ".$call_details[3]."\n";
}

Uno que es más bonito: Devel :: PrettyTrace

use Devel::PrettyTrace;
bt;

En caso de que no pueda usar (o le gustaría evitar) módulos no básicos, aquí hay una subrutina simple que se me ocurrió:

#!/usr/bin/perl
use strict;
use warnings;

sub printstack {
    my ($package, $filename, $line, $subroutine, $hasargs, $wantarray, $evaltext, $is_require, $hints, $bitmask, $hinthash);
    my $i = 1;
    my @r;
    while (@r = caller($i)) {
        ($package, $filename, $line, $subroutine, $hasargs, $wantarray, $evaltext, $is_require, $hints, $bitmask, $hinthash) = @r;
        print "$filename:$line $subroutine\n";
        $i++;
    }
}

sub i {
    printstack();
}

sub h {
    i;
}

sub g {
    h;
}

g;

Produce resultados de la siguiente manera:

/root/_/1.pl:21 main::i
/root/_/1.pl:25 main::h
/root/_/1.pl:28 main::g

O un oneliner:

for (my $i = 0; my @r = caller($i); $i++) { print "$r[1]:$r[2] $r[3]\n"; }

Puede encontrar documentación sobre la persona que llama aquí .

Licenciado bajo: CC-BY-SA con atribución
No afiliado a StackOverflow
scroll top