停止使用DB::DB创建的分析器，以再次显示未真正调用的调用

Question

在搜索是否可能在我使用的框架中记录所有已使用的子例程时，我发现了这个问题。顶部的答案使用子程序DB::DB记录所有已使用的子例程。这在某种程度上起作用，与调用者()一起使用，以找出程序采用的路径。但是我有一个问题，当程序从一个函数返回并进入一个新的函数时，一个子例程被“称为”第二次。

My：：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

完整的翻车输出如下：

$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:另一方面，潜艇是我所需要的。如果在这里使用调用者()，就会得到调用方(0)的前一个子。当前的潜艇在$DB::sub中。但我也需要文件名和这个潜艇被调用的行。它说这里，$DB::filename应该包含文件名，但是它是空的。我还在这个perl4书中找到了一些信息，但在这一点上还不足以帮助我。

Answer 1

下面是一个似乎有效的例子：

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