1=head1 NAME 2 3IRC::Bot::Hangman - An IRC hangman 4 5=head1 SYNOPSIS 6 7 use IRC::Bot::Hangman; 8 IRC::Bot::Hangman->new( 9 channels => [ '#hangman' ], 10 nick => 'hangman', 11 server => 'irc.blablablablah.bla', 12 word_list_name => 'too_easy', 13 games => 3, 14 )->run; 15 print "Finished\n"; 16 17=head1 COMMANDS 18 19 <letter>? : guess a letter 20 guess <letter> : guess a letter 21 guess <word> : guess an entire word 22 <hangman> help - help instructions 23 <hangman> play : Start a new game or display current game 24 <hangman> quiet : keep quiet between guesses 25 <hangman> talk : Talk between guesses 26 27=head1 DESCRIPTION 28 29This module provides a useless IRC bot which 30enables you to play hangman, the classic word game. 31It comes shipped with a list of ~2000 english words by default. 32The architecture is plugin based, words, commands and responses 33can be extended at will by adding new modules. 34 35The main motivation was to provide a multi-player text based 36game for children to help them practising writing. 37 38=head1 PLUGINS 39 40The plugins are managed by 41 42 IRC::Bot::Hangman::WordList 43 IRC::Bot::Hangman::Command 44 IRC::Bot::Hangman::Response 45 46=cut 47 48package IRC::Bot::Hangman; 49use warnings::register; 50use strict; 51use base qw( Bot::BasicBot ); 52use Carp qw( carp ); 53use Games::GuessWord; 54use IRC::Bot::Hangman::WordList; 55use IRC::Bot::Hangman::Command; 56use IRC::Bot::Hangman::Response; 57 58our $VERSION = '0.1'; 59 60our $DEFAULT_WORD_LIST = 'default'; 61our $DEFAULT_DELAY = 30; # seconds 62 63 64=head1 METHODS 65 66=head2 word_list( $list ) 67 68Get or set the word list as an array ref. 69A default word list of ~2000 english words is provided 70if no list is set. 71 72=cut 73 74sub word_list { 75 my $self = shift; 76 if (@_) { 77 my $list = shift; 78 unless (ref $list eq 'ARRAY') { 79 carp "word_list should be an array ref"; 80 return; 81 } 82 $self->{word_list} = $list; 83 return $self; 84 } 85 $self->{word_list} ||= $self->load_word_list(); 86} 87 88 89=head2 load_word_list( name ) 90 91Returns a default english words list 92from L<IRC::Bot::Hangman::WordList> 93 94=cut 95 96sub load_word_list { 97 my $self = shift; 98 my $name = shift || $self->word_list_name; 99 IRC::Bot::Hangman::WordList->load( $name ); 100} 101 102 103=head2 word_list_name( $name ) 104 105Get or set the word list name. 106It must be an installed module in IRC::Bot::Hangman::WordList::xxx 107The default provided is 'default' = IRC::Bot::Hangman::WordList::Default 108 109=cut 110 111sub word_list_name { 112 my $self = shift; 113 if (@_) { 114 $self->{word_list_name} = shift; 115 return $self; 116 } 117 $self->{word_list_name} ||= $DEFAULT_WORD_LIST; 118} 119 120 121=head2 games( integer ) 122 123Get or set the number of games before ending. 124undef means infinity. 125 126=cut 127 128sub games { 129 my $self = shift; 130 if (@_) { 131 my $games = shift; 132 $self->{games} = $games; 133 return $self; 134 } 135 $self->{games}; 136} 137 138 139=head2 game( $game ) 140 141Get or set the hangman game. 142The default value is a L<Games::GuessWord> instance 143with word_list() word list. 144 145=cut 146 147sub game { 148 my $self = shift; 149 if (@_) { 150 my $game = shift; 151 $self->{game} = $game; 152 return $self; 153 } 154 $self->{game} ||= $self->load_game; 155} 156 157 158=head2 new_game() 159 160Reset the game 161 162=cut 163 164sub new_game { 165 my $self = shift; 166 my $game = $self->game or return; 167 $self->game( ref($game)->new( words => $self->word_list ) ); 168} 169 170 171=head2 replay() 172 173Reset the game unless it is the last game 174as counted by games() 175 176=cut 177 178sub replay { 179 my $self = shift; 180 my $games = $self->games; 181 if (defined $games) { 182 $self->games($games - 1); 183 if ($self->games <= 0) { 184 $self->schedule_tick(0); 185 return $self->get_a_msg('last_game'); 186 } 187 } 188 $self->new_game(); 189 $self->schedule_tick(5); 190 return; 191} 192 193 194=head2 can_talk() 195 196Get set C<can_talk>, used by C<tick> to display reminders. 197 198=cut 199 200sub can_talk { 201 my $self = shift; 202 if (@_) { 203 $self->{can_talk} = shift; 204 return $self; 205 } 206 $self->{can_talk}; 207} 208 209 210=head2 load_game() 211 212Returns a L<Games::GuessWord> instance 213 214=cut 215 216sub load_game { 217 my $self = shift; 218 Games::GuessWord->new( words => $self->word_list ); 219} 220 221 222=head2 msg_guess() 223 224Displays the word to guess 225 226=cut 227 228sub msg_guess { 229 my $self = shift; 230 'To guess: ' . $self->game->answer . ' - ' . $self->game->chances . " chances remaining"; 231} 232 233 234=head2 get_delay() 235 236Returns a random time calculated: 237delay() * (1 + rand(4)) seconds 238 239=cut 240 241sub get_delay { 242 my $self = shift; 243 my $delay = $self->delay; 244 $delay *(1 + rand(4)); 245} 246 247 248=head2 delay() 249 250Get set base delay in seconds. 251Default is 30s. 252 253=cut 254 255sub delay { 256 my $self = shift; 257 if (@_) { 258 $self->{delay} = shift; 259 return $self; 260 } 261 $self->{delay} ||= $DEFAULT_DELAY; 262} 263 264 265=head2 input() 266 267Get/set input 268 269=cut 270 271sub input { 272 my $self = shift; 273 if (@_) { 274 $self->{input} = shift; 275 return $self; 276 } 277 $self->{input}; 278} 279 280 281=head2 response() 282 283Get/set response 284 285=cut 286 287sub response { 288 my $self = shift; 289 if (@_) { 290 $self->{response} = shift; 291 return $self; 292 } 293 $self->{response}; 294} 295 296 297=head2 set_response( type ) 298 299Sets the response from a response type 300 301=cut 302 303sub set_response { 304 my $self = shift; 305 my $type = shift; 306 my $msg = $self->get_a_msg( $type ) or carp "No message of type $type"; 307 $self->response( $msg ); 308} 309 310 311=head2 get_a_msg( type ) 312 313Returns a msg of a given type 314 315=cut 316 317sub get_a_msg { 318 my $self = shift; 319 my $type = shift; 320 IRC::Bot::Hangman::Response->get_a_msg( $type ); 321} 322 323 324=head2 guess_word( word ) 325 326Guess a word : success or one chance less 327 328=cut 329 330sub guess_word { 331 my $self = shift; 332 my $guess = shift; 333 if ($guess eq $self->game->secret) { 334 $self->game->guess($guess); 335 return $self->get_a_msg('good_guess'); 336 } 337 else { 338 $self->game->{chances}--; 339 return $self->get_a_msg('bad_guess'); 340 } 341} 342 343 344=head2 guess_letter( letter ) 345 346Guess a letter : match or one chance less 347 348=cut 349 350sub guess_letter { 351 my $self = shift; 352 my $guess = shift; 353 my @guesses = $self->game->guesses; 354 my @msg; 355 if (grep { $_ eq $guess } @guesses) { 356 push @msg, $self->get_a_msg('already_guessed'); 357 push @msg, 'Letters used: ' . join(', ', $self->game->guesses); 358 } 359 else { 360 my $chances = $self->game->chances; 361 $self->game->guess($guess); 362 if ($chances == $self->game->chances) { 363 push @msg, $self->get_a_msg('good_guess'); 364 } 365 else { 366 push @msg, $self->get_a_msg('bad_guess'); 367 } 368 push @msg, $self->give_advice($guess); 369 } 370 @msg; 371} 372 373 374=head2 conclusion() 375 376Displays an end of game message : sucess or lost 377 378=cut 379 380sub conclusion { 381 my $self = shift; 382 my @msg; 383 if ($self->game->won) { 384 push @msg, $self->get_a_msg('won'); 385 push @msg, "The word was: " . $self->game->secret; 386 push @msg, "Your score: " . $self->game->score; 387 push @msg, $self->replay(); 388 } 389 elsif ($self->game->lost) { 390 push @msg, $self->get_a_msg('lost'); 391 push @msg, "The word was: " . $self->game->secret; 392 push @msg, "Your score: " . $self->game->score; 393 push @msg, $self->replay(); 394 } 395 else { 396 push @msg, $self->msg_guess; 397 } 398 @msg; 399} 400 401 402=head2 give_advice( guess ) 403 404=cut 405 406sub give_advice { 407 my $self = shift; 408 my $guess = shift; 409 my @guesses = $self->game->guesses; 410 if ($guess =~ /[euioa]/ and grep(/[euioa]/, @guesses) >= 3 and @guesses < 6) { 411 return $self->get_a_msg('lack_imagination'); 412 } 413 return; 414} 415 416 417=head1 Bot::BasicBot METHODS 418 419These are the L<Bot::BasicBot> overriden methods 420 421=head2 said( $args ) 422 423This is the main method, 424everything said is analysed to provide a reply 425if appropriate 426 427=cut 428 429sub said { 430 my $self = shift; 431 my $args = shift; 432 433 return if ($self->ignore_nick($args->{who})); 434 435 my $nick = $self->nick; 436 if ($args->{address} || '' eq $nick) { 437 my $msg = $args->{body}; 438 $msg =~ s/[\r\n\f]+$//; 439 $self->input( $msg ); 440 $self->response(''); 441 IRC::Bot::Hangman::Command->run( $self ); 442 return $self->response if $self->response; 443 } 444 445 return if ($self->game->won or $self->game->lost); 446 447 my ($guess) = ($args->{body} =~ /^\s*([a-z])\s*\?\s*$/); 448 ($guess) = ($args->{body} =~ /^\s*guess\s+([a-z]+)\s*$/) unless $guess; 449 $guess or return; 450 451 $self->schedule_tick($self->get_delay); 452 $guess = lc $guess; 453 454 my @msg; 455 if (length $guess > 1) { 456 push @msg, $self->guess_word($guess); 457 } 458 else { 459 push @msg, $self->guess_letter($guess); 460 } 461 462 push @msg, $self->conclusion; 463 join "\r\n", @msg; 464} 465 466 467=head2 help() 468 469Displays help when called C<hangman help> 470 471=cut 472 473sub help { 474 my $self = shift; 475 my $help = $self->get_a_msg('help'); 476 my $nick = $self->nick; 477 $help =~ s/<hangman>/$nick/g; 478 $help; 479} 480 481 482=head2 tick() 483 484Called every now and then to display a reminder 485if the game is active and C<can_talk> is on. 486 487=cut 488 489sub tick { 490 my $self = shift; 491 return $self->get_delay if ($self->game->lost or $self->game->won); 492 if ($self->can_talk) { 493 my @msg = ($self->get_a_msg('play'), $self->msg_guess); 494 $self->say( channel => $_, body => join "\r\n", @msg ) for (@{$self->{channels}}); 495 } 496 $self->get_delay; 497} 498 499 5001; 501 502 503=head1 SEE ALSO 504 505L<Bot::BasicBot> 506 507=head1 AUTHOR 508 509Pierre Denis <pierre@itrelease.net> 510 511http://www.itrelease.net/ 512 513=head1 COPYRIGHT 514 515Copyright 2005 IT Release Ltd - All Rights Reserved. 516 517This module is released under the same license as Perl itself. 518 519=cut 520