| File: | lib/Bot/IRC.pm |
| Coverage: | 46.6% |
| line | stmt | bran | cond | sub | pod | time | code |
|---|---|---|---|---|---|---|---|
| 1 | package Bot::IRC; | ||||||
| 2 | # ABSTRACT: Yet Another IRC Bot | ||||||
| 3 | |||||||
| 4 | 5 5 5 | 63 30 440 | use strict; | ||||
| 5 | 5 5 5 | 60 37 290 | use warnings; | ||||
| 6 | |||||||
| 7 | 5 5 5 | 45 24 1421 | use Carp 'croak'; | ||||
| 8 | 5 5 5 | 30565 2525651 7662 | use Daemon::Device; | ||||
| 9 | 5 5 5 | 18838 994486 868 | use IO::Socket; | ||||
| 10 | 5 5 5 | 55005 5239400 540 | use IO::Socket::SSL; | ||||
| 11 | 5 5 5 | 22732 550653 115941 | use Time::Crontab; | ||||
| 12 | |||||||
| 13 | # VERSION | ||||||
| 14 | |||||||
| 15 | sub new { | ||||||
| 16 | 9 | 1 | 57 | my $class = shift; | |||
| 17 | 9 | 106 | my $self = bless( {@_}, $class ); | ||||
| 18 | |||||||
| 19 | 9 | 252 | croak('Odd number of elements passed to new()') if ( @_ % 2 ); | ||||
| 20 | croak('connect/server not provided to new()') | ||||||
| 21 | 9 | 247 | unless ( ref $self->{connect} eq 'HASH' and $self->{connect}{server} ); | ||||
| 22 | |||||||
| 23 | 8 | 95 | $self->{spawn} ||= 2; | ||||
| 24 | |||||||
| 25 | 8 | 69 | $self->{connect}{nick} //= 'bot'; | ||||
| 26 | 8 | 67 | $self->{connect}{name} //= 'Yet Another IRC Bot'; | ||||
| 27 | 8 | 66 | $self->{connect}{port} ||= 6667; | ||||
| 28 | |||||||
| 29 | 8 | 80 | $self->{daemon} //= {}; | ||||
| 30 | 8 | 81 | $self->{daemon}{name} //= $self->{connect}{nick}; | ||||
| 31 | 8 | 92 | $self->{daemon}{pid_file} //= $self->{daemon}{name} . '.pid'; | ||||
| 32 | |||||||
| 33 | 8 | 48 | $self->{nick} = $self->{connect}{nick}; | ||||
| 34 | |||||||
| 35 | 8 | 44 | $self->{hooks} = []; | ||||
| 36 | 8 | 47 | $self->{ticks} = []; | ||||
| 37 | 8 | 49 | $self->{helps} = {}; | ||||
| 38 | 8 | 50 | $self->{loaded} = {}; | ||||
| 39 | |||||||
| 40 | $self->load( | ||||||
| 41 | 2 | 13 | ( ref $self->{plugins} eq 'ARRAY' ) ? @{ $self->{plugins} } : $self->{plugins} | ||||
| 42 | 8 | 56 | ) if ( $self->{plugins} ); | ||||
| 43 | |||||||
| 44 | 7 | 55 | return $self; | ||||
| 45 | } | ||||||
| 46 | |||||||
| 47 | sub run { | ||||||
| 48 | 1 | 1 | 7 | my ($self) = @_; | |||
| 49 | |||||||
| 50 | $self->{socket} = ( ( $self->{connect}{ssl} ) ? 'IO::Socket::SSL' : 'IO::Socket::INET' )->new( | ||||||
| 51 | PeerAddr => $self->{connect}{server}, | ||||||
| 52 | PeerPort => $self->{connect}{port}, | ||||||
| 53 | 1 | 14 | Proto => 'tcp', | ||||
| 54 | Type => SOCK_STREAM, | ||||||
| 55 | SSL_verify_mode => SSL_VERIFY_NONE, | ||||||
| 56 | ) or die $!; | ||||||
| 57 | |||||||
| 58 | 1 | 5 | eval { | ||||
| 59 | $self->{device} = Daemon::Device->new( | ||||||
| 60 | parent => \&_parent, | ||||||
| 61 | on_message => \&_on_message, | ||||||
| 62 | spawn => $self->{spawn}, | ||||||
| 63 | daemon => $self->{daemon}, | ||||||
| 64 | 1 | 12 | data => { self => $self }, | ||||
| 65 | ); | ||||||
| 66 | }; | ||||||
| 67 | 1 | 7 | croak($@) if ($@); | ||||
| 68 | 1 | 8 | $self->{device}->run; | ||||
| 69 | } | ||||||
| 70 | |||||||
| 71 | sub _parent { | ||||||
| 72 | 0 | 0 | my ($device) = @_; | ||||
| 73 | 0 | 0 | my $self = $device->data('self'); | ||||
| 74 | 0 | 0 | my $session = { start => time }; | ||||
| 75 | my $delegate = sub { | ||||||
| 76 | my ($random_child) = | ||||||
| 77 | 0 | 0 | map { $_->[0] } | ||||
| 78 | 0 | 0 | sort { $a->[1] <=> $b->[1] } | ||||
| 79 | 0 | 0 | map { [ $_, rand() ] } | ||||
| 80 | 0 0 | 0 0 | @{ $device->children }; | ||||
| 81 | |||||||
| 82 | 0 | 0 | $device->message( $random_child, @_ ); | ||||
| 83 | 0 | 0 | }; | ||||
| 84 | |||||||
| 85 | local $SIG{ALRM} = sub { | ||||||
| 86 | 0 | 0 | alarm 1; | ||||
| 87 | 0 | 0 | my $time = time; | ||||
| 88 | |||||||
| 89 | 0 | 0 | $_->{code}->($self) for ( | ||||
| 90 | grep { | ||||||
| 91 | ref $_->{timing} and ( $time % 60 == 0 ) and $_->{timing}->match($time) or | ||||||
| 92 | 0 | 0 | not ref $_->{timing} and ( ( $time - $session->{start} ) % $_->{timing} == 0 ) | ||||
| 93 | 0 | 0 | } @{ $self->{ticks} } | ||||
| 94 | ); | ||||||
| 95 | 0 | 0 | }; | ||||
| 96 | |||||||
| 97 | 0 | 0 | while ( my $line = $self->{socket}->getline ) { | ||||
| 98 | 0 | 0 | print $line; | ||||
| 99 | 0 | 0 | chomp($line); | ||||
| 100 | |||||||
| 101 | 0 | 0 | if ( not $session->{established} ) { | ||||
| 102 | 0 | 0 | if ( not $session->{user} ) { | ||||
| 103 | 0 | 0 | $self->say("USER $self->{nick} 0 * :$self->{connect}{name}"); | ||||
| 104 | 0 | 0 | $self->say("NICK $self->{nick}"); | ||||
| 105 | 0 | 0 | $session->{user} = 1; | ||||
| 106 | } | ||||||
| 107 | elsif ( $line =~ /^:\S+\s433\s/ ) { | ||||||
| 108 | 0 | 0 | $self->nick( $self->{nick} . '_' ); | ||||
| 109 | } | ||||||
| 110 | elsif ( $line =~ /^:\S+\s001\s/ ) { | ||||||
| 111 | 0 | 0 | $self->join; | ||||
| 112 | 0 | 0 | $session->{established} = 1; | ||||
| 113 | 0 0 | 0 0 | alarm 1 if ( @{ $self->{ticks} } ); | ||||
| 114 | } | ||||||
| 115 | } | ||||||
| 116 | |||||||
| 117 | 0 | 0 | $delegate->($line); | ||||
| 118 | } | ||||||
| 119 | } | ||||||
| 120 | |||||||
| 121 | sub _on_message { | ||||||
| 122 | 0 | 0 | my $device = shift; | ||||
| 123 | 0 | 0 | my $self = $device->data('self'); | ||||
| 124 | |||||||
| 125 | 0 | 0 | for my $line (@_) { | ||||
| 126 | 0 | 0 | if ( $line =~ /^>>>\sNICK\s(.*)/ ) { | ||||
| 127 | 0 | 0 | $self->{nick} = $1; | ||||
| 128 | 0 | 0 | next; | ||||
| 129 | } | ||||||
| 130 | elsif ( $line =~ /^:\S+\s433\s/ ) { | ||||||
| 131 | 0 | 0 | $self->nick( $self->{nick} . '_' ); | ||||
| 132 | 0 | 0 | next; | ||||
| 133 | } | ||||||
| 134 | |||||||
| 135 | 0 0 | 0 0 | $self->{in} = { map { $_ => '' } qw( line source nick user server command forum text ) }; | ||||
| 136 | 0 | 0 | $self->{in}{$_} = 0 for ( qw( private to_me ) ); | ||||
| 137 | 0 | 0 | $self->{in}{line} = $line; | ||||
| 138 | |||||||
| 139 | 0 | 0 | if ( $line =~ /^:(\S+?)!~?(\S+?)@(\S+?)\s(\S+)\s(\S+)\s:(.*)/ ) { | ||||
| 140 | 0 0 | 0 0 | @{ $self->{in} }{ qw( nick user server command forum text ) } = ( $1, $2, $3, $4, $5, $6 ); | ||||
| 141 | } | ||||||
| 142 | elsif ( $line =~ /^:(\S+?)!~?(\S+?)@(\S+?)\s(\S+)\s:(.*)/ ) { | ||||||
| 143 | 0 0 | 0 0 | @{ $self->{in} }{ qw( nick user server command text ) } = ( $1, $2, $3, $4, $5 ); | ||||
| 144 | } | ||||||
| 145 | elsif ( $line =~ /^:(\S+?)!~?(\S+?)@(\S+?)\s(\S+)\s(\S+)\s(.*)/ ) { | ||||||
| 146 | 0 0 | 0 0 | @{ $self->{in} }{ qw( nick user server command forum text ) } = ( $1, $2, $3, $4, $5, $6 ); | ||||
| 147 | } | ||||||
| 148 | elsif ( $line =~ /^:(\S+?)!~?(\S+?)@(\S+?)\s(\S+)\s(\S+)/ ) { | ||||||
| 149 | 0 0 | 0 0 | @{ $self->{in} }{ qw( nick user server command forum ) } = ( $1, $2, $3, $4, $5, $6 ); | ||||
| 150 | } | ||||||
| 151 | elsif ( $line =~ /^(PING)\s(.+)/ ) { | ||||||
| 152 | 0 0 | 0 0 | @{ $self->{in} }{ qw( command text ) } = ( $1, $2 ); | ||||
| 153 | 0 | 0 | $self->say( 'PONG ' . $self->{in}{text} ); | ||||
| 154 | 0 | 0 | next; | ||||
| 155 | } | ||||||
| 156 | elsif ( $line =~ /^:(\S+)\s(NOTICE|\d+)\s(\S+)\s(.*)/ ) { | ||||||
| 157 | 0 0 | 0 0 | @{ $self->{in} }{ qw( source command forum text ) } = ( $1, $2, $3, $4 ); | ||||
| 158 | } | ||||||
| 159 | elsif ( $line =~ /^(ERROR)\s/ ) { | ||||||
| 160 | 0 | 0 | warn $line . "\n"; | ||||
| 161 | } | ||||||
| 162 | else { | ||||||
| 163 | 0 | 0 | warn 'Unparsed line (probably a bug in Bot::IRC; please report it): ', $line . "\n"; | ||||
| 164 | } | ||||||
| 165 | |||||||
| 166 | 0 | 0 | next unless ( $self->{in}{nick} ne $self->{nick} ); | ||||
| 167 | |||||||
| 168 | 0 | 0 | if ( $self->{in}{command} eq 'PRIVMSG' ) { | ||||
| 169 | 0 | 0 | $self->{in}{private} = 1 if ( $self->{in}{forum} and $self->{in}{forum} eq $self->{nick} ); | ||||
| 170 | $self->{in}{to_me} = 1 if ( | ||||||
| 171 | $self->{in}{text} =~ s/^\s*$self->{nick}\b\W*//i or | ||||||
| 172 | $self->{in}{private} | ||||||
| 173 | 0 | 0 | ); | ||||
| 174 | } | ||||||
| 175 | |||||||
| 176 | 0 | 0 | if ( $self->{in}{to_me} ) { | ||||
| 177 | 0 | 0 | if ( $self->{in}{text} =~ /^\s*help\W*$/i ) { | ||||
| 178 | $self->reply( | ||||||
| 179 | ( ( $self->{in}{private} ) ? '' : $self->{in}{nick} . ': ' ) . | ||||||
| 180 | 'Ask me for help with "help topic" where the topic is one of the following: ' . | ||||||
| 181 | 0 0 | 0 0 | join( ', ', sort keys %{ $self->{helps} } ) . '.' | ||||
| 182 | ); | ||||||
| 183 | 0 | 0 | next; | ||||
| 184 | } | ||||||
| 185 | elsif ( $self->{in}{text} =~ /^\s*help\s+(.+?)\W*$/i ) { | ||||||
| 186 | $self->reply( | ||||||
| 187 | ( ( $self->{in}{private} ) ? '' : $self->{in}{nick} . ': ' ) . | ||||||
| 188 | 0 | 0 | ( $self->{helps}{$1} || "Couldn't find the help topic: $1." ) | ||||
| 189 | ); | ||||||
| 190 | 0 | 0 | next; | ||||
| 191 | } | ||||||
| 192 | } | ||||||
| 193 | |||||||
| 194 | 0 0 | 0 0 | hook: for my $hook ( @{ $self->{hooks} } ) { | ||||
| 195 | 0 | 0 | my $captured_matches = {}; | ||||
| 196 | |||||||
| 197 | 0 0 | 0 0 | for my $type ( keys %{ $hook->{when} } ) { | ||||
| 198 | next hook unless ( | ||||||
| 199 | ref( $hook->{when}{$type} ) eq 'Regexp' and $self->{in}{$type} =~ $hook->{when}{$type} or | ||||||
| 200 | ref( $hook->{when}{$type} ) eq 'CODE' and $hook->{when}{$type}->( | ||||||
| 201 | $self, | ||||||
| 202 | $self->{in}{$type}, | ||||||
| 203 | 0 | 0 | { %{ $self->{in} } }, | ||||
| 204 | ) or | ||||||
| 205 | 0 | 0 | $self->{in}{$type} eq $hook->{when}{$type} | ||||
| 206 | ); | ||||||
| 207 | |||||||
| 208 | 5 5 5 0 | 19541 58559 95844 0 | $captured_matches = { %$captured_matches, %+ } if ( keys %+ ); | ||||
| 209 | } | ||||||
| 210 | |||||||
| 211 | last if ( $hook->{code}->( | ||||||
| 212 | $self, | ||||||
| 213 | 0 0 | 0 0 | { %{ $self->{in} } }, | ||||
| 214 | $captured_matches, | ||||||
| 215 | ) ); | ||||||
| 216 | } | ||||||
| 217 | } | ||||||
| 218 | } | ||||||
| 219 | |||||||
| 220 | sub load { | ||||||
| 221 | 4 | 1 | 20 | my $self = shift; | |||
| 222 | |||||||
| 223 | 4 | 22 | for my $plugin (@_) { | ||||
| 224 | 4 | 22 | unless ( ref $plugin ) { | ||||
| 225 | 4 | 19 | my $namespace; | ||||
| 226 | 4 | 30 | for ( | ||||
| 227 | $plugin, | ||||||
| 228 | __PACKAGE__ . "::Y::$plugin", | ||||||
| 229 | __PACKAGE__ . "::X::$plugin", | ||||||
| 230 | __PACKAGE__ . "::$plugin", | ||||||
| 231 | ) { | ||||||
| 232 | 10 | 815 | eval "require $_"; | ||||
| 233 | 10 | 101 | unless ($@) { | ||||
| 234 | 3 | 18 | $namespace = $_; | ||||
| 235 | 3 | 18 | last; | ||||
| 236 | } | ||||||
| 237 | else { | ||||||
| 238 | 7 | 72 | croak($@) unless ( $@ =~ /^Can't locate/ ); | ||||
| 239 | } | ||||||
| 240 | } | ||||||
| 241 | 4 | 48 | croak("Unable to find or properly load $plugin") unless ($namespace); | ||||
| 242 | |||||||
| 243 | 3 | 24 | next if ( $self->{loaded}{$namespace} ); | ||||
| 244 | |||||||
| 245 | 3 | 46 | $namespace->import if ( $namespace->can('import') ); | ||||
| 246 | 3 | 32 | croak("$namespace does not implement init()") unless ( $namespace->can('init') ); | ||||
| 247 | |||||||
| 248 | 3 | 157 | eval "${namespace}::init(\$self)"; | ||||
| 249 | 3 | 26 | die($@) if ($@); | ||||
| 250 | |||||||
| 251 | 3 | 34 | $self->{loaded}{$namespace} = time; | ||||
| 252 | } | ||||||
| 253 | else { | ||||||
| 254 | 0 0 | 0 0 | $self->$_( @{ $plugin->{$_} } ) for ( qw( hooks ticks ) ); | ||||
| 255 | 0 | 0 | $self->$_( $plugin->{$_} ) for ( qw( helps subs ) ); | ||||
| 256 | } | ||||||
| 257 | } | ||||||
| 258 | |||||||
| 259 | 3 | 33 | return $self; | ||||
| 260 | } | ||||||
| 261 | |||||||
| 262 | sub reload { | ||||||
| 263 | 1 | 1 | 6 | my $self = shift; | |||
| 264 | 1 | 8 | delete $self->{loaded}{$_} for (@_); | ||||
| 265 | 1 | 7 | return $self->load(@_); | ||||
| 266 | } | ||||||
| 267 | |||||||
| 268 | sub hook { | ||||||
| 269 | 5 | 1 | 26 | my ( $self, $when, $code, $attr ) = @_; | |||
| 270 | |||||||
| 271 | 5 | 109 | $attr //= {}; | ||||
| 272 | 5 | 72 | $attr->{priority} //= 0; | ||||
| 273 | |||||||
| 274 | $self->{hooks} = [ | ||||||
| 275 | sort { | ||||||
| 276 | $b->{attr} <=> $a->{attr} | ||||||
| 277 | 5 | 33 | } | ||||
| 278 | 5 5 | 23 50 | @{ $self->{hooks} }, | ||||
| 279 | { | ||||||
| 280 | when => $when, | ||||||
| 281 | code => $code, | ||||||
| 282 | attr => $attr, | ||||||
| 283 | }, | ||||||
| 284 | ]; | ||||||
| 285 | |||||||
| 286 | 5 0 | 99 0 | $self->subs( %{ $attr->{subs} } ) if ( ref $attr->{subs} eq 'HASH' ); | ||||
| 287 | 5 0 | 31 0 | $self->helps( %{ $attr->{helps} } ) if ( ref $attr->{helps} eq 'HASH' ); | ||||
| 288 | |||||||
| 289 | 5 | 47 | return $self; | ||||
| 290 | } | ||||||
| 291 | |||||||
| 292 | sub hooks { | ||||||
| 293 | 1 | 1 | 6 | my $self = shift; | |||
| 294 | 1 | 6 | $self->hook(@$_) for (@_); | ||||
| 295 | 1 | 7 | return $self; | ||||
| 296 | } | ||||||
| 297 | |||||||
| 298 | sub helps { | ||||||
| 299 | 2 | 1 | 10 | my $self = shift; | |||
| 300 | 2 2 | 10 17 | $self->{helps} = { %{ $self->{helps} }, @_ }; | ||||
| 301 | 2 | 19 | return $self; | ||||
| 302 | } | ||||||
| 303 | |||||||
| 304 | sub tick { | ||||||
| 305 | 3 | 1 | 13 | my ( $self, $timing, $code ) = @_; | |||
| 306 | |||||||
| 307 | 3 3 | 14 30 | push( @{ $self->{ticks} }, { | ||||
| 308 | timing => ( $timing =~ /^\d+$/ ) ? $timing : Time::Crontab->new($timing), | ||||||
| 309 | code => $code, | ||||||
| 310 | } ); | ||||||
| 311 | 3 | 21 | return $self; | ||||
| 312 | } | ||||||
| 313 | |||||||
| 314 | sub ticks { | ||||||
| 315 | 1 | 1 | 6 | my $self = shift; | |||
| 316 | 1 | 7 | $self->tick(@$_) for (@_); | ||||
| 317 | 1 | 46 | return $self; | ||||
| 318 | } | ||||||
| 319 | |||||||
| 320 | sub subs { | ||||||
| 321 | 4 | 1 | 23 | my $self = shift; | |||
| 322 | 4 | 29 | my $subs = {@_}; | ||||
| 323 | |||||||
| 324 | 4 | 28 | for my $name ( keys %$subs ) { | ||||
| 325 | 5 5 5 | 6118 290 61731 | no strict 'refs'; | ||||
| 326 | 5 5 | 28 53 | *{ __PACKAGE__ . '::' . $name } = $subs->{$name}; | ||||
| 327 | } | ||||||
| 328 | 4 | 75 | return $self; | ||||
| 329 | } | ||||||
| 330 | |||||||
| 331 | sub register { | ||||||
| 332 | 2 | 1 | 10 | my $self = shift; | |||
| 333 | 2 | 26 | $self->{loaded}{$_} = time for (@_); | ||||
| 334 | 2 | 14 | return $self; | ||||
| 335 | } | ||||||
| 336 | |||||||
| 337 | sub reply { | ||||||
| 338 | 1 | 1 | 6 | my ( $self, $message ) = @_; | |||
| 339 | |||||||
| 340 | 1 | 7 | if ( $self->{in}{forum} ) { | ||||
| 341 | $self->msg( | ||||||
| 342 | 0 | 0 | ( ( $self->{in}{forum} eq $self->{nick} ) ? $self->{in}{nick} : $self->{in}{forum} ), | ||||
| 343 | $message, | ||||||
| 344 | ); | ||||||
| 345 | } | ||||||
| 346 | else { | ||||||
| 347 | 1 | 40 | warn "Didn't have a target to send reply to.\n"; | ||||
| 348 | } | ||||||
| 349 | 1 | 53 | return $self; | ||||
| 350 | } | ||||||
| 351 | |||||||
| 352 | sub msg { | ||||||
| 353 | 1 | 1 | 7 | my ( $self, $target, $message ) = @_; | |||
| 354 | 1 | 9 | $self->say("PRIVMSG $target :$message"); | ||||
| 355 | 1 | 8 | return $self; | ||||
| 356 | } | ||||||
| 357 | |||||||
| 358 | sub say { | ||||||
| 359 | 3 | 1 | 18 | my $self = shift; | |||
| 360 | |||||||
| 361 | 3 | 20 | for (@_) { | ||||
| 362 | 4 | 561 | $self->{socket}->print( $_ . "\r\n" ); | ||||
| 363 | 4 | 5217 | print '<<< ', $_, "\n"; | ||||
| 364 | } | ||||||
| 365 | 3 | 71 | return $self; | ||||
| 366 | } | ||||||
| 367 | |||||||
| 368 | sub nick { | ||||||
| 369 | 1 | 1 | 22 | my ( $self, $nick ) = @_; | |||
| 370 | |||||||
| 371 | 1 | 8 | if ($nick) { | ||||
| 372 | 1 | 6 | $self->{nick} = $nick; | ||||
| 373 | $self->{device}->message( $_, ">>> NICK $self->{nick}" ) | ||||||
| 374 | 1 3 1 | 157 282 167 | for ( grep { $_ != $$ } $self->{device}->ppid, @{ $self->{device}->children } ); | ||||
| 375 | 1 | 9 | $self->say("NICK $self->{nick}"); | ||||
| 376 | } | ||||||
| 377 | 1 | 9 | return $self->{nick}; | ||||
| 378 | } | ||||||
| 379 | |||||||
| 380 | sub join { | ||||||
| 381 | 0 | 1 | my $self = shift; | ||||
| 382 | |||||||
| 383 | 0 0 | my @join = @{ ( $self->can('store') ) ? $self->store->get('join') || [] : [] }; | |||||
| 384 | |||||||
| 385 | 0 | unless (@_) { | |||||
| 386 | 0 | if (@join) { | |||||
| 387 | 0 | $self->say("JOIN $_") for (@join); | |||||
| 388 | } | ||||||
| 389 | elsif ( $self->{connect}{join} ) { | ||||||
| 390 | 0 | for ( | |||||
| 391 | ( ref $self->{connect}{join} eq 'ARRAY' ) | ||||||
| 392 | 0 | ? @{ $self->{connect}{join} } | |||||
| 393 | : $self->{connect}{join} | ||||||
| 394 | ) { | ||||||
| 395 | 0 | push( @join, $_ ); | |||||
| 396 | 0 | $self->say("JOIN $_"); | |||||
| 397 | } | ||||||
| 398 | } | ||||||
| 399 | } | ||||||
| 400 | else { | ||||||
| 401 | 0 | for (@_) { | |||||
| 402 | 0 | push( @join, $_ ); | |||||
| 403 | 0 | $self->say("JOIN $_"); | |||||
| 404 | } | ||||||
| 405 | } | ||||||
| 406 | |||||||
| 407 | 0 | $self->store->set( 'join' => \@join ) if ( $self->can('store') ); | |||||
| 408 | |||||||
| 409 | 0 | return $self; | |||||
| 410 | } | ||||||
| 411 | |||||||
| 412 | sub part { | ||||||
| 413 | 0 | 1 | my $self = shift; | ||||
| 414 | |||||||
| 415 | 0 0 | my @join = @{ ( $self->can('store') ) ? $self->store->get('join') || [] : [] }; | |||||
| 416 | |||||||
| 417 | 0 | for my $channel (@_) { | |||||
| 418 | 0 | $self->say("PART $channel"); | |||||
| 419 | 0 0 | @join = grep { $_ ne $channel } @join; | |||||
| 420 | } | ||||||
| 421 | |||||||
| 422 | 0 | $self->store->set( 'join' => \@join ) if ( $self->can('store') ); | |||||
| 423 | |||||||
| 424 | 0 | return $self; | |||||
| 425 | } | ||||||
| 426 | |||||||
| 427 | 1; | ||||||