停止使用DB::DB創建的探查器以第二次顯示未真正呼叫的呼叫-有解無憂

在尋找在我使用的框架中記錄所有使用過的子程式的可能性時，我發現了這個問題。最佳答案使用子例程 DB::DB 來記錄所有使用的子例程。這在某種程度上起作用，與 caller() 一起使用，以找出程式采用的路徑。但是我有一個問題，即當程式從一個函式回傳并進入一個新的函式時，第二次“呼叫”一個子例程。

我的 DB::DB 在 /etc/perl/Devel/AllSubs.pm

package Devel::AllSubs;

use Data::Dumper;
$Data::Dumper::Sortkeys = 1;

my $LastSub = '::';

sub DB::DB {

    my ($Package, $Filename, $Line, $Subroutine) = caller(1);

    if ($Subroutine ne $LastSub ){
        print STDERR Data::Dumper->Dump(
            [
                $Package,
                $Filename,
                $Line,
                $Subroutine
            ],
            ['Package-1', 'Filename-1', 'Line-1', "Subroutine-1"]
        );

        COUNT:
        for ( my $Count = 2; $Count < 30; $Count   ) {

            my ( $NextPackage, $NextFilename, $NextLine, $NextSubroutine ) = caller( $Count );

            last COUNT if !$NextLine;
            print STDERR Data::Dumper->Dump(
                [
                    $NextPackage,
                    $NextFilename,
                    $NextLine,
                    $NextSubroutine
                ],
                ["Package-$Count", "Filename-$Count", "Line-$Count", "Subroutine-$Count",]
            );
        }
        say STDERR "";

        $LastSub = $Subroutine;
    }

}

1;

我想檢查其呼叫的程式 perl -d:AllSubs AllTest.pl

&One();

sub One {
    &Two();
}

sub Two {
    &Three();
    &Six();
}

sub Three {
    &Four();
    &Five();
}

sub Four {}

sub Five {}

sub Six {}

1;

上面提到的答案聲稱，每個子程式都會呼叫 DB::DB，所以我的預期結果是：

# One
#   Two
#     Three
#       Four
#       Five
#     Six

我得到的是：

# One
#   Two
#     Three
#       Four
#     Three
#       Five
#   Two
#     Six

完整的 dumper 輸出是：

$Package-1 = undef;
$Filename-1 = undef;
$Line-1 = undef;
$Subroutine-1 = undef;

$Package-1 = 'main';
$Filename-1 = '/opt/frameworks/test/scripts/AllTest.pl';
$Line-1 = 30;
$Subroutine-1 = 'main::One';

$Package-1 = 'main';
$Filename-1 = '/opt/frameworks/test/scripts/AllTest.pl';
$Line-1 = 34;
$Subroutine-1 = 'main::Two';
$Package-2 = 'main';
$Filename-2 = '/opt/frameworks/test/scripts/AllTest.pl';
$Line-2 = 30;
$Subroutine-2 = 'main::One';

$Package-1 = 'main';
$Filename-1 = '/opt/frameworks/test/scripts/AllTest.pl';
$Line-1 = 38;
$Subroutine-1 = 'main::Three';
$Package-2 = 'main';
$Filename-2 = '/opt/frameworks/test/scripts/AllTest.pl';
$Line-2 = 34;
$Subroutine-2 = 'main::Two';
$Package-3 = 'main';
$Filename-3 = '/opt/frameworks/test/scripts/AllTest.pl';
$Line-3 = 30;
$Subroutine-3 = 'main::One';

$Package-1 = 'main';
$Filename-1 = '/opt/frameworks/test/scripts/AllTest.pl';
$Line-1 = 43;
$Subroutine-1 = 'main::Four';
$Package-2 = 'main';
$Filename-2 = '/opt/frameworks/test/scripts/AllTest.pl';
$Line-2 = 38;
$Subroutine-2 = 'main::Three';
$Package-3 = 'main';
$Filename-3 = '/opt/frameworks/test/scripts/AllTest.pl';
$Line-3 = 34;
$Subroutine-3 = 'main::Two';
$Package-4 = 'main';
$Filename-4 = '/opt/frameworks/test/scripts/AllTest.pl';
$Line-4 = 30;
$Subroutine-4 = 'main::One';

$Package-1 = 'main';
$Filename-1 = '/opt/frameworks/test/scripts/AllTest.pl';
$Line-1 = 38;
$Subroutine-1 = 'main::Three';
$Package-2 = 'main';
$Filename-2 = '/opt/frameworks/test/scripts/AllTest.pl';
$Line-2 = 34;
$Subroutine-2 = 'main::Two';
$Package-3 = 'main';
$Filename-3 = '/opt/frameworks/test/scripts/AllTest.pl';
$Line-3 = 30;
$Subroutine-3 = 'main::One';

$Package-1 = 'main';
$Filename-1 = '/opt/frameworks/test/scripts/AllTest.pl';
$Line-1 = 44;
$Subroutine-1 = 'main::Five';
$Package-2 = 'main';
$Filename-2 = '/opt/frameworks/test/scripts/AllTest.pl';
$Line-2 = 38;
$Subroutine-2 = 'main::Three';
$Package-3 = 'main';
$Filename-3 = '/opt/frameworks/test/scripts/AllTest.pl';
$Line-3 = 34;
$Subroutine-3 = 'main::Two';
$Package-4 = 'main';
$Filename-4 = '/opt/frameworks/test/scripts/AllTest.pl';
$Line-4 = 30;
$Subroutine-4 = 'main::One';

$Package-1 = 'main';
$Filename-1 = '/opt/frameworks/test/scripts/AllTest.pl';
$Line-1 = 34;
$Subroutine-1 = 'main::Two';
$Package-2 = 'main';
$Filename-2 = '/opt/frameworks/test/scripts/AllTest.pl';
$Line-2 = 30;
$Subroutine-2 = 'main::One';

$Package-1 = 'main';
$Filename-1 = '/opt/frameworks/test/scripts/AllTest.pl';
$Line-1 = 39;
$Subroutine-1 = 'main::Six';
$Package-2 = 'main';
$Filename-2 = '/opt/frameworks/test/scripts/AllTest.pl';
$Line-2 = 34;
$Subroutine-2 = 'main::Two';
$Package-3 = 'main';
$Filename-3 = '/opt/frameworks/test/scripts/AllTest.pl';
$Line-3 = 30;
$Subroutine-3 = 'main::One';

$Package-1 = undef;
$Filename-1 = undef;
$Line-1 = undef;
$Subroutine-1 = undef;

有沒有辦法跳過 DB::DB 被呼叫的情況，即使它沒有在代碼中第二次呼叫？

編輯：我取得了一些進展。DB::DB 為代碼的每一行呼叫。DB::sub 另一方面是我需要的。如果我在這里使用 caller()，我會得到 caller(0) 的前一個 sub。當前子程式在$DB::sub. 但我還需要檔案名和呼叫此子程式的行。它在這里說$DB::filename應該包含檔案名，但它是空的。我還在這本perl4 書中找到了一些資訊，但目前還不足以幫助我。

uj5u.com熱心網友回復：

這是一個似乎有效的示例：

lib/Devel/MyDebugger.pm :

package Devel::MyDebugger;
package DB;
use feature qw(say);
use warnings;

our $sub;
our $dbline;
our $dbpack;
our $dbfile;

our $START_DEBUG = 0;
sub DB  {
    ($dbpack, $dbfile, $dbline) = caller;
}

sub sub {
    if ("$sub" eq "main::One") {
        $START_DEBUG = 1;
    }
    if ($START_DEBUG) {
        say "";
        say "[sub = $sub, lineno = $dbline, pack = $dbpack, file = $dbfile]";
        for ( my $frame = 0; $frame < 30; $frame   ) {
            my @info = my ($package, $filename, $line, $subroutine) = caller $frame;
            last if !$line;
            print_info($frame, @info);
        }
    }
    &$sub;
}

sub print_info {
    my ($frame, $package, $filename, $line, $subroutine) = @_;

    my $indent = " " x $frame;
    say "${indent}Package-$frame: $package";
    say "${indent}Filename-$frame: $filename";
    say "${indent}Line-$frame: $line";
    say "${indent}Subroutine-$frame: $subroutine";
}

p.pl :

#! /usr/bin/env perl
use strict;
use warnings;
&One();
sub One {
    &Two();
}
sub Two {
    &Three();
    &Six();
}
sub Three {
    &Four();
    &Five();
}
sub Four { }
sub Five { }
sub Six { }

像這樣運行除錯器：

$ perl -I./lib -d:MyDebugger p.pl

輸出：

[sub = main::One, lineno = 6, pack = main, file = p.pl]

[sub = main::Two, lineno = 8, pack = main, file = p.pl]
Package-0: main
Filename-0: p.pl
Line-0: 6
Subroutine-0: main::One

[sub = main::Three, lineno = 11, pack = main, file = p.pl]
Package-0: main
Filename-0: p.pl
Line-0: 8
Subroutine-0: main::Two
 Package-1: main
 Filename-1: p.pl
 Line-1: 6
 Subroutine-1: main::One

[sub = main::Four, lineno = 15, pack = main, file = p.pl]
Package-0: main
Filename-0: p.pl
Line-0: 11
Subroutine-0: main::Three
 Package-1: main
 Filename-1: p.pl
 Line-1: 8
 Subroutine-1: main::Two
  Package-2: main
  Filename-2: p.pl
  Line-2: 6
  Subroutine-2: main::One

[sub = main::Five, lineno = 16, pack = main, file = p.pl]
Package-0: main
Filename-0: p.pl
Line-0: 11
Subroutine-0: main::Three
 Package-1: main
 Filename-1: p.pl
 Line-1: 8
 Subroutine-1: main::Two
  Package-2: main
  Filename-2: p.pl
  Line-2: 6
  Subroutine-2: main::One

[sub = main::Six, lineno = 12, pack = main, file = p.pl]
Package-0: main
Filename-0: p.pl
Line-0: 8
Subroutine-0: main::Two
 Package-1: main
 Filename-1: p.pl
 Line-1: 6
 Subroutine-1: main::One

轉載請註明出處，本文鏈接：https://www.uj5u.com/net/350036.html

標籤：perl 调试

上一篇：請向我解釋錯誤，錯誤：渲染的鉤子比上一次渲染時更多

下一篇：如何在API平臺中公開單個端點操作？