web-dev-qa-db-fra.com

Comment obtenir une liste de pile d'appels en Perl?

Existe-t-il un moyen d'accéder (pour l'impression) à une liste de sous-modules à une profondeur arbitraire de sous-appels précédant une position actuelle dans un script Perl?

Je dois apporter des modifications à certains modules Perl (.pm). Le flux de travail est lancé à partir d'une page Web via un script cgi, en passant l'entrée à travers plusieurs modules/objets se terminant dans le module où j'ai besoin d'utiliser les données. Quelque part le long de la ligne, les données ont changé et j'ai besoin de savoir où.

perlstack-tracecallstack
61
slashmais

Vous pouvez utiliser Devel :: StackTrace .

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

Il se comporte comme la trace de Carp, mais vous pouvez mieux contrôler les images.

Le seul problème est que les références sont chaîne et si une valeur référencée change, vous ne la verrez pas. Cependant, vous pouvez concocter quelques trucs avec PadWalker pour imprimer les données complètes (ce serait énorme, cependant).

59
Ovid

appelant peut le faire, bien que vous souhaitiez peut-être encore plus d'informations que cela.

18
Leon Timmermans

Carp::longmess fera ce que vous voulez, et c'est standard.

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

Je suis venu avec ce sous-marin (maintenant avec une action de bénédiction facultative!)

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;
}
18
Axeman

Ce code fonctionne sans modules supplémentaires. Il suffit de l'inclure si nécessaire.

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";
}
17
Thariama

Il y a aussi Carp::confess et Carp::cluck.

16
jkramer

Celui qui est plus joli: Devel :: PrettyTrace

use Devel::PrettyTrace;
bt;
3
user2291758

Dans le cas où vous ne pouvez pas utiliser (ou que vous souhaitez éviter) des modules non principaux, voici un sous-programme simple que j'ai trouvé:

#!/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;

Il produit une sortie comme suit:

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

Ou un oneliner:

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

Vous pouvez trouver de la documentation sur l'appelant ici .

1
x-yuri