Welcome to ShenZhenJia Knowledge Sharing Community for programmer and developer-Open, Learning and Share
menu search
person
Welcome To Ask or Share your Answers For Others

Categories

Update3: If you like this posting please don't upvote me but upvote the genius answer by DVK below.

I have the following subroutines:

 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
";
        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;
}

But why it gives this message:

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.

Is it harmful? Error? How can fix my code so that it get rid of that message?

Update1: I update the code that runs as is with the actuall error message

Update2: I tried to modify using sub as DVK suggested. And it WORKED!

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
";
        push @all_ccomp, [@stack]; # Line 49
    }

    return @all_ccomp;
}
See Question&Answers more detail:os

与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
thumb_up_alt 0 like thumb_down_alt 0 dislike
603 views
Welcome To Ask or Share your Answers For Others

1 Answer

As per perldoc's perldiag for that error, your problem is that the inner sub is referencing a lexical variable (%marked) defined in the outer sub.

The fix is in the third paragraph (use anonymous sub):

(Warning; closure) An inner (nested) named subroutine is referencing a lexical variable defined in an outer named subroutine.

When the inner subroutine is called, it will see the value of the outer subroutine's variable as it was before and during the first call to the outer subroutine; in this case, after the first call to the outer subroutine is complete, the inner and outer subroutines will no longer share a common value for the variable. In other words, the variable will no longer be shared.

This problem can usually be solved by making the inner subroutine anonymous, using the sub {} syntax. When inner anonymous subs that reference variables in outer subroutines are created, they are automatically rebound to the current values of such variables.

Fixed code using anonymous 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
";
    push @all_ccomp, [@stack];
}
# ....

与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
thumb_up_alt 0 like thumb_down_alt 0 dislike
Welcome to ShenZhenJia Knowledge Sharing Community for programmer and developer-Open, Learning and Share
...