File Coverage

blib/lib/Games/TicTacToe.pm
Criterion Covered Total %
statement 44 98 44.9
branch 4 26 15.3
condition 4 24 16.6
subroutine 14 23 60.8
pod 12 13 92.3
total 78 184 42.3


line stmt bran cond sub pod time code
1             package Games::TicTacToe;
2              
3             $Games::TicTacToe::VERSION = '0.24';
4             $Games::TicTacToe::AUTHOR = 'cpan:MANWAR';
5              
6             =head1 NAME
7              
8             Games::TicTacToe - Interface to the TicTacToe (nxn) game.
9              
10             =head1 VERSION
11              
12             Version 0.24
13              
14             =cut
15              
16 10     10   57554 use 5.006;
  10         32  
17 10     10   4858 use Data::Dumper;
  10         65742  
  10         493  
18 10     10   3375 use Games::TicTacToe::Move;
  10         23  
  10         265  
19 10     10   3089 use Games::TicTacToe::Board;
  10         44  
  10         325  
20 10     10   3765 use Games::TicTacToe::Player;
  10         37  
  10         352  
21 10     10   65 use Games::TicTacToe::Params qw(Board PlayerType Players);
  10         28  
  10         42  
22              
23 10     10   4745 use Moo;
  10         22  
  10         37  
24 10     10   2741 use namespace::clean;
  10         31  
  10         43  
25              
26             has 'board' => (is => 'rw', isa => Board);
27             has 'current' => (is => 'rw', isa => PlayerType, default => sub { return 'H'; });
28             has 'players' => (is => 'rw', isa => Players, predicate => 1);
29             has 'size' => (is => 'ro', default => sub { return 3 });
30             has 'winner' => (is => 'rw', predicate => 1, clearer => 1);
31              
32             =head1 DESCRIPTION
33              
34             A console based TicTacToe game to play against the computer. A simple TicTacToe
35             layer supplied with the distribution in the script sub folder. Board arranged as
36             nxn, where n>=3. Default size is 3,For example 5x5 would be something like below:
37              
38             +------------------------+
39             | TicTacToe |
40             +----+----+----+----+----+
41             | 1 | 2 | 3 | 4 | 5 |
42             +----+----+----+----+----+
43             | 6 | 7 | 8 | 9 | 10 |
44             +----+----+----+----+----+
45             | 11 | 12 | 13 | 14 | 15 |
46             +----+----+----+----+----+
47             | 16 | 17 | 18 | 19 | 20 |
48             +----+----+----+----+----+
49             | 21 | 22 | 23 | 24 | 25 |
50             +----+----+----+----+----+
51              
52             =head1 SYNOPSIS
53              
54             Below is the working code for the TicTacToe game using the L
55             package. The game script C is supplied with the distribution and
56             on install is available to play with.
57              
58             use strict; use warnings;
59             use Games::TicTacToe;
60              
61             $|=1;
62              
63             $SIG{'INT'} = sub { print {*STDOUT} "\n\nCaught Interrupt (^C), Aborting\n"; exit(1); };
64              
65             my $tictactoe = Games::TicTacToe->new;
66              
67             my ($size);
68             do {
69             print {*STDOUT} "Please enter game board size (type 3 if you want 3x3): ";
70             $size = ;
71             chomp($size);
72             } until ($tictactoe->isValidGameBoardSize($size));
73              
74             $tictactoe->setGameBoard($size);
75              
76             my ($symbol);
77             do {
78             print {*STDOUT} "Please select the symbol [X / O]: ";
79             $symbol = ;
80             chomp($symbol);
81             } until ($tictactoe->isValidSymbol($symbol));
82              
83             $tictactoe->setPlayers($symbol);
84              
85             my ($response);
86             do {
87             print {*STDOUT} $tictactoe->getGameBoard;
88             my $index = 1;
89             my $board = $tictactoe->board;
90             do {
91             my $move = undef;
92             if ($tictactoe->needNextMove) {
93             my $available = $board->availableIndex;
94             if ($tictactoe->isLastMove) {
95             $move = $available;
96             }
97             else {
98             do {
99             print {*STDOUT} "What is your next move [$available] ? ";
100             $move = ;
101             chomp($move);
102             } until ($tictactoe->isValidMove($move));
103             }
104             }
105              
106             $tictactoe->play($move);
107              
108             print {*STDOUT} $tictactoe->getGameBoard
109             unless (($index % 2 == 1) || $tictactoe->isGameOver);
110              
111             $index++;
112              
113             } until ($tictactoe->isGameOver);
114              
115             print {*STDOUT} $tictactoe->getGameBoard;
116             print {*STDOUT} $tictactoe->getResult;
117              
118             $board->reset;
119              
120             do {
121             print {*STDOUT} "Do you wish to continue (Y/N)? ";
122             $response = ;
123             chomp($response);
124             } until (defined $response && ($response =~ /^[Y|N]$/i));
125              
126             } until ($response =~ /^N$/i);
127              
128             print {*STDOUT} "Thank you.\n";
129              
130             Once it is installed, it can be played on a terminal/command window as below:
131              
132             $ play-tictactoe
133              
134             =cut
135              
136             sub BUILD {
137 6     6 0 36 my ($self) = @_;
138              
139 6         39 $self->setGameBoard($self->size);
140             }
141              
142             =head1 METHODS
143              
144             =head2 setGameBoard($size)
145              
146             It sets up the game board of the given C<$size>.
147              
148             =cut
149              
150             sub setGameBoard {
151 6     6 1 16 my ($self, $size) = @_;
152              
153 6         25 my $cell = [ map { $_ } (1..($size * $size)) ];
  54         87  
154 6         39 $self->board(Games::TicTacToe::Board->new(cell => $cell));
155             }
156              
157             =head2 getGameBoard()
158              
159             Returns game board for TicTacToe (3x3) by default.
160              
161             =cut
162              
163             sub getGameBoard {
164 0     0 1 0 my ($self) = @_;
165              
166 0         0 return $self->board->as_string;
167             }
168              
169             =head2 setPlayers($symbol)
170              
171             Adds a player with the given C<$symbol>. The other symbol would be given to the
172             opposite player i.e. Computer.
173              
174             =cut
175              
176             sub setPlayers {
177 1     1 1 1011 my ($self, $symbol) = @_;
178              
179 1 50 33     10 if (($self->has_players) && (scalar(@{$self->players}) == 2)) {
  1         20  
180 1         21 warn("WARNING: We already have 2 players to play the TicTacToe game.");
181 1         69 return;
182             }
183              
184 0 0       0 die "ERROR: Missing symbol for the player.\n" unless defined $symbol;
185              
186             # Player 1
187 0         0 push @{$self->{players}}, Games::TicTacToe::Player->new(type => 'H', symbol => uc($symbol));
  0         0  
188              
189             # Player 2
190 0 0       0 $symbol = (uc($symbol) eq 'X')?('O'):('X');
191 0         0 push @{$self->{players}}, Games::TicTacToe::Player->new(type => 'C', symbol => $symbol);
  0         0  
192             }
193              
194             =head2 getPlayers()
195              
196             Returns the players information with their symbol.
197              
198             =cut
199              
200             sub getPlayers {
201 1     1 1 964 my ($self) = @_;
202              
203 1 50 33     10 if (!($self->has_players) || scalar(@{$self->players}) == 0) {
  0         0  
204 1         13 warn("WARNING: No player found to play the TicTacToe game.");
205 1         61 return;
206             }
207              
208 0         0 my $players = sprintf("+-------------+\n");
209 0         0 foreach (@{$self->{players}}) {
  0         0  
210 0         0 $players .= sprintf("|%9s: %s |\n", $_->desc, $_->symbol);
211             }
212 0         0 $players .= sprintf("+-------------+\n");
213              
214 0         0 return $players;
215             }
216              
217             =head2 play($move)
218              
219             Makes the given C<$move>, if provided, otherwise make next best possible moves on
220             behalf of opponent.
221              
222             =cut
223              
224             sub play {
225 1     1 1 910 my ($self, $move) = @_;
226              
227             die("ERROR: Please add player before you start the game.\n")
228 1 50 33     28 unless (($self->has_players) && (scalar(@{$self->players}) == 2));
  0         0  
229              
230 0         0 my $player = $self->_getCurrentPlayer;
231 0         0 my $board = $self->board;
232 0 0 0     0 if (defined $move && ($self->_getCurrentPlayer->type eq 'H')) {
233 0         0 --$move;
234             }
235             else {
236 0         0 $move = Games::TicTacToe::Move::now($player, $board);
237             }
238              
239 0         0 $board->setCell($move, $player->symbol);
240 0 0       0 $self->_resetCurrentPlayer unless ($self->isGameOver);
241             }
242              
243             =head2 getResult()
244              
245             Returns the result message.
246              
247             =cut
248              
249             sub getResult {
250 0     0 1 0 my ($self) = @_;
251              
252 0         0 my $result;
253 0 0       0 if ($self->has_winner) {
254 0         0 $result = $self->winner->getMessage;
255             }
256             else {
257 0 0       0 die "ERROR: Game is not finished yet.\n" unless $self->board->isFull;
258 0         0 $result = "Game drawn, better luck next time.\n";
259             }
260              
261 0         0 $self->clear_winner;
262 0         0 $self->current('H');
263              
264 0         0 return Term::ANSIColor::Markup->colorize($result);
265             }
266              
267             =head2 needNextMove()
268              
269             Returns 0 or 1 depending on whether it needs to prompt for next move.
270              
271             =cut
272              
273             sub needNextMove {
274 0     0 1 0 my ($self) = @_;
275              
276 0         0 return ($self->_getCurrentPlayer->type eq 'H');
277             }
278              
279             =head2 isLastMove()
280              
281             Returns 0 or 1 depending on whether it is the last move.
282              
283             =cut
284              
285             sub isLastMove {
286 0     0 1 0 my ($self) = @_;
287              
288 0         0 return ($self->board->availableIndex !~ /\,/);
289             }
290              
291             =head2 isGameOver()
292              
293             Returns 0 or 1 depending whether the TicTacToe game is over or not.
294              
295             =cut
296              
297             sub isGameOver {
298 1     1 1 950 my ($self) = @_;
299              
300 1 50 33     10 if (!($self->has_players) || scalar(@{$self->players}) == 0) {
  0         0  
301 1         13 warn("WARNING: No player found to play the TicTacToe game.");
302 1         60 return;
303             }
304              
305 0           my $board = $self->board;
306 0           foreach my $player (@{$self->players}) {
  0            
307 0 0         if (Games::TicTacToe::Move::foundWinner($player, $board)) {
308 0           $self->winner($player);
309 0           return 1;
310             }
311             }
312              
313 0           return $board->isFull;
314             }
315              
316             =head2 isValidMove($move)
317              
318             Returns 0 or 1 depending on whether the given C<$move> is valid or not.
319              
320             =cut
321              
322             sub isValidMove {
323 0     0 1   my ($self, $move) = @_;
324              
325 0   0       return (defined($move)
326             && ($move =~ /^\d+$/)
327             && ($move >= 1) && ($move <= $self->board->getSize)
328             && ($self->board->isCellEmpty($move-1)));
329             }
330              
331             =head2 isValidSymbol($symbol)
332              
333             Returns 0 or 1 depending on whether the given C<$symbol> is valid or not.
334              
335             =cut
336              
337             sub isValidSymbol {
338 0     0 1   my ($self, $symbol) = @_;
339              
340 0   0       return (defined $symbol && ($symbol =~ /^[X|O]$/i));
341             }
342              
343             =head2 isValidGameBoardSize($size)
344              
345             Returns 0 or 1 depending on whether the given C<$size> is valid or not.
346              
347             =cut
348              
349             sub isValidGameBoardSize {
350 0     0 1   my ($self, $size) = @_;
351              
352 0   0       return (defined $size && ($size >= 3));
353             }
354              
355             #
356             #
357             # PRIVATE METHODS
358              
359             sub _getCurrentPlayer {
360 0     0     my ($self) = @_;
361              
362             ($self->{players}->[0]->type eq $self->current)
363             ?
364             (return $self->{players}->[0])
365             :
366 0 0         (return $self->{players}->[1]);
367             }
368              
369             sub _resetCurrentPlayer {
370 0     0     my ($self) = @_;
371              
372             ($self->{players}->[0]->type eq $self->current)
373             ?
374             ($self->current($self->{players}->[1]->type))
375             :
376 0 0         ($self->current($self->{players}->[0]->type));
377             }
378              
379             =head1 AUTHOR
380              
381             Mohammad S Anwar, C<< >>
382              
383             =head1 REPOSITORY
384              
385             L
386              
387             =head1 BUGS
388              
389             Please report any bugs / feature requests to C
390             or through the web interface at L.
391             I will be notified & then you'll automatically be notified of progress on your bug
392             as I make changes.
393              
394             =head1 SUPPORT
395              
396             You can find documentation for this module with the perldoc command.
397              
398             perldoc Games::TicTacToe
399              
400             You can also look for information at:
401              
402             =over 4
403              
404             =item * RT: CPAN's request tracker
405              
406             L
407              
408             =item * AnnoCPAN: Annotated CPAN documentation
409              
410             L
411              
412             =item * CPAN Ratings
413              
414             L
415              
416             =item * Search CPAN
417              
418             L
419              
420             =back
421              
422             =head1 LICENSE AND COPYRIGHT
423              
424             Copyright (C) 2011 - 2016 Mohammad S Anwar.
425              
426             This program is free software; you can redistribute it and/or modify it under
427             the terms of the the Artistic License (2.0). You may obtain a copy of the full
428             license at:
429              
430             L
431              
432             Any use, modification, and distribution of the Standard or Modified Versions is
433             governed by this Artistic License.By using, modifying or distributing the Package,
434             you accept this license. Do not use, modify, or distribute the Package, if you do
435             not accept this license.
436              
437             If your Modified Version has been derived from a Modified Version made by someone
438             other than you,you are nevertheless required to ensure that your Modified Version
439             complies with the requirements of this license.
440              
441             This license does not grant you the right to use any trademark, service mark,
442             tradename, or logo of the Copyright Holder.
443              
444             This license includes the non-exclusive, worldwide, free-of-charge patent license
445             to make, have made, use, offer to sell, sell, import and otherwise transfer the
446             Package with respect to any patent claims licensable by the Copyright Holder that
447             are necessarily infringed by the Package. If you institute patent litigation
448             (including a cross-claim or counterclaim) against any party alleging that the
449             Package constitutes direct or contributory patent infringement,then this Artistic
450             License to you shall terminate on the date that such litigation is filed.
451              
452             Disclaimer of Warranty: THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER AND
453             CONTRIBUTORS "AS IS' AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES. THE IMPLIED
454             WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE, OR
455             NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY YOUR LOCAL LAW. UNLESS
456             REQUIRED BY LAW, NO COPYRIGHT HOLDER OR CONTRIBUTOR WILL BE LIABLE FOR ANY DIRECT,
457             INDIRECT, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING IN ANY WAY OUT OF THE USE
458             OF THE PACKAGE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
459              
460             =cut
461              
462             1; # End of Games::TicTacToe