21

Update3:如果您喜欢这篇文章，请不要给我点赞，而是给下面 DVK 的天才答案点赞。

我有以下子程序：

 use warnings;
#Input
 my @pairs = (
    "fred bill",
    "hello bye",
    "hello fred",
    "foo bar",
    "fred foo");

#calling the subroutine
my @ccomp = connected_component(@pairs);

use Data::Dumper;
print Dumper \@ccomp;

sub connected_component {

    my  @arr    = @_;
    my %links;

    foreach my $arrm (  @arr ) {
        my ($x,$y) = split(/\s+/,$arrm);;
        $links{$x}{$y} = $links{$y}{$x} = 1;

    }

    my %marked;  # nodes we have already visited
    my @stack;

    my @all_ccomp;

    for my $node (sort keys %links) {
        next if exists $marked{$node};
        @stack = ();
        connected($node);
        print "@stack\n";
        push @all_ccomp, [@stack];
    }

    sub connected {
        no warnings 'recursion';
        my $node = shift;
        return if exists $marked{$node};  # Line 43
        $marked{$node} = 1;
        push @stack, $node;   # Line 45
        my $children = $links{$node};  # Line 46
        connected($_) for keys %$children;
    }


    return @all_ccomp;
}

但为什么它会给出这个信息：

Variable "%marked" will not stay shared at mycode.pl line 43.
Variable "@stack" will not stay shared at mycode.pl line 45.
Variable "%links" will not stay shared at mycode.pl line 46.

它有害吗？错误？如何修复我的代码以消除该消息？

Update1：​​我使用实际错误消息更新按原样运行的代码

Update2：我尝试按照 DVK 的建议使用 sub 进行修改。它奏效了！

use warnings;
#Input
 my @pairs = (
    "fred bill",
    "hello bye",
    "hello fred",
    "foo bar",
    "fred foo");

#calling the subroutine
my @ccomp = connected_component(@pairs);

use Data::Dumper;
print Dumper \@ccomp;

sub connected_component {

    my  @arr    = @_;
    my %links;

    foreach my $arrm (  @arr ) {
        my ($x,$y) = split(/\s+/,$arrm);;
        $links{$x}{$y} = $links{$y}{$x} = 1;

    }

    my %marked;  # nodes we have already visited
    my @stack;

    my @all_ccomp;

    my $connected_sub;
     $connected_sub = sub {
        no warnings 'recursion';
        my $node = shift;
        return if exists $marked{$node};  
        $marked{$node} = 1;
        push @stack, $node;  
        my $children = $links{$node};  
        &$connected_sub($_) for keys %$children;
    };

    for my $node (sort keys %links) { # Line 43
        next if exists $marked{$node};
        @stack = ();
        &$connected_sub($node);
        #print "@stack\n";
        push @all_ccomp, [@stack]; # Line 49
    }

    return @all_ccomp;
}
4

4 回答 4

53

根据perldoc针对该错误的 perldiag，您的问题是内部子引用了外部子中定义的词法变量（%marked）。

修复在第三段（使用匿名子）：

（警告；闭包）内部（嵌套）命名子例程正在引用在外部命名子例程中定义的词法变量。

当调用内部子程序时，它将看到外部子程序变量的值，就像它在第一次调用外部子程序之前和期间一样；在这种情况下，在对外部子例程的第一次调用完成后，内部子例程和外部子例程将不再共享该变量的公共值。换句话说，变量将不再被共享。

这个问题通常可以通过使用 sub {} 语法使内部子例程匿名来解决。当创建引用外部子例程中的变量的内部匿名子时，它们会自动重新绑定到此类变量的当前值。

使用匿名子的固定代码：

# ....
my $connected_sub;
$connected_sub = sub {
    no warnings 'recursion';
    my $node = shift;
    return if exists $marked{$node};  # Line 280
    $marked{$node} = 1;
    push @stack, $node;   # Line 282
    my $children = $links{$node};  # Line 283
    &$connected_sub($_) for keys %$children;
};

for my $node (sort keys %links) {
    next if exists $marked{$node};
    @stack = ();
    &$connected_sub($node);
    #print "@stack\n";
    push @all_ccomp, [@stack];
}
# ....
于 2010-10-29T01:04:50.887 回答
7

另一个（也许更简单）的出路是将变量声明为“我们的”而不是“我的”

所以，

our %marked;

代替

my %marked;

等等

于 2013-10-31T15:46:49.567 回答
6

从 perl 获取诊断消息时，通常最好检查一下perldiag以了解其含义。该手册页也恰好涵盖了您收到的警告。

基本上，命名子例程不会按照您期望的方式嵌套。解决方案包括使用匿名内部子例程，而不是嵌套命名子例程，只是在它们之间显式传递状态，或者使用类似于mysubsCPAN 的东西。

于 2010-10-29T01:05:47.520 回答
0

如果您不小心在脚本的主线程中重新声明了共享变量，也会发生此错误，

`

use vars qw(%types  %colors); 

my %types = (...);    # bad
%colors = (...);   # good

`

于 2012-10-10T15:51:43.833 回答