Thursday, 15 April 2010

loops - Perl changes to array not persisting -



loops - Perl changes to array not persisting -

i making simple irc bot in perl, , thought useful able add together admins. have @ top, declared array, couple of users in. , works great, bot identifies me , opps me on entry. i've declared array this:

@adms=('user@host');

however have bot running in while(1) loop, it's active, , sleep. , when effort run -adduser (which insider loop) changes don't persist, have read normal behaviour within for() loop, maddeningly unhelpful.

if ( $funcarg =~ /^-adduser (.*)/ ) { $user = "$1"; sendraw( $irc_cur_socket, "privmsg $printl $pn" ); push( @adms, $user ); $p = join( ", ", @adms ); sendraw( $irc_cur_socket, "privmsg $printl current admins $p" ); }

how can create these changes persist, able commit alter back?

thanks

edit: i've not made clear enough. shall add together more code , explanation in hopes of clarification. sorry ambiguity.

my @adms = ( "ducktator", "system69", 'ducktator@duck.net' ); # bit farther up, thought spare irc connection code, took of public perl bot anyway. $line_temp; while (1) { while ( !( keys(%irc_servers) ) ) { conectar( "$nick", "$servidor", "$porta" ); } select( undef, undef, undef, 0.01 ) ; #sleeping fraction of sec keeps script running 100% cpu usage ^_^ delete( $irc_servers{''} ) if ( defined( $irc_servers{''} ) ); @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 ); ( $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 { $servarg = shift; if ( $servarg =~ /^ping \:(.*)/ ) { sendraw("pong :$1"); } elsif ( $servarg =~ /^\:(.+?)\!(.+?)\@(.+?) privmsg (.+?) \:(.+)/ ) { $pn = $1; $hostmask = $3; $onde = $4; $args = $5; if ( $args =~ /^\001version\001$/ ) { notice( "$pn", "\001version mirc v7.25 cyberbot\001" ); } # check nick beingness used if ( grep { $_ =~ /^\q$pn\e$/i } @adms ) { #now check vhost beingness valid if ( grep { $_ =~ /$hostmask/i } @adms ) { if ( $onde eq "$meunick" ) { shell( "$pn", "$args" ); } #end of connect if ( $args =~ /^(\q$meunick\e|\-bot)\s+(.*)/ ) { $natrix = $1; $arg = $2; if ( $arg =~ /^\!(.*)/ ) { #here set calling command ircase( "$pn", "$onde", "$1" ) unless ( $natrix eq "-bot" , $arg =~ /^\!nick/ ); } elsif ( $arg =~ /^\-(.*)/ ) { # @ changed - $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 $canal (@canais) { sendraw("join $canal $chanpass"); } } } # have bot functions going on, , it's when code below, doesn't update main @adms array, alter seems dissapear instantly. sub bfunc { $printl = $_[0]; $funcarg = $_[1]; if ( $pid = fork ) { waitpid( $pid, 0 ); } else { if (fork) { exit; } else { if ( $funcarg =~ /^-adduser (.*)/ ) { $user = "$1"; push( @adms, $user ); $p = join( ", ", @adms ); sendraw( $irc_cur_socket, "privmsg $printl current admins $p" ); } } } }

you forking , modifying value in kid process, , changes made kid processes cannot alter values in parent.

consider function identify problem:

# have bot functions going on, , it's when code, # doesn't update main @adms array; alter seems dissapear instantly. sub bfunc { $printl = $_[0]; $funcarg = $_[1]; if (my $pid = fork) { waitpid($pid, 0); } else { if (fork) { exit; } else { if ($funcarg =~ /^-adduser (.*)/) { $user="$1"; push(@adms, $user); $p= join(", ", @adms); sendraw($irc_cur_socket, "privmsg $printl current admins $p"); } } } }

the parent process forks , waits; kid forks, , exits. grandchild process modifies own @adms array, no alter makes reflected in parent process.

perl loops

No comments:

Post a Comment