File Coverage

blib/lib/Games/Domino/Player.pm
Criterion Covered Total %
statement 52 102 50.9
branch 5 26 19.2
condition 2 21 9.5
subroutine 10 16 62.5
pod 5 5 100.0
total 74 170 43.5


line stmt bran cond sub pod time code
1             package Games::Domino::Player;
2              
3             $Games::Domino::Player::VERSION = '0.30';
4             $Games::Domino::Player::AUTHORITY = 'cpan:MANWAR';
5              
6             =head1 NAME
7              
8             Games::Domino::Player - Represents the player of the Domino game.
9              
10             =head1 VERSION
11              
12             Version 0.30
13              
14             =cut
15              
16 5     5   461 use 5.006;
  5         16  
17 5     5   24 use Data::Dumper;
  5         11  
  5         258  
18 5     5   31 use Games::Domino::Params qw(HorC);
  5         10  
  5         41  
19              
20 5     5   1870 use Moo;
  5         11  
  5         33  
21 5     5   1527 use namespace::clean;
  5         11  
  5         54  
22              
23 5     5   1364 use overload q{""} => 'as_string', fallback => 1;
  5         11  
  5         36  
24              
25             has 'name' => (is => 'ro', isa => HorC, required => 1);
26             has 'bank' => (is => 'rw');
27             has 'score' => (is => 'rw');
28             has 'show' => (is => 'rw', default => sub { return 0 });
29              
30             =head1 DESCRIPTION
31              
32             It is used internally by L.
33              
34             =head1 METHODS
35              
36             =head2 save()
37              
38             Saves the given tile to the bank of the player.
39              
40             use strict; use warnings;
41             use Games::Domino::Tile;
42             use Games::Domino::Player;
43              
44             my $player = Games::Domino::Player->new({ name => 'H' });
45             $player->save(Games::Domino::Tile->new({ left => 1, right => 4 }));
46              
47             =cut
48              
49             sub save {
50 18     18 1 147 my ($self, $tile) = @_;
51              
52 18 100       43 die("ERROR: Undefined tile found.\n") unless defined $tile;
53              
54 17         24 push @{$self->{bank}}, $tile;
  17         46  
55             }
56              
57             =head2 reset()
58              
59             Resets player's score and bank (of tiles).
60              
61             use strict; use warnings;
62             use Games::Domino::Tile;
63             use Games::Domino::Player;
64              
65             my $player = Games::Domino::Player->new({ name => 'H' });
66             $player->save(Games::Domino::Tile->new({ left => 1, right => 4 }));
67             $player-reset();
68              
69             =cut
70              
71             sub reset {
72 0     0 1 0 my ($self) = @_;
73              
74 0         0 $self->{bank} = [];
75 0         0 $self->{score} = 0;
76             }
77              
78             =head2 value()
79              
80             Returns the total value of all the tiles of the current player.
81              
82             use strict; use warnings;
83             use Games::Domino::Tile;
84             use Games::Domino::Player;
85              
86             my $player = Games::Domino::Player->new({ name => 'H' });
87             $player->save(Games::Domino::Tile->new({ left => 1, right => 4 }));
88             $player->save(Games::Domino::Tile->new({ left => 5, right => 3 }));
89             print "The total value of the player is [" . $player->value . "]\n";
90              
91             =cut
92              
93             sub value {
94 1     1 1 6 my ($self) = @_;
95              
96 1         3 $self->{score} = 0;
97 1         2 foreach (@{$self->{bank}}) {
  1         3  
98 2         8 $self->{score} += $_->value;
99             }
100 1         6 return $self->{score};
101             }
102              
103             =head2 pick()
104              
105             Returns a matching tile for the given open ends. If no open ends found it then
106             returns highest value tile from the bank of the player.
107              
108             use strict; use warnings;
109             use Games::Domino::Tile;
110             use Games::Domino::Player;
111              
112             my $player = Games::Domino::Player->new({ name => 'H' });
113             $player->save(Games::Domino::Tile->new({ left => 1, right => 4 }));
114             $player->save(Games::Domino::Tile->new({ left => 5, right => 3 }));
115             my $tile = $player->pick();
116             print "Tile: $tile\n";
117              
118             =cut
119              
120             sub pick {
121 2     2 1 10 my ($self, $left, $right) = @_;
122              
123 2 50 66     10 return $self->_pick($left, $right)
124             if (defined($left) && defined($right));
125              
126 2         4 my $i = 0;
127 2         3 my $pos = 0;
128 2         4 my $max = 0;
129 2         3 my $tile = undef;
130              
131 2         3 foreach (@{$self->{bank}}) {
  2         5  
132 4 50       11 if ($_->value > $max) {
133 4         10 $max = $_->value;
134 4         9 $tile = $_;
135 4         5 $pos = $i;
136             }
137 4         10 $i++;
138             }
139              
140 2         3 splice(@{$self->{bank}}, $pos, 1);
  2         6  
141 2         5 return $tile;
142             }
143              
144             =head2 as_string()
145              
146             Returns the player object as string.This method is overloaded as string context.
147             So if we print the object then this method gets called. You can explictly call
148             this method as well. Suppose the player has 2 tiles then this return something
149             like [1 | 4] == [5 | 3].
150              
151             use strict; use warnings;
152             use Games::Domino::Tile;
153             use Games::Domino::Player;
154              
155             my $player = Games::Domino::Player->new({ name => 'H' });
156             $player->save(Games::Domino::Tile->new({ left => 1, right => 4 }));
157             $player->save(Games::Domino::Tile->new({ left => 5, right => 3 }));
158             print "Player: $player\n";
159              
160             =cut
161              
162             sub as_string {
163 1     1 1 4 my ($self) = @_;
164              
165 1         3 my $bank = '';
166 1         2 foreach (@{$self->{bank}}) {
  1         4  
167 2 50       38 if ($self->show) {
168 2         34 $bank .= sprintf("[%d | %d]==", $_->left, $_->right);
169             } else {
170 0         0 $bank .= sprintf("[x | x]==");
171             }
172             }
173 1         25 $bank =~ s/[\=]+\s?$//;
174 1         5 $bank =~ s/\s+$//;
175 1         4 return $bank;
176             }
177              
178             #
179             #
180             # PRIVATE METHODS
181              
182             sub _pick {
183 0     0     my ($self, $left, $right) = @_;
184              
185 0           my $i = 0;
186 0           my $pos = 0;
187 0           my $tile = undef;
188              
189             # Find all matching tiles.
190 0           my $matched = {};
191 0           foreach (@{$self->{bank}}) {
  0            
192 0           my $L = $_->left;
193 0           my $R = $_->right;
194 0 0 0       if (($left =~ /$L|$R/) || ($right =~ /$L|$R/)) {
195 0           $pos = $i;
196 0           $tile = $_;
197 0           $matched->{$i} = $tile;
198             }
199 0           $i++;
200             }
201              
202             # Pick the maximum value tile among all the matched ones.
203 0           my $pick = undef;
204 0           my $max = 0;
205 0           foreach (keys %{$matched}) {
  0            
206 0 0         if ($matched->{$_}->value > $max) {
207 0           $max = $matched->{$_}->value;
208 0           $pick = { i => $_, t => $matched->{$_} };
209             }
210             }
211              
212 0 0         if (defined($pick)) {
213 0           splice(@{$self->{bank}}, $pick->{i}, 1);
  0            
214 0           return $pick->{t};
215             }
216 0           return;
217             }
218              
219             sub _available_indexes {
220 0     0     my ($self) = @_;
221              
222 0 0         return 1 if (scalar(@{$self->{bank}}) == 1);
  0            
223 0           return "1..".scalar(@{$self->{bank}});
  0            
224             }
225              
226             sub _validate_index {
227 0     0     my ($self, $index) = @_;
228              
229 0 0 0       return 0 unless (defined($index) && ($index =~ /^\d+$/));
230 0 0 0       return 1 if ((scalar(@{$self->{bank}}) >= $index) && ($index >= 1));
  0            
231 0           return 0;
232             }
233              
234             sub _validate_tile {
235 0     0     my ($self, $index, $left, $right) = @_;
236              
237 0 0 0       return 0 unless (defined($index) && ($index =~ /^\d+$/));
238 0 0 0       return 1 unless (defined $left && defined $right);
239              
240 0           my $tile = $self->{bank}->[$index-1];
241 0           my $L = $tile->left;
242 0           my $R = $tile->right;
243              
244 0 0 0       return 1 if (($left =~ /$L|$R/) || ($right =~ /$L|$R/));
245 0           return 0;
246             }
247              
248             sub _tile {
249 0     0     my ($self, $index) = @_;
250              
251 0           return $self->{bank}->[$index-1];
252             }
253              
254             =head1 AUTHOR
255              
256             Mohammad S Anwar, C<< >>
257              
258             =head1 REPOSITORY
259              
260             L
261              
262             =head1 BUGS
263              
264             Please report any bugs or feature requests to C,
265             or through the web interface at L.
266             I will be notified, and then you'll automatically be notified of progress on your
267             bug as I make changes.
268              
269             =head1 SUPPORT
270              
271             You can find documentation for this module with the perldoc command.
272              
273             perldoc Games::Domino::Player
274              
275             You can also look for information at:
276              
277             =over 4
278              
279             =item * RT: CPAN's request tracker (report bugs here)
280              
281             L
282              
283             =item * AnnoCPAN: Annotated CPAN documentation
284              
285             L
286              
287             =item * CPAN Ratings
288              
289             L
290              
291             =item * Search CPAN
292              
293             L
294              
295             =back
296              
297             =head1 LICENSE AND COPYRIGHT
298              
299             Copyright 2012 - 2016 Mohammad S Anwar.
300              
301             This program is free software; you can redistribute it and / or modify it under
302             the terms of the the Artistic License (2.0). You may obtain a copy of the full
303             license at:
304              
305             L
306              
307             Any use, modification, and distribution of the Standard or Modified Versions is
308             governed by this Artistic License.By using, modifying or distributing the Package,
309             you accept this license. Do not use, modify, or distribute the Package, if you do
310             not accept this license.
311              
312             If your Modified Version has been derived from a Modified Version made by someone
313             other than you,you are nevertheless required to ensure that your Modified Version
314             complies with the requirements of this license.
315              
316             This license does not grant you the right to use any trademark, service mark,
317             tradename, or logo of the Copyright Holder.
318              
319             This license includes the non-exclusive, worldwide, free-of-charge patent license
320             to make, have made, use, offer to sell, sell, import and otherwise transfer the
321             Package with respect to any patent claims licensable by the Copyright Holder that
322             are necessarily infringed by the Package. If you institute patent litigation
323             (including a cross-claim or counterclaim) against any party alleging that the
324             Package constitutes direct or contributory patent infringement,then this Artistic
325             License to you shall terminate on the date that such litigation is filed.
326              
327             Disclaimer of Warranty: THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER AND
328             CONTRIBUTORS "AS IS' AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES. THE IMPLIED
329             WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE, OR
330             NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY YOUR LOCAL LAW. UNLESS
331             REQUIRED BY LAW, NO COPYRIGHT HOLDER OR CONTRIBUTOR WILL BE LIABLE FOR ANY DIRECT,
332             INDIRECT, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING IN ANY WAY OUT OF THE USE
333             OF THE PACKAGE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
334              
335             =cut
336              
337             1; # End of Games::Domino::Player