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