Wie kann ich eine Anrufstack -Auflistung in Perl erhalten?

Question

Gibt es eine Möglichkeit, auf eine Liste des Sub + -Moduls zu einer beliebigen Tiefe der Sub-Calls vor einer aktuellen Position in einem Perl-Skript auf eine Liste des Sub + -Moduls zugreifen zu können?

Ich muss Änderungen an einigen Perl -Modulen (.pms) vornehmen. Der Workflow wird von einer Webseite durch ein CGI-Script ausgelöst und über mehrere Module/Objekte weitergegeben, die im Modul enden, wo ich die Daten verwenden muss. Irgendwo entlang der Linie änderten sich die Daten und ich muss herausfinden, wo.

Answer 1

Sie können verwenden Entwicklung :: Stacktrace.

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

Es verhält sich wie Karpfenspur, aber Sie können mehr Kontrolle über die Rahmen erhalten.

Das einzige Problem ist, dass die Referenzen strittig sind und wenn ein referenzierter Wert ändert, werden Sie es nicht sehen. Sie könnten jedoch ein paar Sachen aufschlagen Padwalker Um die vollständigen Daten auszudrucken (es wäre jedoch riesig).

Answer 2

Anrufer Kann das tun, obwohl Sie möglicherweise noch mehr Informationen wünschen.

Answer 3

Carp::longmess Ich werde tun, was du willst, und es ist 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
';

Ich habe mir dieses Sub ausgedacht (jetzt mit optionalem Blessin 'Action!)

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

Es gibt auch Carp::confess und Carp::cluck.

Answer 5

Dieser Code funktioniert ohne zusätzliche Module. Fügen Sie es einfach bei Bedarf ein.

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

Eine, die hübscher ist: Entwicklung :: Prettytrace

use Devel::PrettyTrace;
bt;

Answer 7

Falls Sie Nicht-Kern-Module nicht verwenden (oder vermeiden möchten), finden Sie hier eine einfache Unterroutine, die ich mir ausgedacht habe:

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

Es erzeugt die Ausgabe wie folgt:

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

Oder ein Oneliner:

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

Sie können Dokumentation über Caller finden hier.