File Coverage

blib/lib/Games/Solitaire/Verify/Freecells.pm
Criterion Covered Total %
statement 60 63 95.2
branch 15 18 83.3
condition n/a
subroutine 16 16 100.0
pod 8 8 100.0
total 99 105 94.2


line stmt bran cond sub pod time code
1             package Games::Solitaire::Verify::Freecells;
2             $Games::Solitaire::Verify::Freecells::VERSION = '0.2402';
3 9     9   64 use warnings;
  9         38  
  9         302  
4 9     9   48 use strict;
  9         20  
  9         201  
5              
6              
7 9     9   44 use parent 'Games::Solitaire::Verify::Base';
  9         25  
  9         47  
8              
9 9     9   502 use Games::Solitaire::Verify::Exception ();
  9         19  
  9         151  
10 9     9   47 use Games::Solitaire::Verify::Card ();
  9         16  
  9         7702  
11              
12             # _s is the string.
13             __PACKAGE__->mk_acc_ref(
14             [
15             qw(
16             _count
17             _cells
18             _s
19             )
20             ]
21             );
22              
23              
24             sub _input_from_string
25             {
26 272     272   460 my $self = shift;
27 272         462 my $str = shift;
28              
29 272 50       1001 if ( $str !~ m{\AFreecells:}gms )
30             {
31 0         0 Games::Solitaire::Verify::Exception::Parse::State::Freecells->throw(
32             error => "Wrong Freecell String", );
33             }
34              
35             POS:
36 272         756 for my $pos ( 0 .. ( $self->count() - 1 ) )
37             {
38 932 100       4174 if ( $str =~ m{\G\z}cg )
    50          
39             {
40 131         489 last POS;
41             }
42             elsif ( $str =~ m{\G (..)}gms )
43             {
44 801         1812 my $card_s = $1;
45 801         1593 $self->assign( $pos, $self->_parse_freecell_card($card_s) );
46             }
47             else
48             {
49 0         0 Games::Solitaire::Verify::Exception::Parse::State::Freecells
50             ->throw( error => "Wrong Freecell String", );
51             }
52             }
53             }
54              
55             sub _init
56             {
57 286     286   606 my ( $self, $args ) = @_;
58              
59 286 50       702 if ( !exists( $args->{count} ) )
60             {
61 0         0 die "The count was not specified for the freecells";
62             }
63              
64 286         726 $self->_count( $args->{count} );
65              
66 286         1041 $self->_s( 'Freecells:' . ( ' ' x $self->_count ) );
67              
68 286         907 $self->_cells( [ (undef) x $self->_count() ] );
69              
70 286 100       729 if ( exists( $args->{string} ) )
71             {
72 272         595 return $self->_input_from_string( $args->{string} );
73             }
74              
75 14         36 return;
76             }
77              
78             sub _parse_freecell_card
79             {
80 801     801   1558 my ( $self, $s ) = @_;
81              
82             return (
83 801 100       2812 ( $s eq q{ } )
84             ? undef()
85             : Games::Solitaire::Verify::Card->new(
86             {
87             string => $s,
88             }
89             )
90             );
91             }
92              
93              
94             sub count
95             {
96 775     775 1 1340 my $self = shift;
97              
98 775         2715 return $self->_count();
99             }
100              
101              
102             sub cell
103             {
104 3856     3856 1 6695 my ( $self, $idx ) = @_;
105              
106 3856         10665 return $self->_cells()->[$idx];
107             }
108              
109              
110             sub assign
111             {
112 2236     2236 1 4320 my ( $self, $idx, $card ) = @_;
113              
114 2236         4733 $self->_cells()->[$idx] = $card;
115             substr(
116 2236 100       7235 $self->{_s}, length('Freecells:') + ( $idx << 2 ) + 2,
117             2, ( defined($card) ? $card->fast_s : ' ' )
118             );
119              
120 2236         5269 return;
121             }
122              
123              
124             sub to_string
125             {
126 2226     2226 1 10392 ( my $r = $_[0]->{_s} ) =~ s# +\z##;
127 2226         5819 return $r;
128             }
129              
130              
131             sub cell_clone
132             {
133 26     26 1 60 my ( $self, $pos ) = @_;
134              
135 26         49 my $card = $self->cell($pos);
136              
137 26 100       67 return defined($card) ? $card->clone() : undef();
138             }
139              
140              
141             sub clear
142             {
143 578     578 1 1115 my ( $self, $pos ) = @_;
144              
145 578         1523 $self->assign( $pos, undef() );
146              
147 578         1160 return;
148             }
149              
150              
151             sub clone
152             {
153 7     7 1 12 my $self = shift;
154              
155 7         24 my $copy = __PACKAGE__->new(
156             {
157             count => $self->count(),
158             }
159             );
160              
161 7         21 foreach my $pos ( 0 .. ( $self->count() - 1 ) )
162             {
163 26         51 $copy->assign( $pos, $self->cell_clone($pos) );
164             }
165              
166 7         26 return $copy;
167             }
168              
169              
170             sub num_empty
171             {
172 489     489 1 834 my $self = shift;
173              
174 489         751 my $count = 0;
175              
176 489         1089 foreach my $fc_idx ( 0 .. ( $self->count() - 1 ) )
177             {
178 1692 100       3093 if ( !defined( $self->cell($fc_idx) ) )
179             {
180 251         483 ++$count;
181             }
182             }
183 489         1668 return $count;
184             }
185              
186             1; # End of Games::Solitaire::Verify::Freecells
187              
188             __END__