如何检测 Perl 中的递归包调用？

Question

我有一个 Perl 项目，我只是在进行循环包调用时遇到了问题。下面的代码演示了这个问题。

执行此操作时，每个包将调用另一个包，直到耗尽计算机的所有内存并锁定。我同意这是一个糟糕的设计，并且不应在设计中进行这样的循环调用，但我的项目足够大，我想在运行时检测到这一点。

我已经阅读了有关弱化函数和 Data::Structure::Util 的信息，但我还没有想出一种方法来检测是否存在循环包加载（我假设，因为每个都制作了一个新副本迭代并存储在 $this 哈希的每个副本中）。有什么想法吗？

use system::one;

my $one = new system::one(); 

package system::one;

use strict;

use system::two;

sub new {
  my ($class) = @_; 
  my $this = {};  
  bless($this,$class); 
  # attributes
  $this->{two} = new system::two();
  return $this; 
} 

package system::two;

use strict;

use system::one;

sub new {
  my ($class) = @_; 
  my $this = {};  
  bless($this,$class); 
  # attributes
  $this->{one} = new system::one();
  return $this; 
} 

Answer 1

这里，也有一些代码。 :)

sub break_recursion(;$) {
    my $allowed = @_ ? shift : 1;
    my @caller = caller(1);
    my $call = $caller[3];
    my $count = 1;
    for(my $ix = 2; @caller = caller($ix); $ix++) {
        croak "found $count levels of recursion into $call"
            if $caller[3] eq $call && ++$count > $allowed;
    }
}

sub check_recursion(;$) {
    my $allowed = @_ ? shift : 1;
    my @caller = caller(1);
    my $call = $caller[3];
    my $count = 1;
    for(my $ix = 2; @caller = caller($ix); $ix++) {
        return 1
            if $caller[3] eq $call && ++$count > $allowed;
    }
    return 0;
}

这些被称为：

break_recursion(); # to die on any recursion
break_recursion(5); # to allow up to 5 levels of recursion
my $recursing = check_recursion(); # to check for any recursion
my $recursing = check_recursion(10); # to check to see if we have more than 10 levels of recursion.

我想可能会 CPAN 这些。如果有人对此有任何想法，请分享。

Answer 2

它们位于单独的包中的事实与它无限运行并消耗所有可用资源的事实毫无关系。您从彼此内部调用两种方法。这不是循环引用，它是 recursion，这不是一回事。特别是，weaken 根本不会帮助您。你会得到完全相同的效果：

sub a {
    b();
}

sub b {
    a();
}

a();

避免这种情况的最佳方法是不要那样做。更有用的是，如果您必须编写递归函数，请尽量不要在递归链中使用多个函数，而只使用一个函数，这样您就可以更轻松地在心理上跟踪您的调用应该终止的位置。

至于如何检测是否发生了这样的事情，你必须做一些简单的事情，比如用你的递归深度增加一个变量，并在你的深度超过某个值时终止（或返回）。但是你真的不应该依赖它，它类似于编写一个while 循环并在那里使用增量来确保你的函数不会失控。除非您知道它如何以及何时终止，否则不要在集合上递归。

另一个相关的问题是您首先要完成什么？

Answer 3

我建议创建一个名为 break_constructor_recursion() 的例程，它使用 caller() 来检查调用堆栈，如下所示：

找出刚才调用我的包中的什么方法。

查看调用堆栈的其余部分，看看同一个包中的同一个方法是否更靠前。

如果是这样，用合适的东西 die()。

然后在构造函数中添加对 break_constructor_recursion() 的调用。如果构造函数是从自身内部调用的，它会爆炸。

现在，这可能会引发误报；构造函数在其内部被合法调用并非不可能。如果您对此有疑问，我想说让它在识别错误​​之前查找构造函数的一些额外出现。如果堆栈上有 20 次 system::two::new() 调用，那么您不递归的可能性非常低。

Answer 4

双重递归的经典中断是使用状态变量来确定您是否已经在函数中：

{
    my $in_a;
    sub a {
        return if $in_a; #do nothing if b(), or someone b() calls, calls a()
        $in_a = 1;
        b();
        $in_a = 0;
    }
}

如果$in_a 为真，你可以为所欲为，但dieing 或返回是常见的。如果您使用的是 Perl 5.10 或更高版本，则可以使用 state 函数，而不是将函数嵌套在自己的范围内：

sub a {
    state $in_a;
    return if $in_a; #do nothing if b(), or someone b() calls, calls a()
    $in_a = 1;
    b();
    $in_a = 0;
}

Answer 5

use warnings;

没有警告：

#!/usr/bin/perl 

use strict;

sub foo {
    foo(); 
}

foo();

-

$ perl script.pl ^C# 死后

带有警告：

#!/usr/bin/perl 

use strict;
use warnings;

sub foo {
    foo(); 
}

foo();

-

$ perl script.pl 在 script.pl 第 7 行对子例程“main::foo”进行深度递归。 ^C# 死后

始终使用警告。

use warnings FATAL => qw( recursion );

#!/usr/bin/perl 

use strict;
use warnings FATAL => qw( recursion );

sub foo {
    foo(); 
}

foo();

-

$ perl script.pl 在 script.pl 第 7 行对子例程“main::foo”进行深度递归。 $