Comment puis-je obtenir une liste d'appels en Perl?

Question

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é depuis une page Web via un script cgi, en transmettant les entrées à travers plusieurs modules / objets se terminant dans le module où je dois utiliser les données. Quelque part sur la ligne, les données ont été modifiées et je dois savoir où.

Answer 1

Vous pouvez utiliser Devel :: StackTrace .

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

Il se comporte comme le tracé de Carp, mais vous pouvez mieux contrôler les cadres.

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

Answer 2

appelant peut le faire, mais vous voudrez peut-être plus d'informations que cela.

Answer 3

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 facultative de bénédiction!)

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

Answer 4

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

Answer 5

Ce code fonctionne sans module supplémentaire . 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";
}

Answer 6

Celui qui est plus joli: Devel :: PrettyTrace

use Devel::PrettyTrace;
bt;

Answer 7

Au cas où vous ne pourriez pas utiliser (ou voudriez éviter) les modules non-core, voici un simple sous-programme que j'ai créé:

#!/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 élément de doublure:

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 .