Как я могу получить список стека вызовов в Perl?

Есть ли способ получить доступ (для распечатки) к списку вспомогательных модулей с произвольной глубиной вспомогательных вызовов, предшествующих текущей позиции в Perl-скрипте?

Мне нужно внести изменения в некоторые модули Perl (.pm). Рабочий процесс запускается с веб-страницы через cgi-скрипт, вводящий данные через несколько модулей / объектов, заканчивающихся модулем, в котором мне нужно использовать данные. Где-то по ходу дела данные изменились, и мне нужно выяснить, где.


person slashmais    schedule 23.10.2008    source источник
comment
Хотя это не отвечает на ваш вопрос, но может помочь вам решить вашу проблему :-) Вот интересная статья, описывающая один из способов выяснить, кто изменяет ваши переменные из Отметить Доминуса   -  person Pat    schedule 23.10.2008


Ответы (8)


Вы можете использовать Devel :: StackTrace.

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

Он ведет себя как след Карпа, но вы можете получить больший контроль над кадрами.

Единственная проблема заключается в том, что ссылки преобразованы в строку, и если значение, на которое указывает ссылка, изменится, вы его не увидите. Однако вы можете подбить кое-что с помощью PadWalker, чтобы распечатать полные данные (это было бы хотя огромный).

person Ovid    schedule 23.10.2008
comment
Очень полезная альтернатива: perl -d:Confess script.pl от Devel :: Confess. - person Pablo Bianchi; 01.05.2018

Этот код работает без дополнительных модулей. Просто включите его там, где это необходимо.

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";
}
person Thariama    schedule 18.08.2016
comment
изящная техника (хотя должен сказать, что я давно не пробовал Perl :) - person slashmais; 18.08.2016
comment
Должен сказать, очень приятно! Спасибо :-) - person frr; 10.07.2017
comment
начинать с 0, а не с 1. - person Jim Balter; 27.07.2019

Carp::longmess будет делать то, что вы хотите, и это стандартно.

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

Я придумал эту сабвуфер (теперь с дополнительным действием благословения!)

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;
}
person Community    schedule 23.10.2008
comment
longmess больше не является документированной или автоматически экспортируемой функцией Carp. Однако: my $mess = carp(); будет обеспечивать аналогичное, но не идентичное поведение. - person Ross Attrill; 13.06.2013

вызывающий абонент может это сделать, хотя вам может потребоваться еще больше информации.

person Leon Timmermans    schedule 23.10.2008

Также есть Carp::confess и Carp::cluck.

person jkramer    schedule 23.10.2008

Более красивый: Devel :: PrettyTrace

use Devel::PrettyTrace;
bt;
person user2291758    schedule 18.07.2014

Если вы не можете использовать (или хотите избежать) неосновные модули, вот простая подпрограмма, которую я придумал:

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

Он производит следующий вывод:

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

Или один лайнер:

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

Документацию по вызывающему абоненту можно найти здесь.

person x-yuri    schedule 14.06.2019

Перемещение моего комментария в ответ :

  1. Установите Devel :: Confess правильный путь

    cpanm Devel::Confess
    
  2. Бежать с

    perl -d:Confess myscript.pl
    

При ошибках отображается весь список стека вызовов.

person Pablo Bianchi    schedule 17.01.2020