File Coverage

lib/IRC/Bot/Hangman.pm

Criterion	Covered	Total	%
statement	9	9	100.0
branch			n/a
condition			n/a
subroutine	3	3	100.0
pod			n/a
total	12	12	100.0

=head1 NAME

IRC::Bot::Hangman - An IRC hangman

=head1 SYNOPSIS

  use IRC::Bot::Hangman;
  IRC::Bot::Hangman->new(
    channels => [ '#hangman' ],
    nick     => 'hangman',
    server   => 'irc.blablablablah.bla',
    word_list_name => 'too_easy',
    games    => 3,
  )->run;
  print "Finished\n";

=head1 COMMANDS

  ? : guess a letter
  guess  : guess a letter
  guess  : guess an entire word
   help - help instructions
   play : Start a new game or display current game
   quiet : keep quiet between guesses
   talk : Talk between guesses

=head1 DESCRIPTION

This module provides a useless IRC bot which
enables you to play hangman, the classic word game.
It comes shipped with a list of ~2000 english words by default.
The architecture is plugin based, words, commands and responses
can be extended at will by adding new modules.

The main motivation was to provide a multi-player text based
game for children to help them practising writing.

=head1 PLUGINS

The plugins are managed by

  IRC::Bot::Hangman::WordList
  IRC::Bot::Hangman::Command
  IRC::Bot::Hangman::Response

=cut

package IRC::Bot::Hangman;
use warnings::register;
use strict;
use base  qw( Bot::BasicBot );
use Carp  qw( carp );
use Games::GuessWord;
use IRC::Bot::Hangman::WordList;
use IRC::Bot::Hangman::Command;
use IRC::Bot::Hangman::Response;

our $VERSION = '0.1';

our $DEFAULT_WORD_LIST = 'default';
our $DEFAULT_DELAY = 30; # seconds


=head1 METHODS

=head2 word_list( $list )

Get or set the word list as an array ref.
A default word list of ~2000 english words is provided
if no list is set.

=cut

sub word_list {
  my $self = shift;
  if (@_) {
    my $list = shift;
    unless (ref $list eq 'ARRAY') {
      carp "word_list should be an array ref";
      return;
    }
    $self->{word_list} = $list;
    return $self;
  }
  $self->{word_list} ||= $self->load_word_list();
}


=head2 load_word_list( name )

Returns a default english words list
from L

=cut

sub load_word_list {
  my $self = shift;
  my $name = shift || $self->word_list_name;
  IRC::Bot::Hangman::WordList->load( $name );
}


=head2 word_list_name( $name )

Get or set the word list name.
It must be an installed module in IRC::Bot::Hangman::WordList::xxx
The default provided is 'default' = IRC::Bot::Hangman::WordList::Default

=cut

sub word_list_name {
  my $self = shift;
  if (@_) {
    $self->{word_list_name} = shift;
    return $self;
  }
  $self->{word_list_name} ||= $DEFAULT_WORD_LIST;
}


=head2 games( integer )

Get or set the number of games before ending.
undef means infinity.

=cut

sub games {
  my $self = shift;
  if (@_) {
    my $games = shift;
    $self->{games} = $games;
    return $self;
  }
  $self->{games};
}


=head2 game( $game )

Get or set the hangman game.
The default value is a L instance
with word_list() word list.

=cut

sub game {
  my $self = shift;
  if (@_) {
    my $game = shift;
    $self->{game} = $game;
    return $self;
  }
  $self->{game} ||= $self->load_game;
}


=head2 new_game()

Reset the game

=cut

sub new_game {
  my $self = shift;
  my $game = $self->game or return;
  $self->game( ref($game)->new( words => $self->word_list ) );
}


=head2 replay()

Reset the game unless it is the last game
as counted by games()

=cut

sub replay {
  my $self = shift;
  my $games = $self->games;
  if (defined $games) {
    $self->games($games - 1);
    if ($self->games <= 0) {
      $self->schedule_tick(0);
      return $self->get_a_msg('last_game');
    }
  }
  $self->new_game();
  $self->schedule_tick(5);
  return;
}


=head2 can_talk()

Get set C, used by C to display reminders.

=cut

sub can_talk {
  my $self = shift;
  if (@_) {
    $self->{can_talk} = shift;
    return $self;
  }
  $self->{can_talk};
}


=head2 load_game()

Returns a L instance

=cut

sub load_game {
  my $self = shift;
  Games::GuessWord->new( words => $self->word_list );
}


=head2 msg_guess()

Displays the word to guess

=cut

sub msg_guess {
  my $self = shift;
  'To guess: ' . $self->game->answer . ' - ' . $self->game->chances . " chances remaining";
}


=head2 get_delay()

Returns a random time calculated:
delay() * (1 + rand(4)) seconds

=cut

sub get_delay {
  my $self = shift;
  my $delay = $self->delay;
  $delay *(1 + rand(4));
}


=head2 delay()

Get set base delay in seconds.
Default is 30s.

=cut

sub delay {
  my $self = shift;
  if (@_) {
    $self->{delay} = shift;
    return $self;
  }
  $self->{delay} ||= $DEFAULT_DELAY;
}


=head2 input()

Get/set input

=cut

sub input {
  my $self = shift;
  if (@_) {
    $self->{input} = shift;
    return $self;
  }
  $self->{input};
}


=head2 response()

Get/set response

=cut

sub response {
  my $self = shift;
  if (@_) {
    $self->{response} = shift;
    return $self;
  }
  $self->{response};
}


=head2 set_response( type )

Sets the response from a response type

=cut

sub set_response {
  my $self = shift;
  my $type = shift;
  my $msg = $self->get_a_msg( $type ) or carp "No message of type $type";
  $self->response( $msg );
}


=head2 get_a_msg( type )

Returns a msg of a given type

=cut

sub get_a_msg {
  my $self = shift;
  my $type = shift;
  IRC::Bot::Hangman::Response->get_a_msg( $type );
}


=head2 guess_word( word )

Guess a word : success or one chance less

=cut

sub guess_word {
  my $self  = shift;
  my $guess = shift;
  if ($guess eq $self->game->secret) {
    $self->game->guess($guess);
    return $self->get_a_msg('good_guess');
  }
  else {
    $self->game->{chances}--;
    return $self->get_a_msg('bad_guess');
  }
}


=head2 guess_letter( letter )

Guess a letter : match or one chance less

=cut

sub guess_letter {
  my $self  = shift;
  my $guess = shift;
  my @guesses = $self->game->guesses;
  my @msg;
  if (grep { $_ eq $guess } @guesses) {
    push @msg, $self->get_a_msg('already_guessed');
    push @msg, 'Letters used: ' . join(', ', $self->game->guesses);
  }
  else {
    my $chances = $self->game->chances;
    $self->game->guess($guess);
    if ($chances == $self->game->chances) {
      push @msg, $self->get_a_msg('good_guess');
    }
    else {
      push @msg, $self->get_a_msg('bad_guess');
    }
    push @msg, $self->give_advice($guess);
  }
  @msg;
}


=head2 conclusion()

Displays an end of game message : sucess or lost

=cut

sub conclusion {
  my $self = shift;
  my @msg;
  if ($self->game->won) {
    push @msg, $self->get_a_msg('won');
    push @msg, "The word was: " . $self->game->secret;
    push @msg, "Your score: " . $self->game->score;
    push @msg, $self->replay();
  }
  elsif ($self->game->lost) {
    push @msg, $self->get_a_msg('lost');
    push @msg, "The word was: " . $self->game->secret;
    push @msg, "Your score: " . $self->game->score;
    push @msg, $self->replay();
  }
  else {
    push @msg, $self->msg_guess;
  }
  @msg;
}


=head2 give_advice( guess )

=cut

sub give_advice {
  my $self  = shift;
  my $guess = shift;
  my @guesses = $self->game->guesses;
  if ($guess =~ /[euioa]/ and grep(/[euioa]/, @guesses) >= 3 and @guesses < 6) {
    return $self->get_a_msg('lack_imagination');
  }
  return;
}


=head1 Bot::BasicBot METHODS

These are the L overriden methods

=head2 said( $args )

This is the main method,
everything said is analysed to provide a reply
if appropriate

=cut

sub said {
  my $self = shift;
  my $args = shift;

  return if ($self->ignore_nick($args->{who}));

  my $nick = $self->nick;
  if ($args->{address} || '' eq $nick) {
    my $msg = $args->{body};
    $msg =~ s/[\r\n\f]+$//;
    $self->input( $msg );
    $self->response('');
    IRC::Bot::Hangman::Command->run( $self );
    return $self->response if $self->response;
  }

  return if ($self->game->won or $self->game->lost);

  my ($guess) = ($args->{body} =~ /^\s*([a-z])\s*\?\s*$/);
  ($guess) = ($args->{body} =~ /^\s*guess\s+([a-z]+)\s*$/) unless $guess;
  $guess or return;

  $self->schedule_tick($self->get_delay);
  $guess = lc $guess;

  my @msg;
  if (length $guess > 1) {
    push @msg, $self->guess_word($guess);
  }
  else {
    push @msg, $self->guess_letter($guess);
  }

  push @msg, $self->conclusion;
  join "\r\n", @msg;
}


=head2 help()

Displays help when called C

=cut

sub help {
  my $self = shift;
  my $help = $self->get_a_msg('help');
  my $nick = $self->nick;
  $help =~ s//$nick/g;
  $help;
}


=head2 tick()

Called every now and then to display a reminder
if the game is active and C is on.

=cut

sub tick {
  my $self = shift;
  return $self->get_delay if ($self->game->lost or $self->game->won);
  if ($self->can_talk) {
    my @msg = ($self->get_a_msg('play'), $self->msg_guess);
    $self->say( channel => $_, body => join "\r\n", @msg ) for (@{$self->{channels}});
  }
  $self->get_delay;
}


1;


=head1 SEE ALSO

L

=head1 AUTHOR

Pierre Denis

http://www.itrelease.net/

=head1 COPYRIGHT

Copyright 2005 IT Release Ltd - All Rights Reserved.

This module is released under the same license as Perl itself.

=cut