File Coverage

blib/lib/Games/TicTacToe/Board.pm
Criterion Covered Total %
statement 36 98 36.7
branch 12 26 46.1
condition 5 12 41.6
subroutine 10 19 52.6
pod 10 10 100.0
total 73 165 44.2


line stmt bran cond sub pod time code
1             package Games::TicTacToe::Board;
2              
3             $Games::TicTacToe::Board::VERSION = '0.26';
4             $Games::TicTacToe::Board::AUTHORITY = 'cpan:MANWAR';
5              
6             =head1 NAME
7              
8             Games::TicTacToe::Board - Interface to the TicTacToe game's board.
9              
10             =head1 VERSION
11              
12             Version 0.26
13              
14             =cut
15              
16 11     11   1650 use 5.006;
  11         48  
17 11     11   1628 use Data::Dumper;
  11         33718  
  11         492  
18 11     11   4474 use Term::ANSIColor::Markup;
  11         155567  
  11         52  
19              
20 11     11   5342 use Moo;
  11         111317  
  11         48  
21 11     11   18526 use namespace::clean;
  11         126529  
  11         63  
22              
23             our $EMPTY = '\d';
24              
25             =head1 DESCRIPTION
26              
27             It is used internally by L.
28              
29             =cut
30              
31             has 'cell' => (is => 'rw', default => sub { return ['1','2','3','4','5','6','7','8','9']; });
32              
33             =head1 METHODS
34              
35             =head2 getSize()
36              
37             Returns the board size i.e for 3x3 board, the size would be 9.
38              
39             =cut
40              
41             sub getSize {
42 4     4 1 11 my ($self) = @_;
43              
44 4         5 return scalar(@{$self->cell});
  4         21  
45             }
46              
47             =head2 isFull()
48              
49             Return 1 or 0 depending whether the game board is full or not.
50              
51             =cut
52              
53             sub isFull {
54 1     1 1 2 my ($self) = @_;
55              
56 1         3 my $size = $self->getSize;
57 1         4 foreach my $i (0..($size-1)) {
58 1 50       3 return 0 if $self->isCellEmpty($i);
59             }
60              
61 0         0 return 1;
62             }
63              
64             =head2 setCell($index, $symbol)
65              
66             Set the cell C<$index> with the player C<$symbol>.
67              
68             =cut
69              
70             sub setCell {
71 4     4 1 4210 my ($self, $index, $symbol) = @_;
72              
73 4 100       17 die("ERROR: Missing cell index for TicTacToe Board.\n") unless defined $index;
74 3 100       9 die("ERROR: Missing symbol for TicTacToe Board.\n") unless defined $symbol;
75 2 100       69 die("ERROR: Invalid symbol for TicTacToe Board.\n") unless ($symbol =~ /^[X|O]$/i);
76              
77 1         163 my $size = $self->getSize;
78 1 50 33     53 if (($index =~ /^\d*$/) && ($index >= 0) && ($index < $size)) {
      33        
79 0         0 $self->{cell}->[$index] = $symbol;
80             }
81             else {
82 1         7 die("ERROR: Invalid cell index value for TicTacToe Board.\n");
83             }
84             }
85              
86             =head2 getCell($index)
87              
88             Get the cell symbol in the given C<$index>.
89              
90             =cut
91              
92             sub getCell {
93 3     3 1 616 my ($self, $index) = @_;
94              
95 3 100       13 die("ERROR: Missing cell index for TicTacToe Board.\n") unless defined($index);
96              
97 2         5 my $size = $self->getSize;
98 2 100 33     23 if (($index =~ /^\d*$/) && ($index >= 0) && ($index < $size)) {
      66        
99 1         14 return $self->{cell}->[$index];
100             }
101             else {
102 1         5 die("ERROR: Invalid index value for TicTacToe Board.\n");
103             }
104             }
105              
106             =head2 availableIndex()
107              
108             Returns comma seperated empty cell indexes.
109              
110             =cut
111              
112             sub availableIndex {
113 0     0 1 0 my ($self) = @_;
114              
115 0         0 my $index = '';
116 0         0 my $size = $self->getSize;
117 0         0 foreach my $i (1..$size) {
118 0 0       0 $index .= $i . "," if $self->isCellEmpty($i-1);
119             }
120 0         0 $index =~ s/\,$//g;
121              
122 0         0 return $index;
123             }
124              
125             =head2 isCellEmpty($index)
126              
127             Returns 1 or 0 depending on if the cell C<$index> is empty.
128              
129             =cut
130              
131             sub isCellEmpty {
132 1     1 1 2 my ($self, $index) = @_;
133              
134 1         4 return ($self->getCell($index) =~ /$EMPTY/);
135             }
136              
137             =head2 cellContains($index, $symbol)
138              
139             Returns 0 or 1 depending on if the cell C<$index> contains the C<$symbol>.
140              
141             =cut
142              
143             sub cellContains {
144 0     0 1   my ($self, $index, $symbol) = @_;
145              
146 0           return ($self->getCell($index) eq $symbol);
147             }
148              
149             =head2 belongsToPlayer($cells, $player)
150              
151             Returns 0 or 1 depending on if the C<$cells> belong to C<$player>.
152              
153             =cut
154              
155             sub belongsToPlayer {
156 0     0 1   my ($self, $cells, $player) = @_;
157              
158 0           my $symbol = $player->symbol;
159 0           my $size = sqrt($self->getSize);
160 0           foreach my $i (0..($size-1)) {
161 0 0         return 0 unless ($self->cellContains($cells->[$i], $symbol));
162             }
163              
164 0           return 1;
165             }
166              
167             =head2 as_string()
168              
169             Returns the current game board.
170              
171             =cut
172              
173             sub as_string {
174 0     0 1   my ($self) = @_;
175              
176 0           my $size = sqrt($self->getSize);
177 0           my $cell_width = _cell_width($size);
178 0           my $table_width = _table_width($size);
179 0           my $board_color_s = "";
180 0           my $board_color_e = "";
181 0           my $board = sprintf("+%s%s+\n", $board_color_s, '-'x($table_width-2));
182 0           $board .= _table_header($size);
183              
184 0           foreach my $col (1..$size) {
185 0           $board .= sprintf("+%s", '-'x$cell_width);
186             }
187 0           $board .= sprintf("+%s\n", $board_color_e);
188              
189 0           my $i = 0;
190 0           foreach my $row (1..$size) {
191 0           foreach my $col (1..$size) {
192             $board .= sprintf("$board_color_s|$board_color_e %-".($cell_width-2)."s ",
193 0           _color_code($cell_width, $self->{cell}->[$i++]));
194             }
195 0           $board .= "$board_color_s|\n";
196 0           foreach my $col (1..$size) {
197 0           $board .= sprintf("+%s", '-'x$cell_width);
198             }
199 0           $board .= "+$board_color_e\n";
200             }
201              
202 0           return Term::ANSIColor::Markup->colorize($board);
203             }
204              
205             =head2 reset()
206              
207             Resets the game board back to original state.
208              
209             =cut
210              
211             sub reset {
212 0     0 1   my ($self) = @_;
213              
214 0           my $size = $self->getSize;
215 0           foreach my $i (1..$size) {
216 0           $self->{cell}->[$i-1] = $i;
217             }
218             }
219              
220             #
221             #
222             # PRIVATE METHODS
223              
224             sub _cell_width {
225 0     0     my ($size) = @_;
226              
227 0           my $len = length($size*$size);
228 0           return ($len+2);
229             }
230              
231             sub _table_width {
232 0     0     my ($size) = @_;
233              
234 0           my $cell_width = _cell_width($size);
235 0           return ( 1 + ($cell_width * $size) + ($size-1) + 1);
236             }
237              
238             sub _table_header {
239 0     0     my ($size) = @_;
240              
241 0           my $table_width = _table_width($size);
242 0           my $pad_size = $table_width - 9;
243              
244 0           my ($left, $right);
245 0 0         if ($pad_size % 2 == 0) {
246 0           $left = $right = $pad_size / 2;
247             }
248             else {
249 0           $left = int($pad_size / 2);
250 0           $right = $left + 1;
251             }
252              
253 0           my $format = "%-".$left."s%s%".$right."s\n";
254              
255 0           return sprintf($format, '|', 'TicTacToe', '|');
256             }
257              
258             sub _color_code {
259 0     0     my ($width, $text) = @_;
260              
261 0 0         if ($text =~ /^\d+$/) {
    0          
    0          
262 0           return $text;
263             }
264             elsif ($text eq 'X') {
265 0           return "" . sprintf("%-".($width-2)."s", $text) . "";
266             }
267             elsif ($text eq 'O') {
268 0           return "" . sprintf("%-".($width-2)."s", $text) . "";
269             }
270             }
271              
272             =head1 AUTHOR
273              
274             Mohammad S Anwar, C<< >>
275              
276             =head1 REPOSITORY
277              
278             L
279              
280             =head1 BUGS
281              
282             Please report any bugs / feature requests to C
283             or through the web interface at L.
284             I will be notified & then you'll automatically be notified of progress on your bug
285             as I make changes.
286              
287             =head1 SUPPORT
288              
289             You can find documentation for this module with the perldoc command.
290              
291             perldoc Games::TicTacToe::Board
292              
293             You can also look for information at:
294              
295             =over 4
296              
297             =item * RT: CPAN's request tracker
298              
299             L
300              
301             =item * AnnoCPAN: Annotated CPAN documentation
302              
303             L
304              
305             =item * CPAN Ratings
306              
307             L
308              
309             =item * Search CPAN
310              
311             L
312              
313             =back
314              
315             =head1 LICENSE AND COPYRIGHT
316              
317             Copyright (C) 2011 - 2016 Mohammad S Anwar.
318              
319             This program is free software; you can redistribute it and/or modify it under
320             the terms of the the Artistic License (2.0). You may obtain a copy of the full
321             license at:
322              
323             L
324              
325             Any use, modification, and distribution of the Standard or Modified Versions is
326             governed by this Artistic License.By using, modifying or distributing the Package,
327             you accept this license. Do not use, modify, or distribute the Package, if you do
328             not accept this license.
329              
330             If your Modified Version has been derived from a Modified Version made by someone
331             other than you,you are nevertheless required to ensure that your Modified Version
332             complies with the requirements of this license.
333              
334             This license does not grant you the right to use any trademark, service mark,
335             tradename, or logo of the Copyright Holder.
336              
337             This license includes the non-exclusive, worldwide, free-of-charge patent license
338             to make, have made, use, offer to sell, sell, import and otherwise transfer the
339             Package with respect to any patent claims licensable by the Copyright Holder that
340             are necessarily infringed by the Package. If you institute patent litigation
341             (including a cross-claim or counterclaim) against any party alleging that the
342             Package constitutes direct or contributory patent infringement,then this Artistic
343             License to you shall terminate on the date that such litigation is filed.
344              
345             Disclaimer of Warranty: THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER AND
346             CONTRIBUTORS "AS IS' AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES. THE IMPLIED
347             WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE, OR
348             NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY YOUR LOCAL LAW. UNLESS
349             REQUIRED BY LAW, NO COPYRIGHT HOLDER OR CONTRIBUTOR WILL BE LIABLE FOR ANY DIRECT,
350             INDIRECT, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING IN ANY WAY OUT OF THE USE
351             OF THE PACKAGE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
352              
353             =cut
354              
355             1; # End of Games::TicTacToe::Board