Thread: [pastebot-cvs] pastebot/Client IRC.pm,1.6,1.7
Status: Beta
Brought to you by:
rcaputo
From: <ave...@us...> - 2003-10-31 22:41:59
|
Update of /cvsroot/pastebot/pastebot/Client In directory sc8-pr-cvs1:/tmp/cvs-serv18296/Client Modified Files: IRC.pm Log Message: Takes a list of nicknames now. Will try auto-reclaim if all in list are taken. Also indent was in different styles over the file, recommending diff -b. Index: IRC.pm =================================================================== RCS file: /cvsroot/pastebot/pastebot/Client/IRC.pm,v retrieving revision 1.6 retrieving revision 1.7 diff -C2 -d -r1.6 -r1.7 *** IRC.pm 31 Oct 2003 19:52:01 -0000 1.6 --- IRC.pm 31 Oct 2003 22:41:56 -0000 1.7 *************** *** 102,106 **** autoping => sub { my ($kernel, $heap) = @_[KERNEL, HEAP]; ! $kernel->post( $server => userhost => $conf{nick} ) unless $heap->{seen_traffic}; $heap->{seen_traffic} = 0; --- 102,107 ---- autoping => sub { my ($kernel, $heap) = @_[KERNEL, HEAP]; ! $kernel->post( $server => userhost => ! $conf{nicks}->[$heap->{nick_index}] ) unless $heap->{seen_traffic}; $heap->{seen_traffic} = 0; *************** *** 121,125 **** $kernel->post( $server => connect => { Debug => 0, ! Nick => $conf{nick}, Server => $chosen_server, Port => $chosen_port, --- 122,126 ---- $kernel->post( $server => connect => { Debug => 0, ! Nick => $conf{nicks}->[0], Server => $chosen_server, Port => $chosen_port, *************** *** 130,418 **** ); $heap->{server_index}++; $heap->{server_index} = 0 if $heap->{server_index} >= @{$conf{server}}; ! }, ! join => sub { ! my ($kernel, $channel) = @_[KERNEL, ARG0]; ! $kernel->post( $server => join => $channel ); ! }, ! irc_msg => sub { ! my ($kernel, $heap, $sender, $msg) = @_[KERNEL, HEAP, ARG0, ARG2]; ! my ($nick) = $sender =~ /^([^!]+)/; ! print "Message $msg from $nick\n"; ! if ($msg =~ /^\s*help(?:\s+(\w+))?\s*$/) { ! my $what = $1 || 'help'; ! if ($helptext{$what}) { ! $kernel->post( $server => privmsg => $nick, ! $helptext{$what}); ! } ! } ! elsif ($msg =~ /^\s*ignore\s/) { ! unless ($msg =~ /^\s*ignore\s+(\S+)(?:\s+(\S+))?\s*$/) { ! $kernel->post( $server => privmsg => $nick, ! "Usage: ignore <wildcard> [<channels>]"); ! return; ! } ! my ($mask, $channels) = ($1, $2); ! unless ($mask =~ /^-?\d+(\.(\*|\d+)){3}$/ ! || $mask eq '-') { ! $kernel->post($server => privmsg => $nick, ! "Invalid wildcard. Try: help wildcards"); ! return; ! } ! # save it for later ! push(@{$heap->{work}{lc $nick}}, ! [ ignore => $mask => $channels ]); ! # only for chanops - find out where they are ! @{$heap->{work}{lc $nick}} > 1 ! or $kernel->post($server => whois => $nick ); ! } ! elsif ($msg =~ /^\s*ignores\s/) { ! unless ($msg =~ /^\s*ignores\s+(\#\S+)\s*$/) { ! $kernel->post( $server => privmsg => $nick, ! "Usage: ignores <channel>"); ! return; ! } ! my $channel = lc $1; ! my @masks = get_ignores($conf{name}, $channel); ! unless (@masks) { ! $kernel->post( $server => privmsg => $nick, ! "No ignores on $channel" ); ! return; ! } ! my $text = join " ", @masks; ! substr($text, 100) = '...' unless length $text < 100; ! $kernel->post( $server=> privmsg => $nick, ! "Ignores on $channel are: $text"); ! } ! elsif ($msg =~ /^\s*delete\s/) { ! unless ($msg =~ /^\s*delete\s+(\d+)\s*$/) { ! $kernel->post( $server => privmsg => $nick, ! "Usage: delete <pasteid>"); ! return; ! } ! # save it for later ! push(@{$heap->{work}{lc $nick}}, [ delete => $1 ]); ! @{$heap->{work}{lc $nick}} > 1 ! or $kernel->post($server => whois => $nick ); ! } ! elsif ($msg =~ /^\s*uptime\s*$/) { ! my ($user_time, $system_time) = (times())[0,1]; ! my $wall_time = (time() - $^T) || 1; ! my $load_average = ! sprintf("%.4f", ($user_time+$system_time) / $wall_time); ! $kernel->post ! ( $server => privmsg => $nick, ! "I was started on " . scalar(gmtime($^T)) . " GMT. " . ! "I've been active for " . format_elapsed($wall_time, 2) . ". " . ! sprintf( "I have used about %.2f%% of a CPU during my lifespan.", ! (($user_time+$system_time)/$wall_time) * 100 ! ) ! ); ! } ! }, ! irc_319 => sub { ! my ($kernel, $heap, $msg) = @_[KERNEL, HEAP, ARG1]; ! my ($nick, $channels) = split ' ', $msg, 2; ! $channels =~ s/^://; ! my @channels = grep /^@/, split ' ', lc $channels; ! s/^@// for @channels; ! my %channels = map { $_, $_ } @channels; ! my $work = delete $heap->{work}{lc $nick}; ! for my $job (@$work) { ! my $action = shift @$job; ! if ($action eq 'ignore') { ! my ($mask, $channels) = @$job; ! my @igchans; ! if ($channels) { ! @igchans = split ',', lc $channels; ! } ! else { ! @igchans = map "#\L$_", @{$conf{channel}}; ! } ! # only the channels the user is an operator on ! @igchans = grep $channels{$_}, @igchans; ! @igchans or next; ! if ($mask eq '-') { ! for my $chan (@igchans) { ! clear_channel_ignores($conf{name}, $chan); ! print "Nick '$nick' deleted all ignores on $chan\n"; ! } ! $kernel->post( $server => privmsg => $nick => ! "Removed all ignores on @igchans"); ! } ! elsif ($mask =~ /^-(.*)$/) { ! my $mask = $1; ! for my $chan (@igchans) { ! clear_ignore($conf{name}, $chan, $mask); ! } ! $kernel->post( $server => privmsg => $nick => ! "Removed ignore $mask on @igchans"); ! } ! else { ! for my $chan (@igchans) { ! set_ignore($conf{name}, $chan, $mask); ! } ! $kernel->post( $server => privmsg => $nick => ! "Added ignore mask $mask on @igchans"); ! } ! } ! elsif ($action eq 'delete') { ! my $paste_chan = fetch_paste_channel($job->[0]); ! if (defined $paste_chan) { ! if ($channels{lc $paste_chan}) { ! delete_paste($conf{name}, $paste_chan, $job->[0], $nick) ! or print "It didn't delete!\n"; ! $kernel->post( $server => privmsg => $nick => ! "Deleted paste $job->[0]") ! } ! else { ! $kernel->post( $server => privmsg => $nick => ! "Paste $job->[0] was sent to $paste_chan - " . ! "you aren't a channel operator on $paste_chan" ! ) ! } ! } ! else { ! $kernel->post( $server => privmsg => $nick => ! "No such paste") ! } ! } ! else { ! print "Unknown action $action\n"; ! } ! } ! }, ! # negative on /whois ! irc_401 => sub { ! my ($kernel, $heap, $msg) = @_[KERNEL, HEAP, ARG1]; ! my ($nick) = split ' ', $msg; ! delete $heap->{work}{lc $nick}; ! }, ! _stop => sub { ! my $kernel = $_[KERNEL]; ! $kernel->post( $server => quit => $conf{quit} ); ! }, ! _default => sub { ! my ($state, $event, $args, $heap) = @_[STATE, ARG0, ARG1, HEAP]; ! $args ||= [ ]; ! print "default $state = $event (@$args)\n"; ! $heap->{seen_traffic} = 1; ! return 0; ! }, ! irc_001 => sub { ! my ($kernel, $heap) = @_[KERNEL, HEAP]; ! if (defined $conf{flags}) { ! $kernel->post( $server => mode => $conf{nick} => $conf{flags} ); ! } ! $kernel->post( $server => away => $conf{away} ); ! foreach my $channel (@{$conf{channel}}) { ! $kernel->yield( join => "\#$channel" ); ! } ! $heap->{server_index} = 0; ! }, ! announce => sub { ! my ($kernel, $heap, $channel, $message) = @_[KERNEL, HEAP, ARG0, ARG1]; ! $kernel->post( $server => privmsg => $channel => $message ); ! }, ! irc_ctcp_version => sub { ! my ($kernel, $sender) = @_[KERNEL, ARG0]; ! my $who = (split /!/, $sender)[0]; ! print "ctcp version from $who\n"; ! $kernel->post( $server => ctcpreply => $who, "VERSION $conf{cver}" ); ! }, ! irc_ctcp_clientinfo => sub { ! my ($kernel, $sender) = @_[KERNEL, ARG0]; ! my $who = (split /!/, $sender)[0]; ! print "ctcp clientinfo from $who\n"; ! $kernel->post( $server => ctcpreply => ! $who, "CLIENTINFO $conf{ccinfo}" ! ); ! }, ! irc_ctcp_userinfo => sub { ! my ($kernel, $sender) = @_[KERNEL, ARG0]; ! my $who = (split /!/, $sender)[0]; ! print "ctcp userinfo from $who\n"; ! $kernel->post( $server => ctcpreply => ! $who, "USERINFO $conf{cuinfo}" ! ); ! }, ! irc_invite => sub { ! my ($kernel, $who, $where) = @_[KERNEL, ARG0, ARG1]; ! $kernel->yield( join => $where ); ! }, ! irc_join => sub { ! my ($kernel, $who, $where) = @_[KERNEL, ARG0, ARG1]; ! my ($nick) = $who =~ /^([^!]+)/; ! add_channel($where) if lc $nick eq lc $conf{nick}; ! }, ! irc_kick => sub { ! my ($kernel, $who, $where, $nick, $reason) = @_[KERNEL, ARG0..ARG3]; ! print "$who was kicked from $where: $reason\n"; ! remove_channel($where) if lc $nick eq lc $conf{nick}; ! # $kernel->delay( join => 15 => $where ); ! }, ! irc_disconnected => sub { ! my ($kernel, $server) = @_[KERNEL, ARG0]; ! print "Lost connection to server $server.\n"; ! clear_channels(); ! $kernel->delay( connect => 60 ); ! }, ! irc_error => sub { ! my ($kernel, $error) = @_[KERNEL, ARG0]; ! print "Server error occurred: $error\n"; ! clear_channels(); ! $kernel->delay( connect => 60 ); ! }, ! irc_socketerr => sub { ! my ($kernel, $error) = @_[KERNEL, ARG0]; ! print "IRC client ($server): socket error occurred: $error\n"; ! clear_channels(); ! $kernel->delay( connect => 60 ); ! }, ! irc_public => sub { ! my ($kernel, $heap, $who, $where, $msg) = @_[KERNEL, HEAP, ARG0..ARG2]; ! $who = (split /!/, $who)[0]; ! $where = $where->[0]; ! print "<$who:$where> $msg\n"; ! $heap->{seen_traffic} = 1; ! # Do something with input here? }, ! }, ! ); } --- 131,459 ---- ); + $heap->{nick_index} = 0; + $heap->{server_index}++; $heap->{server_index} = 0 if $heap->{server_index} >= @{$conf{server}}; ! }, ! join => sub { ! my ($kernel, $channel) = @_[KERNEL, ARG0]; ! $kernel->post( $server => join => $channel ); ! }, ! irc_msg => sub { ! my ($kernel, $heap, $sender, $msg) = @_[KERNEL, HEAP, ARG0, ARG2]; ! my ($nick) = $sender =~ /^([^!]+)/; ! print "Message $msg from $nick\n"; ! if ($msg =~ /^\s*help(?:\s+(\w+))?\s*$/) { ! my $what = $1 || 'help'; ! if ($helptext{$what}) { ! $kernel->post( $server => privmsg => $nick, ! $helptext{$what}); ! } ! } ! elsif ($msg =~ /^\s*ignore\s/) { ! unless ($msg =~ /^\s*ignore\s+(\S+)(?:\s+(\S+))?\s*$/) { ! $kernel->post( $server => privmsg => $nick, ! "Usage: ignore <wildcard> [<channels>]"); ! return; ! } ! my ($mask, $channels) = ($1, $2); ! unless ($mask =~ /^-?\d+(\.(\*|\d+)){3}$/ ! || $mask eq '-') { ! $kernel->post($server => privmsg => $nick, ! "Invalid wildcard. Try: help wildcards"); ! return; ! } ! # save it for later ! push(@{$heap->{work}{lc $nick}}, ! [ ignore => $mask => $channels ]); ! # only for chanops - find out where they are ! @{$heap->{work}{lc $nick}} > 1 ! or $kernel->post($server => whois => $nick ); ! } ! elsif ($msg =~ /^\s*ignores\s/) { ! unless ($msg =~ /^\s*ignores\s+(\#\S+)\s*$/) { ! $kernel->post( $server => privmsg => $nick, ! "Usage: ignores <channel>"); ! return; ! } ! my $channel = lc $1; ! my @masks = get_ignores($conf{name}, $channel); ! unless (@masks) { ! $kernel->post( $server => privmsg => $nick, ! "No ignores on $channel" ); ! return; ! } ! my $text = join " ", @masks; ! substr($text, 100) = '...' unless length $text < 100; ! $kernel->post( $server=> privmsg => $nick, ! "Ignores on $channel are: $text"); ! } ! elsif ($msg =~ /^\s*delete\s/) { ! unless ($msg =~ /^\s*delete\s+(\d+)\s*$/) { ! $kernel->post( $server => privmsg => $nick, ! "Usage: delete <pasteid>"); ! return; ! } ! # save it for later ! push(@{$heap->{work}{lc $nick}}, [ delete => $1 ]); ! @{$heap->{work}{lc $nick}} > 1 ! or $kernel->post($server => whois => $nick ); ! } ! elsif ($msg =~ /^\s*uptime\s*$/) { ! my ($user_time, $system_time) = (times())[0,1]; ! my $wall_time = (time() - $^T) || 1; ! my $load_average = ! sprintf("%.4f", ($user_time+$system_time) / $wall_time); ! $kernel->post ! ( $server => privmsg => $nick, ! "I was started on " . scalar(gmtime($^T)) . " GMT. " . ! "I've been active for " . format_elapsed($wall_time, 2) . ". " . ! sprintf( "I have used about %.2f%% of a CPU during my lifespan.", ! (($user_time+$system_time)/$wall_time) * 100 ! ) ! ); ! } ! }, ! irc_319 => sub { ! my ($kernel, $heap, $msg) = @_[KERNEL, HEAP, ARG1]; ! my ($nick, $channels) = split ' ', $msg, 2; ! $channels =~ s/^://; ! my @channels = grep /^@/, split ' ', lc $channels; ! s/^@// for @channels; ! my %channels = map { $_, $_ } @channels; ! my $work = delete $heap->{work}{lc $nick}; ! for my $job (@$work) { ! my $action = shift @$job; ! if ($action eq 'ignore') { ! my ($mask, $channels) = @$job; ! my @igchans; ! if ($channels) { ! @igchans = split ',', lc $channels; ! } ! else { ! @igchans = map "#\L$_", @{$conf{channel}}; ! } ! # only the channels the user is an operator on ! @igchans = grep $channels{$_}, @igchans; ! @igchans or next; ! if ($mask eq '-') { ! for my $chan (@igchans) { ! clear_channel_ignores($conf{name}, $chan); ! print "Nick '$nick' deleted all ignores on $chan\n"; ! } ! $kernel->post( $server => privmsg => $nick => ! "Removed all ignores on @igchans"); ! } ! elsif ($mask =~ /^-(.*)$/) { ! my $mask = $1; ! for my $chan (@igchans) { ! clear_ignore($conf{name}, $chan, $mask); ! } ! $kernel->post( $server => privmsg => $nick => ! "Removed ignore $mask on @igchans"); ! } ! else { ! for my $chan (@igchans) { ! set_ignore($conf{name}, $chan, $mask); ! } ! $kernel->post( $server => privmsg => $nick => ! "Added ignore mask $mask on @igchans"); ! } ! } ! elsif ($action eq 'delete') { ! my $paste_chan = fetch_paste_channel($job->[0]); ! if (defined $paste_chan) { ! if ($channels{lc $paste_chan}) { ! delete_paste($conf{name}, $paste_chan, $job->[0], $nick) ! or print "It didn't delete!\n"; ! $kernel->post( $server => privmsg => $nick => ! "Deleted paste $job->[0]") ! } ! else { ! $kernel->post( $server => privmsg => $nick => ! "Paste $job->[0] was sent to $paste_chan - " . ! "you aren't a channel operator on $paste_chan" ! ) ! } ! } ! else { ! $kernel->post( $server => privmsg => $nick => ! "No such paste") ! } ! } ! else { ! print "Unknown action $action\n"; ! } ! } ! }, ! # negative on /whois ! irc_401 => sub { ! my ($kernel, $heap, $msg) = @_[KERNEL, HEAP, ARG1]; ! my ($nick) = split ' ', $msg; ! delete $heap->{work}{lc $nick}; ! }, ! # Nick is in use ! irc_433 => sub { ! my ($kernel, $heap) = @_[KERNEL, HEAP]; ! $heap->{nick_index}++; ! ! my $newnick = $conf{nicks}->[$heap->{nick_index} % @{$conf{nicks}}]; ! if ($heap->{nick_index} >= @{$conf{nicks}}) { ! $newnick .= $heap->{nick_index} - @{$conf{nicks}}; ! $kernel->delay( ison => 120 ); ! } ! ! warn "Nickclash, now trying $newnick\n"; ! $kernel->post( $server => nick => $newnick ); ! }, ! ! ison => sub { ! $_[KERNEL]->post( $server => ison => @{$conf{nicks}} ); ! }, ! # ISON reply ! irc_303 => sub { ! my ($kernel, $heap, $nicklist) = @_[KERNEL, HEAP, ARG1]; ! my @nicklist = split " ", lc $nicklist; ! for my $totry (@{$conf{nicks}}) { ! unless (grep $_ eq lc $totry, @nicklist) { ! $kernel->post( $server => nick => $totry ); ! return; ! } ! } ! $kernel->delay( ison => 120 ); ! }, ! _stop => sub { ! my $kernel = $_[KERNEL]; ! $kernel->post( $server => quit => $conf{quit} ); ! }, ! _default => sub { ! my ($state, $event, $args, $heap) = @_[STATE, ARG0, ARG1, HEAP]; ! $args ||= [ ]; ! print "default $state = $event (@$args)\n"; ! $heap->{seen_traffic} = 1; ! return 0; ! }, ! irc_001 => sub { ! my ($kernel, $heap) = @_[KERNEL, HEAP]; ! if (defined $conf{flags}) { ! $kernel->post( $server => mode => ! $conf{nicks}->[$heap->{nick_index}] => $conf{flags} ); ! } ! $kernel->post( $server => away => $conf{away} ); ! foreach my $channel (@{$conf{channel}}) { ! $kernel->yield( join => "\#$channel" ); ! } ! $heap->{server_index} = 0; ! }, ! announce => sub { ! my ($kernel, $heap, $channel, $message) = @_[KERNEL, HEAP, ARG0, ARG1]; ! $kernel->post( $server => privmsg => $channel => $message ); ! }, ! irc_ctcp_version => sub { ! my ($kernel, $sender) = @_[KERNEL, ARG0]; ! my $who = (split /!/, $sender)[0]; ! print "ctcp version from $who\n"; ! $kernel->post( $server => ctcpreply => $who, "VERSION $conf{cver}" ); ! }, ! irc_ctcp_clientinfo => sub { ! my ($kernel, $sender) = @_[KERNEL, ARG0]; ! my $who = (split /!/, $sender)[0]; ! print "ctcp clientinfo from $who\n"; ! $kernel->post( $server => ctcpreply => ! $who, "CLIENTINFO $conf{ccinfo}" ! ); ! }, ! irc_ctcp_userinfo => sub { ! my ($kernel, $sender) = @_[KERNEL, ARG0]; ! my $who = (split /!/, $sender)[0]; ! print "ctcp userinfo from $who\n"; ! $kernel->post( $server => ctcpreply => ! $who, "USERINFO $conf{cuinfo}" ! ); ! }, ! irc_invite => sub { ! my ($kernel, $who, $where) = @_[KERNEL, ARG0, ARG1]; ! $kernel->yield( join => $where ); ! }, ! irc_join => sub { ! my ($kernel, $heap, $who, $where) = @_[KERNEL, HEAP, ARG0, ARG1]; ! my ($nick) = $who =~ /^([^!]+)/; ! add_channel($where) ! if lc $nick eq lc $conf{nicks}->[$heap->{nick_index}]; ! }, ! irc_kick => sub { ! my ($kernel, $heap, $who, $where, $nick, $reason) ! = @_[KERNEL, HEAP, ARG0..ARG3]; ! print "$nick was kicked from $where by $who: $reason\n"; ! remove_channel($where) ! if lc $nick eq lc $conf{nicks}->[$heap->{nick_index}]; ! # $kernel->delay( join => 15 => $where ); ! }, ! irc_disconnected => sub { ! my ($kernel, $server) = @_[KERNEL, ARG0]; ! print "Lost connection to server $server.\n"; ! clear_channels(); ! $kernel->delay( connect => 60 ); ! }, ! irc_error => sub { ! my ($kernel, $error) = @_[KERNEL, ARG0]; ! print "Server error occurred: $error\n"; ! clear_channels(); ! $kernel->delay( connect => 60 ); ! }, ! ! irc_socketerr => sub { ! my ($kernel, $error) = @_[KERNEL, ARG0]; ! print "IRC client ($server): socket error occurred: $error\n"; ! clear_channels(); ! $kernel->delay( connect => 60 ); ! }, ! ! irc_public => sub { ! my ($kernel, $heap, $who, $where, $msg) = @_[KERNEL, HEAP, ARG0..ARG2]; ! $who = (split /!/, $who)[0]; ! $where = $where->[0]; ! print "<$who:$where> $msg\n"; ! ! $heap->{seen_traffic} = 1; ! ! # Do something with input here? ! }, }, ! ); } |