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

Question

我有一个Perl项目,我通过打一个循环包调用问题.下面的代码演示了这个问题.

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

我已经阅读了弱化函数和Data :: Structure :: Util,但我还没有找到一种方法来检测是否存在循环包加载(我假设,因为在每次迭代时都会生成一个新副本并存储在$ this hash的每个副本中).有任何想法吗？

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 这些。如果有人对此有任何想法，请分享。