Perl更改为数组不持久

时间:2014-10-19 03:29:45

标签: perl loops

我在perl中创建一个简单的IRC bot,我认为能够添加管理员会很有用。 所以我在顶部,声明了这个数组,有几个用户。这很好用,机器人识别我,并在我进入时选择我。 我已经声明了这个数组:

    my @adms=('user@host');

然而,我让机器人在while(1)循环中运行,因此它处于活动状态,并且处于睡眠状态。当我试图运行-adduser(这是内环这个循环)时,更改不会持续存在,我已经读过这是除了for()循环之外的任何东西中的正常行为,但这对于无用是有害的。

if ( $funcarg =~ /^-adduser (.*)/ ) {
    my $user = "$1";
    sendraw( $IRC_cur_socket, "PRIVMSG $printl $pn" );
    push( @adms, $user );
    my $p = join( ", ", @adms );
    sendraw( $IRC_cur_socket, "PRIVMSG $printl Current admins are now $p" );
}

如何让这些更改持续存在,我能够做些什么来改变这种变化?

由于

编辑: 我没有说清楚这一点。所以我将添加更多的代码和解释,以期澄清。抱歉任何歧义。

my @adms = ( "Ducktator", "System69", 'Ducktator@Duck.net' );
# It is a bit further up, but i thought to spare you the IRC connection code, as I took some of that from a public perl bot anyway.

my $line_temp;
while (1) {
    while ( !( keys(%irc_servers) ) ) { conectar( "$nick", "$servidor", "$porta" ); }
    select( undef, undef, undef, 0.01 )
        ;    #sleeping for a fraction of a second keeps the script from running to 100% cpu usage ^_^
    delete( $irc_servers{''} ) if ( defined( $irc_servers{''} ) );
    my @ready = $sel_cliente->can_read(0);
    next unless (@ready);
    foreach $fh (@ready) {
        $IRC_cur_socket = $fh;
        $meunick        = $irc_servers{$IRC_cur_socket}{'nick'};
        $nread          = sysread( $fh, $msg, 4096 );
        if ( $nread == 0 ) {
            $sel_cliente->remove($fh);
            $fh->close;
            delete( $irc_servers{$fh} );
        }
        @lines = split( /\n/, $msg );
        for ( my $c = 0; $c <= $#lines; $c++ ) {
            $line      = $lines[$c];
            $line      = $line_temp . $line if ($line_temp);
            $line_temp = '';
            $line =~ s/\r$//;
            unless ( $c == $#lines ) {
                parse("$line");
            } else {
                if ( $#lines == 0 ) {
                    parse("$line");
                } elsif ( $lines[$c] =~ /\r$/ ) {
                    parse("$line");
                } elsif ( $line =~ /^(\S+) NOTICE AUTH :\*\*\*/ ) {
                    parse("$line");
                } else {
                    $line_temp = $line;
                }
            }
        }
    }
}

sub parse {
    my $servarg = shift;
    if ( $servarg =~ /^PING \:(.*)/ ) {
        sendraw("PONG :$1");
    } elsif ( $servarg =~ /^\:(.+?)\!(.+?)\@(.+?) PRIVMSG (.+?) \:(.+)/ ) {
        my $pn       = $1;
        my $hostmask = $3;
        my $onde     = $4;
        my $args     = $5;
        if ( $args =~ /^\001VERSION\001$/ ) {
            notice( "$pn", "\001VERSION mIRC v7.25 CyberBot\001" );
        }
        # Check for what the nick is being used
        if ( grep { $_ =~ /^\Q$pn\E$/i } @adms ) {

            #Now check for the vhost being valid
            if ( grep { $_ =~ /$hostmask/i } @adms ) {

                if ( $onde eq "$meunick" ) {
                    shell( "$pn", "$args" );
                }
                #End of Connect
                if ( $args =~ /^(\Q$meunick\E|\-bot)\s+(.*)/ ) {
                    my $natrix = $1;
                    my $arg    = $2;
                    if ( $arg =~ /^\!(.*)/ ) {
                        #Here we get to set the calling command
                        ircase( "$pn", "$onde", "$1" )
                            unless ( $natrix eq "-bot" and $arg =~ /^\!nick/ );
                    } elsif ( $arg =~ /^\-(.*)/ ) {    # @ changed to -
                        $ondep = $onde;
                        $ondep = $pn if $onde eq $meunick;
                        bfunc( "$ondep", "$1" );
                    }
                }
            }
        }

    } elsif ( $servarg =~ /^\:(.+?)\!(.+?)\@-(.+?)\s+NICK\s+\:(\S+)/i ) {
        if ( lc($1) eq lc($meunick) ) {
            $meunick = $4;
            $irc_servers{$IRC_cur_socket}{'nick'} = $meunick;
        }
    } elsif ( $servarg =~ m/^\:(.+?)\s+433/i ) {
        nick( "$meunick|" . int rand(999999) );
    } elsif ( $servarg =~ m/^\:(.+?)\s+001\s+(\S+)\s/i ) {
        $meunick                              = $2;
        $irc_servers{$IRC_cur_socket}{'nick'} = $meunick;
        $irc_servers{$IRC_cur_socket}{'nome'} = "$1";
        foreach my $canal (@canais) {
            sendraw("JOIN $canal $chanpass");
        }
    }
}
# This is where i have bot functions going on, and it's when i do this code below, it doesn't update the main @adms array, the change seems to dissapear instantly.
sub bfunc {
    my $printl  = $_[0];
    my $funcarg = $_[1];
    if ( my $pid = fork ) {
        waitpid( $pid, 0 );
    } else {
        if (fork) {
            exit;
        } else {

            if ( $funcarg =~ /^-adduser (.*)/ ) {
                my $user = "$1";
                push( @adms, $user );
                my $p = join( ", ", @adms );
                sendraw( $IRC_cur_socket, "PRIVMSG $printl Current admins are now $p" );
            }
        }
    }
}

1 个答案:

答案 0 :(得分:1)

您正在分叉和修改子进程中的值,并且子进程所做的更改不能更改父进程中的值。

考虑您确定问题的功能:

# This is where I have bot functions going on, and it's when I do this code,
# it doesn't update the main @adms array; the change seems to dissapear instantly. 

sub bfunc {
   my $printl = $_[0];
   my $funcarg = $_[1];
   if (my $pid = fork) {
      waitpid($pid, 0);
   } else {
      if (fork) {
         exit;
      } else {
         if ($funcarg =~ /^-adduser (.*)/) {
         my $user="$1";
          push(@adms, $user);
         my $p=  join(", ", @adms);
          sendraw($IRC_cur_socket, "PRIVMSG $printl Current admins are now $p");
         }
        }
    }
}

父进程分叉并等待;孩子也分叉,然后退出。然后,孙子进程会修改自己的@adms数组,但它所做的更改不会反映在父进程中。