停止使用 DB::DB 创建的分析器以在未真正调用的情况下第二次显示调用

Question

在寻找在我使用的框架中记录所有使用过的子例程的可能性时，我发现了这个。最佳答案使用子例程 DB::DB 来记录所有使用的子例程。这在一定程度上起作用，与 caller() 一起使用，以找出程序采用的路径。但是我有一个问题，当程序 returns 从一个函数进入一个新的函数时，子程序被第二次“调用”。

我的 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

完整的转储程序输出是：

$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。但我还需要文件名和调用此 sub 的行。它说 here that $DB::filename should contain the filename, but it is empty. I also found some information in this perl4 book，但目前还不足以帮助我。

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

停止使用 DB::DB 创建的分析器以在未真正调用的情况下第二次显示调用

Stopping a profiler created with DB::DB to show a call a second time where it wasn't really called

debugging

perl