| line | stmt | bran | cond | sub | pod | time | code | 
| 1 |  |  |  |  |  |  | package IRC::Bot; | 
| 2 |  |  |  |  |  |  |  | 
| 3 | 1 |  |  | 1 |  | 27934 | use strict; | 
|  | 1 |  |  |  |  | 3 |  | 
|  | 1 |  |  |  |  | 36 |  | 
| 4 | 1 |  |  | 1 |  | 4 | use warnings; | 
|  | 1 |  |  |  |  | 2 |  | 
|  | 1 |  |  |  |  | 46 |  | 
| 5 |  |  |  |  |  |  |  | 
| 6 |  |  |  |  |  |  | #use diagnostics;  # For development | 
| 7 | 1 |  |  |  |  | 160 | use vars qw($VERSION @ISA @EXPORT $log $seen $auth $help $quote $whois | 
| 8 | 1 |  |  | 1 |  | 6 | $qact $qactdel $quser $qtext $qchannel $delcheck); | 
|  | 1 |  |  |  |  | 6 |  | 
| 9 | 1 |  |  | 1 |  | 4 | use Carp; | 
|  | 1 |  |  |  |  | 1 |  | 
|  | 1 |  |  |  |  | 82 |  | 
| 10 | 1 |  |  | 1 |  | 4370 | use POE; | 
|  | 0 |  |  |  |  |  |  | 
|  | 0 |  |  |  |  |  |  | 
| 11 |  |  |  |  |  |  | use POE::Component::IRC; | 
| 12 |  |  |  |  |  |  | use POSIX qw( setsid ); | 
| 13 |  |  |  |  |  |  | use IRC::Bot::Log; | 
| 14 |  |  |  |  |  |  | use IRC::Bot::Seen; | 
| 15 |  |  |  |  |  |  | use IRC::Bot::Auth; | 
| 16 |  |  |  |  |  |  | use IRC::Bot::Help; | 
| 17 |  |  |  |  |  |  | use IRC::Bot::Quote; | 
| 18 |  |  |  |  |  |  | use constant NICK => 'bot'; | 
| 19 |  |  |  |  |  |  |  | 
| 20 |  |  |  |  |  |  | require Exporter; | 
| 21 |  |  |  |  |  |  |  | 
| 22 |  |  |  |  |  |  | @ISA     = qw(Exporter AutoLoader); | 
| 23 |  |  |  |  |  |  | @EXPORT  = qw(); | 
| 24 |  |  |  |  |  |  | $VERSION = '0.07'; | 
| 25 |  |  |  |  |  |  |  | 
| 26 |  |  |  |  |  |  | # Set us up the bomb | 
| 27 |  |  |  |  |  |  | sub new { | 
| 28 |  |  |  |  |  |  |  | 
| 29 |  |  |  |  |  |  | my $class = shift; | 
| 30 |  |  |  |  |  |  | my %args  = @_; | 
| 31 |  |  |  |  |  |  | return bless \%args, $class; | 
| 32 |  |  |  |  |  |  |  | 
| 33 |  |  |  |  |  |  | } | 
| 34 |  |  |  |  |  |  |  | 
| 35 |  |  |  |  |  |  | # Run the bot | 
| 36 |  |  |  |  |  |  | sub run { | 
| 37 |  |  |  |  |  |  |  | 
| 38 |  |  |  |  |  |  | my $self = shift; | 
| 39 |  |  |  |  |  |  | if ($self->{'LogPath'} eq '') { | 
| 40 |  |  |  |  |  |  | $self->{'LogPath'} = $ENV{'HOME'} . "/"; | 
| 41 |  |  |  |  |  |  | } | 
| 42 |  |  |  |  |  |  | $log = IRC::Bot::Log->new( 'Path' => $self->{'LogPath'} ); | 
| 43 |  |  |  |  |  |  | $seen = IRC::Bot::Seen->new(); | 
| 44 |  |  |  |  |  |  | $auth = IRC::Bot::Auth->new(); | 
| 45 |  |  |  |  |  |  | $help = IRC::Bot::Help->new(); | 
| 46 |  |  |  |  |  |  | $quote = IRC::Bot::Quote->new(); | 
| 47 |  |  |  |  |  |  |  | 
| 48 |  |  |  |  |  |  | POE::Component::IRC->new(NICK) | 
| 49 |  |  |  |  |  |  | || croak "Cannot create new P::C::I object!\n"; | 
| 50 |  |  |  |  |  |  |  | 
| 51 |  |  |  |  |  |  | POE::Session->create( | 
| 52 |  |  |  |  |  |  | object_states => [ | 
| 53 |  |  |  |  |  |  | $self => { | 
| 54 |  |  |  |  |  |  | _start           => "bot_start", | 
| 55 |  |  |  |  |  |  | irc_001          => "on_connect", | 
| 56 |  |  |  |  |  |  | irc_disconnected => "on_disco", | 
| 57 |  |  |  |  |  |  | irc_public       => "on_public", | 
| 58 |  |  |  |  |  |  | irc_msg          => "on_msg", | 
| 59 |  |  |  |  |  |  | irc_quit         => "on_quit", | 
| 60 |  |  |  |  |  |  | irc_join         => "on_join", | 
| 61 |  |  |  |  |  |  | irc_part         => "on_part", | 
| 62 |  |  |  |  |  |  | irc_mode         => "on_mode", | 
| 63 |  |  |  |  |  |  | irc_kick         => "on_kick", | 
| 64 |  |  |  |  |  |  | irc_notice       => "on_notice", | 
| 65 |  |  |  |  |  |  | irc_ctcp_ping    => "on_ping", | 
| 66 |  |  |  |  |  |  | irc_ctcp_version => "on_ver", | 
| 67 |  |  |  |  |  |  | irc_ctcp_finger  => "on_finger", | 
| 68 |  |  |  |  |  |  | irc_ctcp_page    => "on_page", | 
| 69 |  |  |  |  |  |  | irc_ctcp_time    => "on_time", | 
| 70 |  |  |  |  |  |  | irc_ctcp_action  => "on_action", | 
| 71 |  |  |  |  |  |  | irc_nick         => "on_nick", | 
| 72 |  |  |  |  |  |  | keepalive        => "keepalive", | 
| 73 |  |  |  |  |  |  | irc_433          => "on_nick_taken", | 
| 74 |  |  |  |  |  |  | irc_353          => "on_names", | 
| 75 |  |  |  |  |  |  | irc_dcc_request  => "on_dcc_req", | 
| 76 |  |  |  |  |  |  | irc_dcc_error    => "on_dcc_err", | 
| 77 |  |  |  |  |  |  | irc_dcc_done     => "on_dcc_done", | 
| 78 |  |  |  |  |  |  | irc_dcc_start    => "on_dcc_start", | 
| 79 |  |  |  |  |  |  | irc_dcc_chat     => "on_dcc_chat", | 
| 80 |  |  |  |  |  |  |  | 
| 81 |  |  |  |  |  |  | } | 
| 82 |  |  |  |  |  |  | ] | 
| 83 |  |  |  |  |  |  | ); | 
| 84 |  |  |  |  |  |  | $poe_kernel->run(); | 
| 85 |  |  |  |  |  |  | } | 
| 86 |  |  |  |  |  |  |  | 
| 87 |  |  |  |  |  |  | # Start the bot things up | 
| 88 |  |  |  |  |  |  | sub bot_start { | 
| 89 |  |  |  |  |  |  |  | 
| 90 |  |  |  |  |  |  | my ( $self, $kernel, $session ) = @_[ OBJECT, KERNEL, SESSION ]; | 
| 91 |  |  |  |  |  |  |  | 
| 92 |  |  |  |  |  |  | my $ts = scalar(localtime); | 
| 93 |  |  |  |  |  |  | $log->serv_log("[$ts] Starting Up..."); | 
| 94 |  |  |  |  |  |  |  | 
| 95 |  |  |  |  |  |  | $kernel->post( NICK, 'register', 'all' ); | 
| 96 |  |  |  |  |  |  | $kernel->post( | 
| 97 |  |  |  |  |  |  | NICK, | 
| 98 |  |  |  |  |  |  | 'connect', | 
| 99 |  |  |  |  |  |  | { | 
| 100 |  |  |  |  |  |  | Debug    => $self->{'Debug'}, | 
| 101 |  |  |  |  |  |  | Nick     => $self->{'Nick'}, | 
| 102 |  |  |  |  |  |  | Server   => $self->{'Server'}, | 
| 103 |  |  |  |  |  |  | Port     => $self->{'Port'}, | 
| 104 |  |  |  |  |  |  | Username => $self->{'Username'}, | 
| 105 |  |  |  |  |  |  | Password => $self->{'Password'}, | 
| 106 |  |  |  |  |  |  | Ircname  => $self->{'Ircname'}, | 
| 107 |  |  |  |  |  |  | NSPass   => $self->{'NSPass'} | 
| 108 |  |  |  |  |  |  | } | 
| 109 |  |  |  |  |  |  | ); | 
| 110 |  |  |  |  |  |  | $kernel->delay( 'reconnect', 20 ); | 
| 111 |  |  |  |  |  |  | } | 
| 112 |  |  |  |  |  |  |  | 
| 113 |  |  |  |  |  |  | # Handle connect event | 
| 114 |  |  |  |  |  |  | # Join specified channels | 
| 115 |  |  |  |  |  |  | sub on_connect { | 
| 116 |  |  |  |  |  |  |  | 
| 117 |  |  |  |  |  |  | my ( $self, $kernel ) = @_[ OBJECT, KERNEL ]; | 
| 118 |  |  |  |  |  |  | $kernel->post( NICK, 'mode', $self->{'Nick'}, '+B' ); | 
| 119 |  |  |  |  |  |  | if ($self->{'NSPass'}) { | 
| 120 |  |  |  |  |  |  | my $msg = "identify " . $self->{'NSPass'}; | 
| 121 |  |  |  |  |  |  | $self->botspeak( $kernel, 'NickServ', $msg ); | 
| 122 |  |  |  |  |  |  | } | 
| 123 |  |  |  |  |  |  | foreach my $chan ( @{ $self->{'Channels'} } ) { | 
| 124 |  |  |  |  |  |  | $kernel->post( NICK, 'join', $chan ); | 
| 125 |  |  |  |  |  |  | } | 
| 126 |  |  |  |  |  |  | } | 
| 127 |  |  |  |  |  |  |  | 
| 128 |  |  |  |  |  |  | # Someone pinged us, handle it. | 
| 129 |  |  |  |  |  |  | sub on_ping { | 
| 130 |  |  |  |  |  |  |  | 
| 131 |  |  |  |  |  |  | my ( $self, $kernel, $who ) = @_[ OBJECT, KERNEL, ARG0 ]; | 
| 132 |  |  |  |  |  |  | my $nick = ( split /!/, $who )[0]; | 
| 133 |  |  |  |  |  |  | $kernel->post( NICK, 'ctcpreply', $nick, "PING", "PONG" ); | 
| 134 |  |  |  |  |  |  |  | 
| 135 |  |  |  |  |  |  | } | 
| 136 |  |  |  |  |  |  |  | 
| 137 |  |  |  |  |  |  | # Someone changed their nick, handle it. | 
| 138 |  |  |  |  |  |  | sub on_nick { | 
| 139 |  |  |  |  |  |  |  | 
| 140 |  |  |  |  |  |  | my ( $self, $kernel, $who, $nnick ) = @_[ OBJECT, KERNEL, ARG0, ARG1 ]; | 
| 141 |  |  |  |  |  |  | my $nick = ( split /!/, $who )[0]; | 
| 142 |  |  |  |  |  |  | $seen->log_seen( $nick, "Changing nick to $nnick" ); | 
| 143 |  |  |  |  |  |  |  | 
| 144 |  |  |  |  |  |  | } | 
| 145 |  |  |  |  |  |  |  | 
| 146 |  |  |  |  |  |  | # Handle CTCP Version | 
| 147 |  |  |  |  |  |  | sub on_ver { | 
| 148 |  |  |  |  |  |  |  | 
| 149 |  |  |  |  |  |  | my ( $self, $kernel, $who ) = @_[ OBJECT, KERNEL, ARG0 ]; | 
| 150 |  |  |  |  |  |  | my $nick = ( split /!/, $who )[0]; | 
| 151 |  |  |  |  |  |  | $kernel->post( NICK, 'ctcpreply', $nick, "VERSION", "Ima Bot" ); | 
| 152 |  |  |  |  |  |  |  | 
| 153 |  |  |  |  |  |  | } | 
| 154 |  |  |  |  |  |  |  | 
| 155 |  |  |  |  |  |  | # Handle CTCP Finger | 
| 156 |  |  |  |  |  |  | sub on_finger { | 
| 157 |  |  |  |  |  |  |  | 
| 158 |  |  |  |  |  |  | my ( $self, $kernel, $who ) = @_[ OBJECT, KERNEL, ARG0 ]; | 
| 159 |  |  |  |  |  |  | my $nick = ( split /!/, $who )[0]; | 
| 160 |  |  |  |  |  |  | $kernel->post( NICK, 'ctcpreply', $nick, "FINGER", "Ima Bot" ); | 
| 161 |  |  |  |  |  |  |  | 
| 162 |  |  |  |  |  |  | } | 
| 163 |  |  |  |  |  |  |  | 
| 164 |  |  |  |  |  |  | # Handle CTCP Page | 
| 165 |  |  |  |  |  |  | sub on_page { | 
| 166 |  |  |  |  |  |  |  | 
| 167 |  |  |  |  |  |  | my ( $self, $kernel, $who ) = @_[ OBJECT, KERNEL, ARG0 ]; | 
| 168 |  |  |  |  |  |  | my $nick = ( split /!/, $who )[0]; | 
| 169 |  |  |  |  |  |  | $kernel->post( NICK, 'ctcpreply', $nick, "PAGE", "Ima Bot" ); | 
| 170 |  |  |  |  |  |  |  | 
| 171 |  |  |  |  |  |  | } | 
| 172 |  |  |  |  |  |  |  | 
| 173 |  |  |  |  |  |  | # Handle CTCP Time | 
| 174 |  |  |  |  |  |  | sub on_time { | 
| 175 |  |  |  |  |  |  |  | 
| 176 |  |  |  |  |  |  | my ( $self, $kernel, $who ) = @_[ OBJECT, KERNEL, ARG0 ]; | 
| 177 |  |  |  |  |  |  | my $nick = ( split /!/, $who )[0]; | 
| 178 |  |  |  |  |  |  | my $ts = scalar(localtime); | 
| 179 |  |  |  |  |  |  | $kernel->post( NICK, 'ctcpreply', $nick, "TIME", $ts ); | 
| 180 |  |  |  |  |  |  |  | 
| 181 |  |  |  |  |  |  | } | 
| 182 |  |  |  |  |  |  |  | 
| 183 |  |  |  |  |  |  | # Log actions | 
| 184 |  |  |  |  |  |  | sub on_action { | 
| 185 |  |  |  |  |  |  |  | 
| 186 |  |  |  |  |  |  | my ( $self, $kernel, $who, $where, $msg ) = | 
| 187 |  |  |  |  |  |  | @_[ OBJECT, KERNEL, ARG0, ARG1, ARG2 ]; | 
| 188 |  |  |  |  |  |  |  | 
| 189 |  |  |  |  |  |  | my $nick = ( split /!/, $who )[0]; | 
| 190 |  |  |  |  |  |  | my $channel = $where->[0]; | 
| 191 |  |  |  |  |  |  | my $time = sprintf( "%02d:%02d", ( localtime( time() ) )[ 2, 1 ] ); | 
| 192 |  |  |  |  |  |  | $log->chan_log("[$channel $time] Action: *$nick $msg"); | 
| 193 |  |  |  |  |  |  |  | 
| 194 |  |  |  |  |  |  | } | 
| 195 |  |  |  |  |  |  |  | 
| 196 |  |  |  |  |  |  | # Handle mode changes | 
| 197 |  |  |  |  |  |  | sub on_mode { | 
| 198 |  |  |  |  |  |  |  | 
| 199 |  |  |  |  |  |  | my ( $self, $kernel, $who, $where, $mode, $nicks ) = | 
| 200 |  |  |  |  |  |  | @_[ OBJECT, KERNEL, ARG0, ARG1, ARG2, ARG3 ]; | 
| 201 |  |  |  |  |  |  |  | 
| 202 |  |  |  |  |  |  | my $nick = ( split /!/, $who )[0]; | 
| 203 |  |  |  |  |  |  | my $time = sprintf( "%02d:%02d", ( localtime( time() ) )[ 2, 1 ] ); | 
| 204 |  |  |  |  |  |  | if ($self->{'Nick'} eq $where) { | 
| 205 |  |  |  |  |  |  | $log->bot_log("[$where $time] MODE: $mode"); | 
| 206 |  |  |  |  |  |  | } | 
| 207 |  |  |  |  |  |  | else { | 
| 208 |  |  |  |  |  |  | if ($nicks) { | 
| 209 |  |  |  |  |  |  | $log->chan_log("[$where $time] MODE: $mode $nicks by: $nick"); | 
| 210 |  |  |  |  |  |  | } | 
| 211 |  |  |  |  |  |  | else { | 
| 212 |  |  |  |  |  |  | $log->chan_log("[$where $time] MODE: $mode $where by: $nick"); | 
| 213 |  |  |  |  |  |  | } | 
| 214 |  |  |  |  |  |  | } | 
| 215 |  |  |  |  |  |  |  | 
| 216 |  |  |  |  |  |  | } | 
| 217 |  |  |  |  |  |  |  | 
| 218 |  |  |  |  |  |  | # Handle notices | 
| 219 |  |  |  |  |  |  | sub on_notice { | 
| 220 |  |  |  |  |  |  |  | 
| 221 |  |  |  |  |  |  | my ( $self, $kernel, $who, $msg ) = @_[ OBJECT, KERNEL, ARG0, ARG2 ]; | 
| 222 |  |  |  |  |  |  |  | 
| 223 |  |  |  |  |  |  | my $nick = ( split /!/, $who )[0]; | 
| 224 |  |  |  |  |  |  | my $time = sprintf( "%02d:%02d", ( localtime( time() ) )[ 2, 1 ] ); | 
| 225 |  |  |  |  |  |  | $log->bot_log("[$self->{'Nick'} $time] NOTICE: $nick: $msg"); | 
| 226 |  |  |  |  |  |  |  | 
| 227 |  |  |  |  |  |  | } | 
| 228 |  |  |  |  |  |  |  | 
| 229 |  |  |  |  |  |  | # Handle kicks | 
| 230 |  |  |  |  |  |  | sub on_kick { | 
| 231 |  |  |  |  |  |  |  | 
| 232 |  |  |  |  |  |  | my ( $self, $kernel, $who, $chan, $kickee, $msg ) = | 
| 233 |  |  |  |  |  |  | @_[ OBJECT, KERNEL, ARG0, ARG1, ARG2, ARG3 ]; | 
| 234 |  |  |  |  |  |  |  | 
| 235 |  |  |  |  |  |  | my $nick = ( split /!/, $who )[0]; | 
| 236 |  |  |  |  |  |  | my $time = sprintf( "%02d:%02d", ( localtime( time() ) )[ 2, 1 ] ); | 
| 237 |  |  |  |  |  |  | $log->chan_log("[$chan $time] KICK: $nick: $kickee ($msg)"); | 
| 238 |  |  |  |  |  |  |  | 
| 239 |  |  |  |  |  |  | } | 
| 240 |  |  |  |  |  |  |  | 
| 241 |  |  |  |  |  |  | # Handle someone quitting. | 
| 242 |  |  |  |  |  |  | sub on_quit { | 
| 243 |  |  |  |  |  |  |  | 
| 244 |  |  |  |  |  |  | my ( $self, $kernel, $who, $msg ) = @_[ OBJECT, KERNEL, ARG0, ARG1 ]; | 
| 245 |  |  |  |  |  |  | my $nick = ( split /!/, $who )[0]; | 
| 246 |  |  |  |  |  |  | my $time = sprintf( "%02d:%02d", ( localtime( time() ) )[ 2, 1 ] ); | 
| 247 |  |  |  |  |  |  | $log->serv_log("[$self->{'Nick'} $time] QUIT: $nick: $msg"); | 
| 248 |  |  |  |  |  |  | $seen->log_seen( $nick, "Quit: $msg" ); | 
| 249 |  |  |  |  |  |  |  | 
| 250 |  |  |  |  |  |  | } | 
| 251 |  |  |  |  |  |  |  | 
| 252 |  |  |  |  |  |  | # Handle join event | 
| 253 |  |  |  |  |  |  | sub on_join { | 
| 254 |  |  |  |  |  |  |  | 
| 255 |  |  |  |  |  |  | my ( $self, $kernel, $who, $where ) = @_[ OBJECT, KERNEL, ARG0, ARG1 ]; | 
| 256 |  |  |  |  |  |  | my $nick = ( split /!/, $who )[0]; | 
| 257 |  |  |  |  |  |  | my $time = sprintf( "%02d:%02d", ( localtime( time() ) )[ 2, 1 ] ); | 
| 258 |  |  |  |  |  |  | $log->chan_log("[$where $time] JOIN: $nick"); | 
| 259 |  |  |  |  |  |  | $seen->log_seen( $nick, "Joining $where" ); | 
| 260 |  |  |  |  |  |  |  | 
| 261 |  |  |  |  |  |  | } | 
| 262 |  |  |  |  |  |  |  | 
| 263 |  |  |  |  |  |  | # Handle part event | 
| 264 |  |  |  |  |  |  | sub on_part { | 
| 265 |  |  |  |  |  |  |  | 
| 266 |  |  |  |  |  |  | my ( $self, $kernel, $who, $where ) = @_[ OBJECT, KERNEL, ARG0, ARG1 ]; | 
| 267 |  |  |  |  |  |  | my $nick = ( split /!/, $who )[0]; | 
| 268 |  |  |  |  |  |  | my $time = sprintf( "%02d:%02d", ( localtime( time() ) )[ 2, 1 ] ); | 
| 269 |  |  |  |  |  |  | $log->chan_log("[$where $time] PART: $nick"); | 
| 270 |  |  |  |  |  |  | $seen->log_seen( $nick, "Parting $where" ); | 
| 271 |  |  |  |  |  |  |  | 
| 272 |  |  |  |  |  |  | } | 
| 273 |  |  |  |  |  |  |  | 
| 274 |  |  |  |  |  |  | # Changes nick if current nick is taken | 
| 275 |  |  |  |  |  |  | sub on_nick_taken { | 
| 276 |  |  |  |  |  |  |  | 
| 277 |  |  |  |  |  |  | my ( $self, $kernel ) = @_[ OBJECT, KERNEL ]; | 
| 278 |  |  |  |  |  |  | my $nick  = $self->{'Nick'}; | 
| 279 |  |  |  |  |  |  | my $rnick = int( rand(999) ); | 
| 280 |  |  |  |  |  |  | $kernel->post( NICK, 'nick', "$nick$rnick" ); | 
| 281 |  |  |  |  |  |  |  | 
| 282 |  |  |  |  |  |  | } | 
| 283 |  |  |  |  |  |  |  | 
| 284 |  |  |  |  |  |  | # Communicate with channel/nick | 
| 285 |  |  |  |  |  |  | sub botspeak { | 
| 286 |  |  |  |  |  |  |  | 
| 287 |  |  |  |  |  |  | my ( $self, $kernel, $channel, $msg ) = @_; | 
| 288 |  |  |  |  |  |  | $kernel->post( NICK, 'privmsg', $channel, $msg ); | 
| 289 |  |  |  |  |  |  |  | 
| 290 |  |  |  |  |  |  | } | 
| 291 |  |  |  |  |  |  |  | 
| 292 |  |  |  |  |  |  | # Borrowed this code from another bot | 
| 293 |  |  |  |  |  |  | # Can't for the life of me remember which one | 
| 294 |  |  |  |  |  |  | # Please, let me know if it was you, so I can | 
| 295 |  |  |  |  |  |  | # give props!! | 
| 296 |  |  |  |  |  |  | sub keepalive { | 
| 297 |  |  |  |  |  |  |  | 
| 298 |  |  |  |  |  |  | my ( $self, $kernel, $heap ) = @_[ OBJECT, KERNEL, HEAP ]; | 
| 299 |  |  |  |  |  |  | $heap->{'keepalive_time'} += 180; | 
| 300 |  |  |  |  |  |  | $kernel->alarm( 'keepalive' => $heap->{'keepalive_time'} ); | 
| 301 |  |  |  |  |  |  | $kernel->post( NICK, 'sl', 'PING ' . time() ); | 
| 302 |  |  |  |  |  |  |  | 
| 303 |  |  |  |  |  |  | } | 
| 304 |  |  |  |  |  |  |  | 
| 305 |  |  |  |  |  |  | # Handle public events | 
| 306 |  |  |  |  |  |  | sub on_public { | 
| 307 |  |  |  |  |  |  |  | 
| 308 |  |  |  |  |  |  | my ( $self, $kernel, $who, $where, $msg ) = | 
| 309 |  |  |  |  |  |  | @_[ OBJECT, KERNEL, ARG0 .. $#_ ]; | 
| 310 |  |  |  |  |  |  | my $nick = ( split /!/, $who )[0]; | 
| 311 |  |  |  |  |  |  | my $channel = $where->[0]; | 
| 312 |  |  |  |  |  |  | my $pubmsg  = $msg; | 
| 313 |  |  |  |  |  |  | my $time    = sprintf( "%02d:%02d", ( localtime( time() ) )[ 2, 1 ] ); | 
| 314 |  |  |  |  |  |  | $log->chan_log("[$channel $time] <$nick> $msg"); | 
| 315 |  |  |  |  |  |  |  | 
| 316 |  |  |  |  |  |  | if ( $msg =~ m/^!help$/i ) { | 
| 317 |  |  |  |  |  |  |  | 
| 318 |  |  |  |  |  |  | my %pubHelp = $help->pub_help(); | 
| 319 |  |  |  |  |  |  | $self->botspeak( $kernel, $channel, "Here is the help you requested:" ); | 
| 320 |  |  |  |  |  |  | foreach my $keys ( keys %pubHelp ) { | 
| 321 |  |  |  |  |  |  | $self->botspeak( $kernel, $channel, $pubHelp{$keys} ); | 
| 322 |  |  |  |  |  |  | } | 
| 323 |  |  |  |  |  |  |  | 
| 324 |  |  |  |  |  |  | } | 
| 325 |  |  |  |  |  |  | elsif ( $msg =~ m/^!ping$/i ) { | 
| 326 |  |  |  |  |  |  |  | 
| 327 |  |  |  |  |  |  | $self->botspeak( $kernel, $channel, "Pong!" ); | 
| 328 |  |  |  |  |  |  |  | 
| 329 |  |  |  |  |  |  | } | 
| 330 |  |  |  |  |  |  | elsif ( $msg =~ m/^!uptime$/i ) { | 
| 331 |  |  |  |  |  |  |  | 
| 332 |  |  |  |  |  |  | my $time = sprintf( "%d Days, %02d:%02d:%02d", | 
| 333 |  |  |  |  |  |  | ( gmtime( time() - $^T ) )[ 7, 2, 1, 0 ] ); | 
| 334 |  |  |  |  |  |  | $self->botspeak( $kernel, $channel, "I've been up for $time" ); | 
| 335 |  |  |  |  |  |  |  | 
| 336 |  |  |  |  |  |  | } | 
| 337 |  |  |  |  |  |  | elsif ( $msg =~ m/^!seen/i ) { | 
| 338 |  |  |  |  |  |  |  | 
| 339 |  |  |  |  |  |  | my @arg = split ( / /, $msg ); | 
| 340 |  |  |  |  |  |  | my $name = $arg[1]; | 
| 341 |  |  |  |  |  |  |  | 
| 342 |  |  |  |  |  |  | if ($name) { | 
| 343 |  |  |  |  |  |  |  | 
| 344 |  |  |  |  |  |  | my $fseen = $seen->get_seen($name) || undef; | 
| 345 |  |  |  |  |  |  |  | 
| 346 |  |  |  |  |  |  | if ( $name eq $nick ) { | 
| 347 |  |  |  |  |  |  | $self->botspeak( $kernel, $channel, | 
| 348 |  |  |  |  |  |  | "Looking for yourself, $nick?" ); | 
| 349 |  |  |  |  |  |  | } | 
| 350 |  |  |  |  |  |  | elsif ( $name eq $self->{'Nick'} ) { | 
| 351 |  |  |  |  |  |  | $self->botspeak( $kernel, $channel, "I'm right here, foo!" ); | 
| 352 |  |  |  |  |  |  | } | 
| 353 |  |  |  |  |  |  | elsif ( defined $fseen ) { | 
| 354 |  |  |  |  |  |  | $self->botspeak( $kernel, $channel, $fseen ); | 
| 355 |  |  |  |  |  |  | } | 
| 356 |  |  |  |  |  |  | else { | 
| 357 |  |  |  |  |  |  | $self->botspeak( $kernel, $channel, | 
| 358 |  |  |  |  |  |  | "Sorry, $nick, I haven't seen $name." ); | 
| 359 |  |  |  |  |  |  | } | 
| 360 |  |  |  |  |  |  | } | 
| 361 |  |  |  |  |  |  | else { | 
| 362 |  |  |  |  |  |  | my $seen = $help->pub_help('seen'); | 
| 363 |  |  |  |  |  |  | $self->botspeak( $kernel, $channel, | 
| 364 |  |  |  |  |  |  | "Hey $nick, it's like this: $seen" ); | 
| 365 |  |  |  |  |  |  | } | 
| 366 |  |  |  |  |  |  | } | 
| 367 |  |  |  |  |  |  | elsif ( $msg =~ m/^!quote/i ) { | 
| 368 |  |  |  |  |  |  |  | 
| 369 |  |  |  |  |  |  | my @arg  = split ( / /, $msg ); | 
| 370 |  |  |  |  |  |  | my $name  = $arg[1]; | 
| 371 |  |  |  |  |  |  | my $there = $arg[2]; | 
| 372 |  |  |  |  |  |  | $qchannel = $channel; | 
| 373 |  |  |  |  |  |  | if ($name) { | 
| 374 |  |  |  |  |  |  | if ( $msg =~ m/^!quote\s+(\w+)\s+([^"]*)\s+"([^"]*)"/i ) { | 
| 375 |  |  |  |  |  |  |  | 
| 376 |  |  |  |  |  |  | $qact  = $1; | 
| 377 |  |  |  |  |  |  | $quser = $2; | 
| 378 |  |  |  |  |  |  | $qtext = $3; | 
| 379 |  |  |  |  |  |  | my $res; | 
| 380 |  |  |  |  |  |  | if ($qact eq "add" ) { | 
| 381 |  |  |  |  |  |  | $res = $quote->quote_set( $quser, $qtext ); | 
| 382 |  |  |  |  |  |  | $self->botspeak( $kernel, $channel, $res ); | 
| 383 |  |  |  |  |  |  | } | 
| 384 |  |  |  |  |  |  | } | 
| 385 |  |  |  |  |  |  | elsif ( $msg =~ m/^!quote\s+(\w+)\s+([^"]*)$/i ) { | 
| 386 |  |  |  |  |  |  | $qactdel = $1; | 
| 387 |  |  |  |  |  |  | $quser = $2; | 
| 388 |  |  |  |  |  |  | $delcheck = 1; | 
| 389 |  |  |  |  |  |  | my $res; | 
| 390 |  |  |  |  |  |  | if ($qactdel eq "del") { | 
| 391 |  |  |  |  |  |  | $res = $quote->quote_forget( $quser ); | 
| 392 |  |  |  |  |  |  | $self->botspeak( $kernel, $channel, $res ); | 
| 393 |  |  |  |  |  |  | } | 
| 394 |  |  |  |  |  |  | } | 
| 395 |  |  |  |  |  |  | else { | 
| 396 |  |  |  |  |  |  | my $said; | 
| 397 |  |  |  |  |  |  | if ($there) { | 
| 398 |  |  |  |  |  |  | $said = $quote->quote_query( $there ); | 
| 399 |  |  |  |  |  |  | } | 
| 400 |  |  |  |  |  |  | else { | 
| 401 |  |  |  |  |  |  | $said = $quote->quote_query( $name ); | 
| 402 |  |  |  |  |  |  | } | 
| 403 |  |  |  |  |  |  | $self->botspeak( $kernel, $channel, $said ); | 
| 404 |  |  |  |  |  |  | } | 
| 405 |  |  |  |  |  |  | } | 
| 406 |  |  |  |  |  |  | else { | 
| 407 |  |  |  |  |  |  | my $rhelp = $help->pub_help('quote'); | 
| 408 |  |  |  |  |  |  | $self->botspeak( $kernel, $channel, $rhelp ); | 
| 409 |  |  |  |  |  |  | } | 
| 410 |  |  |  |  |  |  | } | 
| 411 |  |  |  |  |  |  | } | 
| 412 |  |  |  |  |  |  |  | 
| 413 |  |  |  |  |  |  | # Handle privmsg communication. | 
| 414 |  |  |  |  |  |  | sub on_msg { | 
| 415 |  |  |  |  |  |  |  | 
| 416 |  |  |  |  |  |  | my ( $self, $kernel, $who, $nicks, $msg ) = | 
| 417 |  |  |  |  |  |  | @_[ OBJECT, KERNEL, ARG0, ARG1, ARG2 ]; | 
| 418 |  |  |  |  |  |  | my $nick = ( split /!/, $who )[0]; | 
| 419 |  |  |  |  |  |  | my $time = sprintf( "%02d:%02d", ( localtime( time() ) )[ 2, 1 ] ); | 
| 420 |  |  |  |  |  |  | $log->bot_log("[$self->{'Nick'} $time] <$nick> $msg"); | 
| 421 |  |  |  |  |  |  | $self->botspeak( $kernel, $nick, | 
| 422 |  |  |  |  |  |  | "Please use DCC CHAT to communicate with me :)" ) | 
| 423 |  |  |  |  |  |  |  | 
| 424 |  |  |  |  |  |  | } | 
| 425 |  |  |  |  |  |  |  | 
| 426 |  |  |  |  |  |  | # Handle dcc request, accept and move on. | 
| 427 |  |  |  |  |  |  | sub on_dcc_req { | 
| 428 |  |  |  |  |  |  |  | 
| 429 |  |  |  |  |  |  | my ( $self, $kernel, $type, $who, $id ) = | 
| 430 |  |  |  |  |  |  | @_[ OBJECT, KERNEL, ARG0, ARG1, ARG3 ]; | 
| 431 |  |  |  |  |  |  |  | 
| 432 |  |  |  |  |  |  | $kernel->post( NICK, 'dcc_accept', $id ); | 
| 433 |  |  |  |  |  |  |  | 
| 434 |  |  |  |  |  |  | } | 
| 435 |  |  |  |  |  |  |  | 
| 436 |  |  |  |  |  |  | # Start up the DCC session, or welcome back | 
| 437 |  |  |  |  |  |  | sub on_dcc_start { | 
| 438 |  |  |  |  |  |  |  | 
| 439 |  |  |  |  |  |  | my ( $self, $kernel, $id, $who, $type ) = | 
| 440 |  |  |  |  |  |  | @_[ OBJECT, KERNEL, ARG0, ARG1, ARG2 ]; | 
| 441 |  |  |  |  |  |  | my $nick = ( split /!/, $who )[0]; | 
| 442 |  |  |  |  |  |  |  | 
| 443 |  |  |  |  |  |  | if ( $type eq 'CHAT' ) { | 
| 444 |  |  |  |  |  |  | my $check = $auth->is_auth($nick); | 
| 445 |  |  |  |  |  |  |  | 
| 446 |  |  |  |  |  |  | if ( $check != 1 ) { | 
| 447 |  |  |  |  |  |  | $kernel->post( NICK, 'dcc_chat', $id, "Please Login" ); | 
| 448 |  |  |  |  |  |  | $kernel->post( NICK, 'dcc_chat', $id, "(.login user pass)" ); | 
| 449 |  |  |  |  |  |  | } | 
| 450 |  |  |  |  |  |  | else { | 
| 451 |  |  |  |  |  |  | $auth->get_ses($nick); | 
| 452 |  |  |  |  |  |  | $kernel->post( NICK, 'dcc_chat', $id, "Welcome Back, $nick" ); | 
| 453 |  |  |  |  |  |  | } | 
| 454 |  |  |  |  |  |  |  | 
| 455 |  |  |  |  |  |  | } | 
| 456 |  |  |  |  |  |  | else { | 
| 457 |  |  |  |  |  |  | $kernel->post( NICK, 'dcc_close', $id ); | 
| 458 |  |  |  |  |  |  | } | 
| 459 |  |  |  |  |  |  |  | 
| 460 |  |  |  |  |  |  | } | 
| 461 |  |  |  |  |  |  |  | 
| 462 |  |  |  |  |  |  | # Handle a dcc_chat session, parse for commands | 
| 463 |  |  |  |  |  |  | # Act accordingly. | 
| 464 |  |  |  |  |  |  | # LOTS OF STUFF GOING ON HERE | 
| 465 |  |  |  |  |  |  | # Main command parser/dispatcher | 
| 466 |  |  |  |  |  |  | sub on_dcc_chat { | 
| 467 |  |  |  |  |  |  |  | 
| 468 |  |  |  |  |  |  | my ( $self, $kernel, $id, $who, $msg ) = | 
| 469 |  |  |  |  |  |  | @_[ OBJECT, KERNEL, ARG0, ARG1, ARG3 ]; | 
| 470 |  |  |  |  |  |  |  | 
| 471 |  |  |  |  |  |  | my $nick = ( split /!/, $who )[0]; | 
| 472 |  |  |  |  |  |  | my $check = $auth->is_auth($nick); | 
| 473 |  |  |  |  |  |  |  | 
| 474 |  |  |  |  |  |  | if ( $msg =~ m/^.login/i ) { | 
| 475 |  |  |  |  |  |  |  | 
| 476 |  |  |  |  |  |  | my @arg = split ( / /, $msg ); | 
| 477 |  |  |  |  |  |  | my $user = $arg[1]; | 
| 478 |  |  |  |  |  |  | my $pass = $arg[2]; | 
| 479 |  |  |  |  |  |  | my $time = sprintf( "%02d:%02d", ( localtime( time() ) )[ 2, 1 ] ); | 
| 480 |  |  |  |  |  |  |  | 
| 481 |  |  |  |  |  |  | if ( $user eq $self->{'Admin'} && $pass eq $self->{'Apass'} ) { | 
| 482 |  |  |  |  |  |  | $kernel->post( NICK, 'dcc_chat', $id, "Welcome, $nick!" ); | 
| 483 |  |  |  |  |  |  | $kernel->post( NICK, 'dcc_chat', $id, | 
| 484 |  |  |  |  |  |  | "All commands are prefixed with a period(.)" ); | 
| 485 |  |  |  |  |  |  | $kernel->post( NICK, 'dcc_chat', $id, "See \cB.help\cB" ); | 
| 486 |  |  |  |  |  |  | $log->bot_log("[$self->{'Nick'} $time] $nick logged in with $user"); | 
| 487 |  |  |  |  |  |  | $auth->auth_set($nick); | 
| 488 |  |  |  |  |  |  | } | 
| 489 |  |  |  |  |  |  | else { | 
| 490 |  |  |  |  |  |  | $kernel->post( NICK, 'dcc_chat', $id, "Incorrect Login Info!" ); | 
| 491 |  |  |  |  |  |  | $log->bot_log("$nick tried to login with $user"); | 
| 492 |  |  |  |  |  |  | $kernel->post( NICK, 'dcc_close', $id ); | 
| 493 |  |  |  |  |  |  | } | 
| 494 |  |  |  |  |  |  | } | 
| 495 |  |  |  |  |  |  | elsif ( $check != 0 ) { | 
| 496 |  |  |  |  |  |  |  | 
| 497 |  |  |  |  |  |  | if ( $msg =~ m/^.say/i ) { | 
| 498 |  |  |  |  |  |  |  | 
| 499 |  |  |  |  |  |  | my @arg = split ( / /, $msg ); | 
| 500 |  |  |  |  |  |  | my $chan = $arg[1]; | 
| 501 |  |  |  |  |  |  | $msg =~ s/$arg[1]//; | 
| 502 |  |  |  |  |  |  | $msg =~ s/.say\s*//; | 
| 503 |  |  |  |  |  |  | $msg =~ s/\n+//; | 
| 504 |  |  |  |  |  |  |  | 
| 505 |  |  |  |  |  |  | if ( $chan || $arg[2] ) { | 
| 506 |  |  |  |  |  |  | $self->botspeak( $kernel, $chan, $msg ); | 
| 507 |  |  |  |  |  |  | } | 
| 508 |  |  |  |  |  |  | else { | 
| 509 |  |  |  |  |  |  | my $say = $help->ask_help('say'); | 
| 510 |  |  |  |  |  |  | $kernel->post( NICK, 'dcc_chat', $id, $say ); | 
| 511 |  |  |  |  |  |  | } | 
| 512 |  |  |  |  |  |  | } | 
| 513 |  |  |  |  |  |  | elsif ( $msg =~ m/^.logout$/i ) { | 
| 514 |  |  |  |  |  |  |  | 
| 515 |  |  |  |  |  |  | $kernel->post( NICK, 'dcc_chat', $id, "Bye Bye" ); | 
| 516 |  |  |  |  |  |  | $auth->de_auth($nick); | 
| 517 |  |  |  |  |  |  | $kernel->post( NICK, 'dcc_close', $id ); | 
| 518 |  |  |  |  |  |  |  | 
| 519 |  |  |  |  |  |  | } | 
| 520 |  |  |  |  |  |  | elsif ( $msg =~ m/^.join/i ) { | 
| 521 |  |  |  |  |  |  |  | 
| 522 |  |  |  |  |  |  | my @arg = split ( / /, $msg ); | 
| 523 |  |  |  |  |  |  | my $chan = $arg[1]; | 
| 524 |  |  |  |  |  |  |  | 
| 525 |  |  |  |  |  |  | if ($chan) { | 
| 526 |  |  |  |  |  |  | $kernel->post( NICK, 'join', $chan ); | 
| 527 |  |  |  |  |  |  | } | 
| 528 |  |  |  |  |  |  | else { | 
| 529 |  |  |  |  |  |  | my $join = $help->ask_help('join'); | 
| 530 |  |  |  |  |  |  | $kernel->post( NICK, 'dcc_chat', $id, $join ); | 
| 531 |  |  |  |  |  |  | } | 
| 532 |  |  |  |  |  |  | } | 
| 533 |  |  |  |  |  |  | elsif ( $msg =~ m/^.part/i ) { | 
| 534 |  |  |  |  |  |  |  | 
| 535 |  |  |  |  |  |  | my @arg = split ( / /, $msg ); | 
| 536 |  |  |  |  |  |  | my $chan = $arg[1]; | 
| 537 |  |  |  |  |  |  |  | 
| 538 |  |  |  |  |  |  | if ($chan) { | 
| 539 |  |  |  |  |  |  | $kernel->post( NICK, 'part', $chan ); | 
| 540 |  |  |  |  |  |  | } | 
| 541 |  |  |  |  |  |  | else { | 
| 542 |  |  |  |  |  |  | my $part = $help->ask_help('part'); | 
| 543 |  |  |  |  |  |  | $kernel->post( NICK, 'dcc_chat', $id, $part ); | 
| 544 |  |  |  |  |  |  | } | 
| 545 |  |  |  |  |  |  | } | 
| 546 |  |  |  |  |  |  | elsif ( $msg =~ m/^.help/i ) { | 
| 547 |  |  |  |  |  |  |  | 
| 548 |  |  |  |  |  |  | my @arg = split ( / /, $msg ); | 
| 549 |  |  |  |  |  |  | my $command = $arg[1]; | 
| 550 |  |  |  |  |  |  |  | 
| 551 |  |  |  |  |  |  | if ($command) { | 
| 552 |  |  |  |  |  |  | if ( $command eq 'all' ) { | 
| 553 |  |  |  |  |  |  | my %help = $help->ask_help(); | 
| 554 |  |  |  |  |  |  | $kernel->post( NICK, 'dcc_chat', $id, | 
| 555 |  |  |  |  |  |  | "Available Topics Are:" ); | 
| 556 |  |  |  |  |  |  | foreach my $keys ( keys %help ) { | 
| 557 |  |  |  |  |  |  | $kernel->post( NICK, 'dcc_chat', $id, "\cB$keys" ); | 
| 558 |  |  |  |  |  |  | } | 
| 559 |  |  |  |  |  |  | $kernel->post( NICK, 'dcc_chat', $id, | 
| 560 |  |  |  |  |  |  | "Type .help  for more info" ); | 
| 561 |  |  |  |  |  |  | } | 
| 562 |  |  |  |  |  |  | else { | 
| 563 |  |  |  |  |  |  | my $ans = $help->ask_help($command); | 
| 564 |  |  |  |  |  |  | $kernel->post( NICK, 'dcc_chat', $id, $ans ); | 
| 565 |  |  |  |  |  |  | } | 
| 566 |  |  |  |  |  |  | } | 
| 567 |  |  |  |  |  |  | else { | 
| 568 |  |  |  |  |  |  | $kernel->post( NICK, 'dcc_chat', $id, | 
| 569 |  |  |  |  |  |  | "Try .help all or .help  for more help." ); | 
| 570 |  |  |  |  |  |  | } | 
| 571 |  |  |  |  |  |  | } | 
| 572 |  |  |  |  |  |  | elsif ( $msg =~ m/^.quit/i ) { | 
| 573 |  |  |  |  |  |  |  | 
| 574 |  |  |  |  |  |  | my @arg = split ( / /, $msg ); | 
| 575 |  |  |  |  |  |  | my $mesg = $arg[1]; | 
| 576 |  |  |  |  |  |  | $msg =~ s/.quit\s*//; | 
| 577 |  |  |  |  |  |  | $msg =~ s/\n+//; | 
| 578 |  |  |  |  |  |  |  | 
| 579 |  |  |  |  |  |  | if ($mesg) { | 
| 580 |  |  |  |  |  |  | $kernel->call( NICK, 'quit', $msg ); | 
| 581 |  |  |  |  |  |  | } | 
| 582 |  |  |  |  |  |  | else { | 
| 583 |  |  |  |  |  |  | $kernel->call( NICK, 'quit', "IRC::BOT" ); | 
| 584 |  |  |  |  |  |  | } | 
| 585 |  |  |  |  |  |  | } | 
| 586 |  |  |  |  |  |  | elsif ( $msg =~ m/^.clear\s+\w$/i || $msg =~ m/^.clear$/i ) { | 
| 587 |  |  |  |  |  |  |  | 
| 588 |  |  |  |  |  |  | my @arg = split ( / /, $msg ); | 
| 589 |  |  |  |  |  |  | my $file  = $arg[1]; | 
| 590 |  |  |  |  |  |  | my $clear = $log->clear_log($file); | 
| 591 |  |  |  |  |  |  |  | 
| 592 |  |  |  |  |  |  | if ( $clear != 0 ) { | 
| 593 |  |  |  |  |  |  | $kernel->post( NICK, 'dcc_chat', $id, "Cleared $file" ); | 
| 594 |  |  |  |  |  |  | } | 
| 595 |  |  |  |  |  |  | else { | 
| 596 |  |  |  |  |  |  | my $clear = $help->ask_help('clear'); | 
| 597 |  |  |  |  |  |  | $kernel->post( NICK, 'dcc_chat', $id, $clear ); | 
| 598 |  |  |  |  |  |  | } | 
| 599 |  |  |  |  |  |  | } | 
| 600 |  |  |  |  |  |  | elsif ( $msg =~ m/^.kick/i ) { | 
| 601 |  |  |  |  |  |  |  | 
| 602 |  |  |  |  |  |  | my @arg = split ( / /, $msg ); | 
| 603 |  |  |  |  |  |  | my $channel = $arg[1]; | 
| 604 |  |  |  |  |  |  | my $user    = $arg[2]; | 
| 605 |  |  |  |  |  |  | my $mesg    = $arg[3]; | 
| 606 |  |  |  |  |  |  | if ( $channel || $user || $mesg ) { | 
| 607 |  |  |  |  |  |  | $kernel->post( NICK, 'kick', $channel, $user, $mesg ); | 
| 608 |  |  |  |  |  |  | } | 
| 609 |  |  |  |  |  |  | else { | 
| 610 |  |  |  |  |  |  | my $kick = $help->get_help('kick'); | 
| 611 |  |  |  |  |  |  | $kernel->post( NICK, 'dcc_chat', $id, $kick ); | 
| 612 |  |  |  |  |  |  | } | 
| 613 |  |  |  |  |  |  | } | 
| 614 |  |  |  |  |  |  | elsif ( $msg =~ m/^.op/i ) { | 
| 615 |  |  |  |  |  |  |  | 
| 616 |  |  |  |  |  |  | my @arg = split ( / /, $msg ); | 
| 617 |  |  |  |  |  |  | my $channel = $arg[1]; | 
| 618 |  |  |  |  |  |  | my $user    = $arg[2]; | 
| 619 |  |  |  |  |  |  | if ( $channel || $user ) { | 
| 620 |  |  |  |  |  |  | $kernel->post( NICK, 'mode', $channel, '+o', $user ); | 
| 621 |  |  |  |  |  |  | } | 
| 622 |  |  |  |  |  |  | else { | 
| 623 |  |  |  |  |  |  | my $op = $help->ask_help('op'); | 
| 624 |  |  |  |  |  |  | $kernel->post( NICK, 'dcc_chat', $id, $op ); | 
| 625 |  |  |  |  |  |  | } | 
| 626 |  |  |  |  |  |  | } | 
| 627 |  |  |  |  |  |  | elsif ( $msg =~ m/^.deop/i ) { | 
| 628 |  |  |  |  |  |  |  | 
| 629 |  |  |  |  |  |  | my @arg = split ( / /, $msg ); | 
| 630 |  |  |  |  |  |  | my $channel = $arg[1]; | 
| 631 |  |  |  |  |  |  | my $user    = $arg[2]; | 
| 632 |  |  |  |  |  |  | if ( $channel || $user ) { | 
| 633 |  |  |  |  |  |  | $kernel->post( NICK, 'mode', $channel, '-o', $user ); | 
| 634 |  |  |  |  |  |  | } | 
| 635 |  |  |  |  |  |  | else { | 
| 636 |  |  |  |  |  |  | my $deop = $help->ask_help('deop'); | 
| 637 |  |  |  |  |  |  | $kernel->post( NICK, 'dcc_chat', $id, $deop ); | 
| 638 |  |  |  |  |  |  | } | 
| 639 |  |  |  |  |  |  | } | 
| 640 |  |  |  |  |  |  | elsif ( $msg =~ m/^.ban/i ) { | 
| 641 |  |  |  |  |  |  |  | 
| 642 |  |  |  |  |  |  | my @arg = split ( / /, $msg ); | 
| 643 |  |  |  |  |  |  | my $channel = $arg[1]; | 
| 644 |  |  |  |  |  |  | my $host    = $arg[2]; | 
| 645 |  |  |  |  |  |  | if ( $channel || $host ) { | 
| 646 |  |  |  |  |  |  | $kernel->post( NICK, 'mode', $channel, '+b', $host ); | 
| 647 |  |  |  |  |  |  | } | 
| 648 |  |  |  |  |  |  | else { | 
| 649 |  |  |  |  |  |  | my $ban = $help->ask_help('ban'); | 
| 650 |  |  |  |  |  |  | $kernel->post( NICK, 'dcc_chat', $id, $ban ); | 
| 651 |  |  |  |  |  |  | } | 
| 652 |  |  |  |  |  |  |  | 
| 653 |  |  |  |  |  |  | } | 
| 654 |  |  |  |  |  |  | elsif ( $msg =~ m/^.unban/i ) { | 
| 655 |  |  |  |  |  |  |  | 
| 656 |  |  |  |  |  |  | my @arg = split ( / /, $msg ); | 
| 657 |  |  |  |  |  |  | my $channel = $arg[1]; | 
| 658 |  |  |  |  |  |  | my $host    = $arg[2]; | 
| 659 |  |  |  |  |  |  | if ( $channel || $host ) { | 
| 660 |  |  |  |  |  |  | $kernel->post( NICK, 'mode', $channel, '-b', $host ); | 
| 661 |  |  |  |  |  |  | } | 
| 662 |  |  |  |  |  |  | else { | 
| 663 |  |  |  |  |  |  | my $unban = $help->ask_help('unban'); | 
| 664 |  |  |  |  |  |  | $kernel->post( NICK, 'dcc_chat', $id, $unban ); | 
| 665 |  |  |  |  |  |  | } | 
| 666 |  |  |  |  |  |  | } | 
| 667 |  |  |  |  |  |  | elsif ( $msg =~ m/^.hop/i ) { | 
| 668 |  |  |  |  |  |  |  | 
| 669 |  |  |  |  |  |  | my @arg = split ( / /, $msg ); | 
| 670 |  |  |  |  |  |  | my $channel = $arg[1]; | 
| 671 |  |  |  |  |  |  | my $user    = $arg[2]; | 
| 672 |  |  |  |  |  |  |  | 
| 673 |  |  |  |  |  |  | if ( $channel || $user ) { | 
| 674 |  |  |  |  |  |  | $kernel->post( NICK, 'mode', $channel, '+h', $user ); | 
| 675 |  |  |  |  |  |  | } | 
| 676 |  |  |  |  |  |  | else { | 
| 677 |  |  |  |  |  |  | my $hop = $help->ask_help('hop'); | 
| 678 |  |  |  |  |  |  | $kernel->post( NICK, 'dcc_chat', $id, $hop ); | 
| 679 |  |  |  |  |  |  | } | 
| 680 |  |  |  |  |  |  | } | 
| 681 |  |  |  |  |  |  | elsif ( $msg =~ m/^.dehop/i ) { | 
| 682 |  |  |  |  |  |  |  | 
| 683 |  |  |  |  |  |  | my @arg = split ( / /, $msg ); | 
| 684 |  |  |  |  |  |  | my $channel = $arg[1]; | 
| 685 |  |  |  |  |  |  | my $user    = $arg[2]; | 
| 686 |  |  |  |  |  |  |  | 
| 687 |  |  |  |  |  |  | if ( $channel || $user ) { | 
| 688 |  |  |  |  |  |  | $kernel->post( NICK, 'mode', $channel, '-h', $user ); | 
| 689 |  |  |  |  |  |  | } | 
| 690 |  |  |  |  |  |  | else { | 
| 691 |  |  |  |  |  |  | my $dehop = $help->ask_help('dehop'); | 
| 692 |  |  |  |  |  |  | $kernel->post( NICK, 'dcc_chat', $id, $dehop ); | 
| 693 |  |  |  |  |  |  | } | 
| 694 |  |  |  |  |  |  | } | 
| 695 |  |  |  |  |  |  | elsif ( $msg =~ m/^.voice/i ) { | 
| 696 |  |  |  |  |  |  |  | 
| 697 |  |  |  |  |  |  | my @arg = split ( / /, $msg ); | 
| 698 |  |  |  |  |  |  | my $channel = $arg[1]; | 
| 699 |  |  |  |  |  |  | my $user    = $arg[2]; | 
| 700 |  |  |  |  |  |  |  | 
| 701 |  |  |  |  |  |  | if ( $channel || $user ) { | 
| 702 |  |  |  |  |  |  | $kernel->post( NICK, 'mode', $channel, '+v', $user ); | 
| 703 |  |  |  |  |  |  | } | 
| 704 |  |  |  |  |  |  | else { | 
| 705 |  |  |  |  |  |  | my $voice = $help->ask_help('voice'); | 
| 706 |  |  |  |  |  |  | $kernel->post( NICK, 'dcc_chat', $id, $voice ); | 
| 707 |  |  |  |  |  |  | } | 
| 708 |  |  |  |  |  |  |  | 
| 709 |  |  |  |  |  |  | } | 
| 710 |  |  |  |  |  |  | elsif ( $msg =~ m/^.devoice/i ) { | 
| 711 |  |  |  |  |  |  |  | 
| 712 |  |  |  |  |  |  | my @arg = split ( / /, $msg ); | 
| 713 |  |  |  |  |  |  | my $channel = $arg[1]; | 
| 714 |  |  |  |  |  |  | my $user    = $arg[2]; | 
| 715 |  |  |  |  |  |  |  | 
| 716 |  |  |  |  |  |  | if ( $channel || $user ) { | 
| 717 |  |  |  |  |  |  | $kernel->post( NICK, 'mode', $channel, '-v', $user ); | 
| 718 |  |  |  |  |  |  | } | 
| 719 |  |  |  |  |  |  | else { | 
| 720 |  |  |  |  |  |  | my $devoice = $help->ask_help('voice'); | 
| 721 |  |  |  |  |  |  | $kernel->post( NICK, 'dcc_chat', $id, $devoice ); | 
| 722 |  |  |  |  |  |  | } | 
| 723 |  |  |  |  |  |  |  | 
| 724 |  |  |  |  |  |  | } | 
| 725 |  |  |  |  |  |  | elsif ( $msg =~ m/^.nick/i ) { | 
| 726 |  |  |  |  |  |  |  | 
| 727 |  |  |  |  |  |  | my @arg = split ( / /, $msg ); | 
| 728 |  |  |  |  |  |  | my $nnick = $arg[1]; | 
| 729 |  |  |  |  |  |  | if ($nnick) { | 
| 730 |  |  |  |  |  |  | $kernel->post ( NICK, 'nick', $nnick ); | 
| 731 |  |  |  |  |  |  | } | 
| 732 |  |  |  |  |  |  | else { | 
| 733 |  |  |  |  |  |  | my $chnick = $help->ask_help('nick'); | 
| 734 |  |  |  |  |  |  | $kernel->post( NICK, 'dcc_chat', $id, $chnick); | 
| 735 |  |  |  |  |  |  | } | 
| 736 |  |  |  |  |  |  | } | 
| 737 |  |  |  |  |  |  | elsif ( $msg =~ m/^.identify/i ) { | 
| 738 |  |  |  |  |  |  |  | 
| 739 |  |  |  |  |  |  | my @arg = split ( / /, $msg ); | 
| 740 |  |  |  |  |  |  | my $idpass = $arg[1]; | 
| 741 |  |  |  |  |  |  | if ($idpass) { | 
| 742 |  |  |  |  |  |  | $self->botspeak( $kernel, 'NickServ', "identify $idpass" ); | 
| 743 |  |  |  |  |  |  | } | 
| 744 |  |  |  |  |  |  | else { | 
| 745 |  |  |  |  |  |  | my $iden = $help->ask_help('identify'); | 
| 746 |  |  |  |  |  |  | $kernel->post( NICK, 'dcc_chat', $id, $iden); | 
| 747 |  |  |  |  |  |  | } | 
| 748 |  |  |  |  |  |  |  | 
| 749 |  |  |  |  |  |  | } | 
| 750 |  |  |  |  |  |  | elsif ( $msg =~ m/^.msg\s([^"]*)/i ) { | 
| 751 |  |  |  |  |  |  |  | 
| 752 |  |  |  |  |  |  | my $user = $1; | 
| 753 |  |  |  |  |  |  | if ($user) { | 
| 754 |  |  |  |  |  |  | $self->botspeak( $kernel, $user, "" ); | 
| 755 |  |  |  |  |  |  | } | 
| 756 |  |  |  |  |  |  | else { | 
| 757 |  |  |  |  |  |  | my $priv = $help->ask_help('msg'); | 
| 758 |  |  |  |  |  |  | $kernel->post( NICK, 'dcc_chat', $id, $priv); | 
| 759 |  |  |  |  |  |  | } | 
| 760 |  |  |  |  |  |  |  | 
| 761 |  |  |  |  |  |  | } | 
| 762 |  |  |  |  |  |  | elsif ( $msg =~ m/^.away/i ) { | 
| 763 |  |  |  |  |  |  |  | 
| 764 |  |  |  |  |  |  | my @arg = split ( / /, $msg ); | 
| 765 |  |  |  |  |  |  | my $amsg = $arg[1]; | 
| 766 |  |  |  |  |  |  |  | 
| 767 |  |  |  |  |  |  | if ($amsg) { | 
| 768 |  |  |  |  |  |  | $kernel->post( NICK, 'away', $amsg ); | 
| 769 |  |  |  |  |  |  | } | 
| 770 |  |  |  |  |  |  | else { | 
| 771 |  |  |  |  |  |  | my $away = $help->ask_help('away'); | 
| 772 |  |  |  |  |  |  | $kernel->post( NICK, 'dcc_chat', $id, $away ); | 
| 773 |  |  |  |  |  |  | } | 
| 774 |  |  |  |  |  |  |  | 
| 775 |  |  |  |  |  |  | } | 
| 776 |  |  |  |  |  |  | elsif ( $msg =~ m/^.back$/i ) { | 
| 777 |  |  |  |  |  |  |  | 
| 778 |  |  |  |  |  |  | $kernel->post( NICK, 'away' ); | 
| 779 |  |  |  |  |  |  |  | 
| 780 |  |  |  |  |  |  | } | 
| 781 |  |  |  |  |  |  | elsif ( $msg =~ m/^.uptime$/i ) { | 
| 782 |  |  |  |  |  |  |  | 
| 783 |  |  |  |  |  |  | my $time = sprintf( "%d Days, %02d:%02d:%02d", | 
| 784 |  |  |  |  |  |  | ( gmtime( time() - $^T ) )[ 7, 2, 1, 0 ] ); | 
| 785 |  |  |  |  |  |  | $kernel->post( NICK, 'dcc_chat', $id, "I've been up for $time" ); | 
| 786 |  |  |  |  |  |  | } | 
| 787 |  |  |  |  |  |  | elsif ( $msg =~ m/^.clearseen$/i ) { | 
| 788 |  |  |  |  |  |  |  | 
| 789 |  |  |  |  |  |  | $seen->clear_seen(); | 
| 790 |  |  |  |  |  |  | $kernel->post( NICK, 'dcc_chat', $id, "Seen cache cleared!" ); | 
| 791 |  |  |  |  |  |  |  | 
| 792 |  |  |  |  |  |  | } | 
| 793 |  |  |  |  |  |  | elsif ( $msg =~ m/^.topic/i ) { | 
| 794 |  |  |  |  |  |  | my @arg = split ( / /, $msg ); | 
| 795 |  |  |  |  |  |  | my $chan = $arg[1]; | 
| 796 |  |  |  |  |  |  | $msg =~ s/\.topic\s+//; | 
| 797 |  |  |  |  |  |  | $msg =~ s/$chan//; | 
| 798 |  |  |  |  |  |  | $msg =~ s/\n+//; | 
| 799 |  |  |  |  |  |  | if ($msg) { | 
| 800 |  |  |  |  |  |  | $kernel->post( NICK, 'topic', $chan, $msg ); | 
| 801 |  |  |  |  |  |  | } | 
| 802 |  |  |  |  |  |  | else { | 
| 803 |  |  |  |  |  |  | my $topic = $help->ask_help('topic'); | 
| 804 |  |  |  |  |  |  | $kernel->post( NICK, 'dcc_chat', $id, $topic ); | 
| 805 |  |  |  |  |  |  | } | 
| 806 |  |  |  |  |  |  | } | 
| 807 |  |  |  |  |  |  | else { | 
| 808 |  |  |  |  |  |  |  | 
| 809 |  |  |  |  |  |  | $kernel->post( NICK, 'dcc_chat', $id, | 
| 810 |  |  |  |  |  |  | "\cB.help\cB is what you need" ); | 
| 811 |  |  |  |  |  |  | } | 
| 812 |  |  |  |  |  |  | } | 
| 813 |  |  |  |  |  |  | else { | 
| 814 |  |  |  |  |  |  |  | 
| 815 |  |  |  |  |  |  | $kernel->post( NICK, 'dcc_chat', $id, "Unauthorized!" ); | 
| 816 |  |  |  |  |  |  | $kernel->post( NICK, 'dcc_close', $id ); | 
| 817 |  |  |  |  |  |  | } | 
| 818 |  |  |  |  |  |  | } | 
| 819 |  |  |  |  |  |  |  | 
| 820 |  |  |  |  |  |  | # Got an error, attempt to close session. | 
| 821 |  |  |  |  |  |  | # Doesn't appear to be working, I need to question | 
| 822 |  |  |  |  |  |  | # my implementation, but we'll do that later | 
| 823 |  |  |  |  |  |  | sub on_dcc_err { | 
| 824 |  |  |  |  |  |  |  | 
| 825 |  |  |  |  |  |  | my ( $self, $kernel, $id, $who ) = @_[ OBJECT, KERNEL, ARG0, ARG2 ]; | 
| 826 |  |  |  |  |  |  | my $nick = ( split /!/, $who )[0]; | 
| 827 |  |  |  |  |  |  | $kernel->post( NICK, 'notice', $nick, "Bot Session Closed" ); | 
| 828 |  |  |  |  |  |  | $auth->de_auth($nick); | 
| 829 |  |  |  |  |  |  |  | 
| 830 |  |  |  |  |  |  | } | 
| 831 |  |  |  |  |  |  |  | 
| 832 |  |  |  |  |  |  | # DCC session is done, close out, kill session. | 
| 833 |  |  |  |  |  |  | sub on_dcc_done { | 
| 834 |  |  |  |  |  |  |  | 
| 835 |  |  |  |  |  |  | my ( $self, $kernel, $id, $who ) = @_[ OBJECT, KERNEL, ARG0, ARG1 ]; | 
| 836 |  |  |  |  |  |  | my $nick = ( split /!/, $who )[0]; | 
| 837 |  |  |  |  |  |  | $auth->de_auth($nick); | 
| 838 |  |  |  |  |  |  |  | 
| 839 |  |  |  |  |  |  | } | 
| 840 |  |  |  |  |  |  |  | 
| 841 |  |  |  |  |  |  | # Got back info from the NAMES command. | 
| 842 |  |  |  |  |  |  | # Parse and send info to Seen.pm | 
| 843 |  |  |  |  |  |  | sub on_names { | 
| 844 |  |  |  |  |  |  |  | 
| 845 |  |  |  |  |  |  | my ( $self, $kernel, $sender, $server, $who ) = | 
| 846 |  |  |  |  |  |  | @_[ OBJECT, KERNEL, SENDER, ARG0 .. ARG1 ]; | 
| 847 |  |  |  |  |  |  |  | 
| 848 |  |  |  |  |  |  | $who =~ /([^"]*)\s+:([^"]*)\s+/; | 
| 849 |  |  |  |  |  |  | my $chan  = $1; | 
| 850 |  |  |  |  |  |  | my $names = $2; | 
| 851 |  |  |  |  |  |  | $seen->load_current( $names, $chan ); | 
| 852 |  |  |  |  |  |  |  | 
| 853 |  |  |  |  |  |  | } | 
| 854 |  |  |  |  |  |  |  | 
| 855 |  |  |  |  |  |  | # Daemonize process | 
| 856 |  |  |  |  |  |  | # Got this off of perlmonks | 
| 857 |  |  |  |  |  |  | # Node id: 121604 tailored to my needs | 
| 858 |  |  |  |  |  |  | # Was trying to avoid more dependencies. | 
| 859 |  |  |  |  |  |  | sub daemon { | 
| 860 |  |  |  |  |  |  |  | 
| 861 |  |  |  |  |  |  | my $self = shift; | 
| 862 |  |  |  |  |  |  |  | 
| 863 |  |  |  |  |  |  | my @fh = ( \*STDIN, \*STDOUT ); | 
| 864 |  |  |  |  |  |  |  | 
| 865 |  |  |  |  |  |  | my $path; | 
| 866 |  |  |  |  |  |  | if (!defined($self->{'LogPath'})) { | 
| 867 |  |  |  |  |  |  | $path = $ENV{'HOME'}; | 
| 868 |  |  |  |  |  |  | } | 
| 869 |  |  |  |  |  |  | else { | 
| 870 |  |  |  |  |  |  | $path = $self->{'LogPath'}; | 
| 871 |  |  |  |  |  |  | } | 
| 872 |  |  |  |  |  |  | open \*STDERR, ">$path/error.log"; | 
| 873 |  |  |  |  |  |  | select( ( select( \*STDERR ), $| = 1 )[0] ); | 
| 874 |  |  |  |  |  |  |  | 
| 875 |  |  |  |  |  |  | my $ppid = $$; | 
| 876 |  |  |  |  |  |  |  | 
| 877 |  |  |  |  |  |  | my $pid = fork && exit 0; | 
| 878 |  |  |  |  |  |  |  | 
| 879 |  |  |  |  |  |  | !defined $pid && croak "No Fork: ", $!; | 
| 880 |  |  |  |  |  |  |  | 
| 881 |  |  |  |  |  |  | while ( kill 0, $ppid ) { | 
| 882 |  |  |  |  |  |  | select undef, undef, undef, .001; | 
| 883 |  |  |  |  |  |  | } | 
| 884 |  |  |  |  |  |  |  | 
| 885 |  |  |  |  |  |  | my $session_id = POSIX::setsid(); | 
| 886 |  |  |  |  |  |  | chdir '/' || croak "Could not cd to /", $!; | 
| 887 |  |  |  |  |  |  | my $oldmask = umask 00; | 
| 888 |  |  |  |  |  |  | close $_ || croak $! for @fh; | 
| 889 |  |  |  |  |  |  |  | 
| 890 |  |  |  |  |  |  | } | 
| 891 |  |  |  |  |  |  |  | 
| 892 |  |  |  |  |  |  | # Disconnected, clean up a bit | 
| 893 |  |  |  |  |  |  | sub on_disco { | 
| 894 |  |  |  |  |  |  |  | 
| 895 |  |  |  |  |  |  | my $self = shift; | 
| 896 |  |  |  |  |  |  | $auth->de_auth(); | 
| 897 |  |  |  |  |  |  | exit(0); | 
| 898 |  |  |  |  |  |  |  | 
| 899 |  |  |  |  |  |  | } | 
| 900 |  |  |  |  |  |  |  | 
| 901 |  |  |  |  |  |  | 1; | 
| 902 |  |  |  |  |  |  |  | 
| 903 |  |  |  |  |  |  | __END__ |