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.25';
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.25
13              
14             =cut
15              
16 10     10   51269 use 5.006;
  10         35  
17 10     10   4862 use Data::Dumper;
  10         71427  
  10         561  
18 10     10   3673 use Games::TicTacToe::Move;
  10         25  
  10         270  
19 10     10   3557 use Games::TicTacToe::Board;
  10         39  
  10         296  
20 10     10   3949 use Games::TicTacToe::Player;
  10         36  
  10         322  
21 10     10   62 use Games::TicTacToe::Params qw(Board PlayerType Players);
  10         28  
  10         39  
22              
23 10     10   4827 use Moo;
  10         21  
  10         36  
24 10     10   2933 use namespace::clean;
  10         35  
  10         36  
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             The game script C is supplied with the distribution and on install
53             is available to play with.
54              
55             USAGE: play-tictactoe [-h] [long options...]
56              
57             --size=Int TicTacToe board size. Default is 3.
58             --symbol=String User preferred symbol. Default is X. The other possible
59             value is O.
60              
61             --usage show a short help message
62             -h show a compact help message
63             --help show a long help message
64             --man show the manual
65              
66             =cut
67              
68             sub BUILD {
69 6     6 0 38 my ($self) = @_;
70              
71 6         40 $self->setGameBoard($self->size);
72             }
73              
74             =head1 METHODS
75              
76             =head2 setGameBoard($size)
77              
78             It sets up the game board of the given C<$size>.
79              
80             =cut
81              
82             sub setGameBoard {
83 6     6 1 17 my ($self, $size) = @_;
84              
85 6         25 my $cell = [ map { $_ } (1..($size * $size)) ];
  54         87  
86 6         37 $self->board(Games::TicTacToe::Board->new(cell => $cell));
87             }
88              
89             =head2 getGameBoard()
90              
91             Returns game board for TicTacToe (3x3) by default.
92              
93             =cut
94              
95             sub getGameBoard {
96 0     0 1 0 my ($self) = @_;
97              
98 0         0 return $self->board->as_string;
99             }
100              
101             =head2 setPlayers($symbol)
102              
103             Adds a player with the given C<$symbol>. The other symbol would be given to the
104             opposite player i.e. Computer.
105              
106             =cut
107              
108             sub setPlayers {
109 1     1 1 972 my ($self, $symbol) = @_;
110              
111 1 50 33     7 if (($self->has_players) && (scalar(@{$self->players}) == 2)) {
  1         18  
112 1         23 warn("WARNING: We already have 2 players to play the TicTacToe game.");
113 1         64 return;
114             }
115              
116 0 0       0 die "ERROR: Missing symbol for the player.\n" unless defined $symbol;
117              
118             # Player 1
119 0         0 push @{$self->{players}}, Games::TicTacToe::Player->new(type => 'H', symbol => uc($symbol));
  0         0  
120              
121             # Player 2
122 0 0       0 $symbol = (uc($symbol) eq 'X')?('O'):('X');
123 0         0 push @{$self->{players}}, Games::TicTacToe::Player->new(type => 'C', symbol => $symbol);
  0         0  
124             }
125              
126             =head2 getPlayers()
127              
128             Returns the players information with their symbol.
129              
130             =cut
131              
132             sub getPlayers {
133 1     1 1 934 my ($self) = @_;
134              
135 1 50 33     8 if (!($self->has_players) || scalar(@{$self->players}) == 0) {
  0         0  
136 1         12 warn("WARNING: No player found to play the TicTacToe game.");
137 1         59 return;
138             }
139              
140 0         0 my $players = sprintf("+-------------+\n");
141 0         0 foreach (@{$self->{players}}) {
  0         0  
142 0         0 $players .= sprintf("|%9s: %s |\n", $_->desc, $_->symbol);
143             }
144 0         0 $players .= sprintf("+-------------+\n");
145              
146 0         0 return $players;
147             }
148              
149             =head2 play($move)
150              
151             Makes the given C<$move>, if provided, otherwise make next best possible moves on
152             behalf of opponent.
153              
154             =cut
155              
156             sub play {
157 1     1 1 940 my ($self, $move) = @_;
158              
159             die("ERROR: Please add player before you start the game.\n")
160 1 50 33     13 unless (($self->has_players) && (scalar(@{$self->players}) == 2));
  0         0  
161              
162 0         0 my $player = $self->_getCurrentPlayer;
163 0         0 my $board = $self->board;
164 0 0 0     0 if (defined $move && ($self->_getCurrentPlayer->type eq 'H')) {
165 0         0 --$move;
166             }
167             else {
168 0         0 $move = Games::TicTacToe::Move::now($player, $board);
169             }
170              
171 0         0 $board->setCell($move, $player->symbol);
172 0 0       0 $self->_resetCurrentPlayer unless ($self->isGameOver);
173             }
174              
175             =head2 getResult()
176              
177             Returns the result message.
178              
179             =cut
180              
181             sub getResult {
182 0     0 1 0 my ($self) = @_;
183              
184 0         0 my $result;
185 0 0       0 if ($self->has_winner) {
186 0         0 $result = $self->winner->getMessage;
187             }
188             else {
189 0 0       0 die "ERROR: Game is not finished yet.\n" unless $self->board->isFull;
190 0         0 $result = "Game drawn, better luck next time.\n";
191             }
192              
193 0         0 $self->clear_winner;
194 0         0 $self->current('H');
195              
196 0         0 return Term::ANSIColor::Markup->colorize($result);
197             }
198              
199             =head2 needNextMove()
200              
201             Returns 0 or 1 depending on whether it needs to prompt for next move.
202              
203             =cut
204              
205             sub needNextMove {
206 0     0 1 0 my ($self) = @_;
207              
208 0         0 return ($self->_getCurrentPlayer->type eq 'H');
209             }
210              
211             =head2 isLastMove()
212              
213             Returns 0 or 1 depending on whether it is the last move.
214              
215             =cut
216              
217             sub isLastMove {
218 0     0 1 0 my ($self) = @_;
219              
220 0         0 return ($self->board->availableIndex !~ /\,/);
221             }
222              
223             =head2 isGameOver()
224              
225             Returns 0 or 1 depending whether the TicTacToe game is over or not.
226              
227             =cut
228              
229             sub isGameOver {
230 1     1 1 935 my ($self) = @_;
231              
232 1 50 33     11 if (!($self->has_players) || scalar(@{$self->players}) == 0) {
  0         0  
233 1         14 warn("WARNING: No player found to play the TicTacToe game.");
234 1         62 return;
235             }
236              
237 0           my $board = $self->board;
238 0           foreach my $player (@{$self->players}) {
  0            
239 0 0         if (Games::TicTacToe::Move::foundWinner($player, $board)) {
240 0           $self->winner($player);
241 0           return 1;
242             }
243             }
244              
245 0           return $board->isFull;
246             }
247              
248             =head2 isValidMove($move)
249              
250             Returns 0 or 1 depending on whether the given C<$move> is valid or not.
251              
252             =cut
253              
254             sub isValidMove {
255 0     0 1   my ($self, $move) = @_;
256              
257 0   0       return (defined($move)
258             && ($move =~ /^\d+$/)
259             && ($move >= 1) && ($move <= $self->board->getSize)
260             && ($self->board->isCellEmpty($move-1)));
261             }
262              
263             =head2 isValidSymbol($symbol)
264              
265             Returns 0 or 1 depending on whether the given C<$symbol> is valid or not.
266              
267             =cut
268              
269             sub isValidSymbol {
270 0     0 1   my ($self, $symbol) = @_;
271              
272 0   0       return (defined $symbol && ($symbol =~ /^[X|O]$/i));
273             }
274              
275             =head2 isValidGameBoardSize($size)
276              
277             Returns 0 or 1 depending on whether the given C<$size> is valid or not.
278              
279             =cut
280              
281             sub isValidGameBoardSize {
282 0     0 1   my ($self, $size) = @_;
283              
284 0   0       return (defined $size && ($size >= 3));
285             }
286              
287             #
288             #
289             # PRIVATE METHODS
290              
291             sub _getCurrentPlayer {
292 0     0     my ($self) = @_;
293              
294             ($self->{players}->[0]->type eq $self->current)
295             ?
296             (return $self->{players}->[0])
297             :
298 0 0         (return $self->{players}->[1]);
299             }
300              
301             sub _resetCurrentPlayer {
302 0     0     my ($self) = @_;
303              
304             ($self->{players}->[0]->type eq $self->current)
305             ?
306             ($self->current($self->{players}->[1]->type))
307             :
308 0 0         ($self->current($self->{players}->[0]->type));
309             }
310              
311             =head1 AUTHOR
312              
313             Mohammad S Anwar, C<< >>
314              
315             =head1 REPOSITORY
316              
317             L
318              
319             =head1 BUGS
320              
321             Please report any bugs / feature requests to C
322             or through the web interface at L.
323             I will be notified & then you'll automatically be notified of progress on your bug
324             as I make changes.
325              
326             =head1 SUPPORT
327              
328             You can find documentation for this module with the perldoc command.
329              
330             perldoc Games::TicTacToe
331              
332             You can also look for information at:
333              
334             =over 4
335              
336             =item * RT: CPAN's request tracker
337              
338             L
339              
340             =item * AnnoCPAN: Annotated CPAN documentation
341              
342             L
343              
344             =item * CPAN Ratings
345              
346             L
347              
348             =item * Search CPAN
349              
350             L
351              
352             =back
353              
354             =head1 LICENSE AND COPYRIGHT
355              
356             Copyright (C) 2011 - 2016 Mohammad S Anwar.
357              
358             This program is free software; you can redistribute it and/or modify it under
359             the terms of the the Artistic License (2.0). You may obtain a copy of the full
360             license at:
361              
362             L
363              
364             Any use, modification, and distribution of the Standard or Modified Versions is
365             governed by this Artistic License.By using, modifying or distributing the Package,
366             you accept this license. Do not use, modify, or distribute the Package, if you do
367             not accept this license.
368              
369             If your Modified Version has been derived from a Modified Version made by someone
370             other than you,you are nevertheless required to ensure that your Modified Version
371             complies with the requirements of this license.
372              
373             This license does not grant you the right to use any trademark, service mark,
374             tradename, or logo of the Copyright Holder.
375              
376             This license includes the non-exclusive, worldwide, free-of-charge patent license
377             to make, have made, use, offer to sell, sell, import and otherwise transfer the
378             Package with respect to any patent claims licensable by the Copyright Holder that
379             are necessarily infringed by the Package. If you institute patent litigation
380             (including a cross-claim or counterclaim) against any party alleging that the
381             Package constitutes direct or contributory patent infringement,then this Artistic
382             License to you shall terminate on the date that such litigation is filed.
383              
384             Disclaimer of Warranty: THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER AND
385             CONTRIBUTORS "AS IS' AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES. THE IMPLIED
386             WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE, OR
387             NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY YOUR LOCAL LAW. UNLESS
388             REQUIRED BY LAW, NO COPYRIGHT HOLDER OR CONTRIBUTOR WILL BE LIABLE FOR ANY DIRECT,
389             INDIRECT, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING IN ANY WAY OUT OF THE USE
390             OF THE PACKAGE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
391              
392             =cut
393              
394             1; # End of Games::TicTacToe