File Coverage

blib/lib/Games/Bingo/Card.pm
Criterion Covered Total %
statement 131 131 100.0
branch 28 28 100.0
condition 2 3 66.6
subroutine 18 18 100.0
pod 4 4 100.0
total 183 184 99.4


line stmt bran cond sub pod time code
1             package Games::Bingo::Card;
2              
3 11     11   7855 use strict;
  11         19  
  11         443  
4 11     11   56 use warnings;
  11         17  
  11         381  
5 11     11   279 use 5.006; #perl 5.6.0
  11         29  
6 11     11   6422 use integer;
  11         109  
  11         66  
7 11     11   407 use vars qw($VERSION);
  11         16  
  11         597  
8 11     11   4596 use Games::Bingo::Column;
  11         30  
  11         392  
9 11     11   5573 use Games::Bingo::ColumnCollection;
  11         24  
  11         412  
10 11         12478 use Games::Bingo::Constants qw(
11             NUMBER_OF_NUMBERS_IN_CARD
12             NUMBER_OF_COLUMNS_IN_CARD
13             NUMBER_OF_ROWS_IN_CARD
14             NUMBER_OF_NUMBERS_IN_ROW
15             NUMBER_OF_NUMBERS
16 11     11   65 );
  11         17  
17              
18             $VERSION = '0.18';
19              
20             sub new {
21 13     13 1 7483 my ($class) = @_;
22            
23 13         41 my $self = bless [], $class;
24            
25 13         37 return $self;
26             }
27              
28             sub get_all_numbers {
29 203     203 1 268 my $self = shift;
30            
31 203         312 my @numbers = ();
32 203         263 foreach my $row (@{$self}) {
  203         345  
33 1818         1301 foreach my $number (@{$row}) {
  1818         2376  
34 4147 100       7743 push(@numbers, $number) if $number;
35             }
36             }
37 203         430 return @numbers;
38             }
39              
40             sub validate {
41 3     3 1 22 my ($self, $bingo) = @_;
42            
43 3         6 my $rv = 0;
44 3         6 my $trv = NUMBER_OF_NUMBERS_IN_CARD;
45            
46 3 100       10 if ($bingo->{game}) {
47 2         8 my @numbers = $self->get_all_numbers();
48            
49 2         6 foreach my $number (@numbers) {
50 30 100       60 ++$rv if $bingo->pulled($number);
51             }
52 2         6 $trv = NUMBER_OF_NUMBERS_IN_CARD;
53             } else {
54 1         37 warn "bingo game not defined?\n";
55             }
56            
57 3 100       11 if ($rv == $trv) {
58 1         4 $bingo->{game}--;
59 1         9 return 1;
60             } else {
61 2         17 return 0;
62             }
63             }
64              
65             sub _print_card {
66 1     1   7 my $self = shift;
67              
68 1         3 my $row = 0;
69 1         4 for (my $m = 0; $m < 7; $m++) {
70 7         10 my $column = 0;
71            
72 7 100       18 if ($m%2) {
73 3         12 for (my $n = 1; $n < 20; $n++) {
74 57 100       93 if ($n%2) {
75 30         621 print "|";
76             } else {
77 27 100       56 if ($self->[$column][$row]) {
78 15         319 printf("%2d",$self->[$column][$row]);
79             } else {
80 12         205 print " ";
81             }
82 27         84 ++$column;
83             }
84             }
85 3         6 $row++;
86             } else {
87 4         14 for (my $n = 1; $n < 20; $n++) {
88 76 100       127 if ($n%2) {
89 40         939 print "+";
90             } else {
91 36         718 print "--";
92             }
93             }
94             }
95 7         1038 print "\n";
96             }
97 1         15 return 1;
98             }
99              
100             sub _insert {
101 3012     3012   6305 my ($self, $row, $number) = @_;
102            
103 3012         4085 my $column = $self->_resolve_column($number);
104 3012         5080 $self->[$column]->[$row] = $number;
105              
106 3012         7586 return 1;
107             }
108              
109             sub _integrity_check {
110 201     201   247 my ($self) = @_;
111            
112 201         220 my $rv = NUMBER_OF_NUMBERS_IN_CARD;
113 201         240 foreach my $row (@{$self}) {
  201         349  
114 1809         1270 foreach my $cell (@{$row}) {
  1809         2297  
115 4120 100 66     13457 if ($cell and $cell =~ m/^\d+$/o) {
116 2490         3010 $rv--;
117             }
118             }
119             }
120 201 100       429 if ($rv != 0) {
121 193         516 return 0;
122             } else {
123 8         33 return 1;
124             }
125             }
126              
127             sub _resolve_column {
128 3102     3102   53002 my ($self, $number) = @_;
129            
130 3102         3072 my $result = ($number / 10);
131 3102         9571 my ($column) = $result =~ m/^(\d{1})$/o;
132            
133 3102 100       6794 if ($result < 1) { #ones go in column 0
    100          
134 340         352 $column = 0;
135             } elsif ($result == NUMBER_OF_COLUMNS_IN_CARD) { #9 go in column 8
136 30         34 $column = 8;
137             }
138 3102         6037 return $column;
139             }
140              
141             sub _init {
142 200     200   312 my ($self) = @_;
143            
144 200         229 my @numbers;
145 200         905 my $bingo = Games::Bingo->new();
146 200         574 $bingo->init(\@numbers, NUMBER_OF_NUMBERS);
147              
148             #Creating the numeric set to pick from
149 200         691 my $temp_collection = Games::Bingo::ColumnCollection->new();
150 200         749 $temp_collection->divide(NUMBER_OF_COLUMNS_IN_CARD, @numbers);
151            
152 200         474 my $final_collection = Games::Bingo::ColumnCollection->new();
153            
154             #Getting the first 9 numbers
155 200         495 for (my $i = 0; $i < NUMBER_OF_COLUMNS_IN_CARD; $i++) {
156 1800         3269 my $c = $temp_collection->get_column($i);
157 1800         3525 my $n = $c->get_random_number(1);
158              
159 1800         3598 my $fc = Games::Bingo::Column->new($i);
160 1800         3544 $fc->populate($n);
161            
162 1800         3532 $final_collection->add_column($fc);
163             }
164              
165             #Getting the 3 extras so we have 12 numbers
166 200         543 for (my $i = NUMBER_OF_NUMBERS_IN_CARD
167             - NUMBER_OF_COLUMNS_IN_CARD; $i > 0; $i--) {
168 1200         2504 my $tc = $temp_collection->get_random_column(1);
169 1200         2353 my $n = $tc->get_random_number(1);
170 1200         1273 my $label = $tc->{label};
171            
172 1200         2295 my $fc = $final_collection->get_column($label);
173            
174 1200         2322 $fc->populate($n);
175             }
176 200         1914 return $final_collection;
177             }
178              
179             sub populate {
180 6     6 1 37 my ($self) = @_;
181              
182 198         483 HACK:
183            
184             my $fcc = $self->_init();
185            
186 198         602 for (my $row = NUMBER_OF_ROWS_IN_CARD-1; $row >= 0; $row--) {
187 594         1415 my $tcc = Games::Bingo::ColumnCollection->new();
188              
189 594         1270 for (my $i = NUMBER_OF_NUMBERS_IN_ROW; $i > 0; $i--) {
190              
191 2970         6030 my $c = $fcc->get_random_column(1);
192 2970         5760 my $number = $c->get_highest_number(1);
193            
194 2970 100       5202 if ($c->count_numbers() > 0) {
195 1188         2146 $fcc->add_column($c);
196             } else {
197             #implicitly discarding empty columns
198             }
199 2970         4410 $self->_insert($row, $number);
200             }
201 594         955 foreach my $column (@${fcc}) {
202 2098         3500 $tcc->add_column($column);
203             }
204 594         1531 $fcc = $tcc;
205             }
206 198         478 my $amount = scalar $self->get_all_numbers();
207            
208 198 100       448 unless ($self->_integrity_check) {
209            
210 192         17634 warn "Incomplete trying again... ($amount)\n";
211            
212             #if the integrity check fails, meaning we don not have
213             #enough numbers to print a card we simply try again,
214             #please refer to the BUGS file or the B section below.
215            
216 192         838 $self = $self->_flush;
217            
218 192         769 goto HACK;
219             }
220 6         39 return $self;
221             }
222              
223             sub _flush {
224 193     193   272 my $self = shift;
225            
226 193         247 @{$self} = ();
  193         876  
227            
228 193         360 return $self;
229             }
230              
231             1;
232              
233             __END__