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.2403';
3 9     9   63 use warnings;
  9         21  
  9         298  
4 9     9   48 use strict;
  9         21  
  9         203  
5              
6              
7 9     9   42 use parent 'Games::Solitaire::Verify::Base';
  9         28  
  9         45  
8              
9 9     9   506 use Games::Solitaire::Verify::Exception ();
  9         19  
  9         160  
10 9     9   43 use Games::Solitaire::Verify::Card ();
  9         20  
  9         7894  
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   435 my $self = shift;
27 272         487 my $str = shift;
28              
29 272 50       1024 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         655 for my $pos ( 0 .. ( $self->count() - 1 ) )
37             {
38 932 100       4165 if ( $str =~ m{\G\z}cg )
    50          
39             {
40 131         495 last POS;
41             }
42             elsif ( $str =~ m{\G (..)}gms )
43             {
44 801         1712 my $card_s = $1;
45 801         1676 $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   597 my ( $self, $args ) = @_;
58              
59 286 50       746 if ( !exists( $args->{count} ) )
60             {
61 0         0 die "The count was not specified for the freecells";
62             }
63              
64 286         782 $self->_count( $args->{count} );
65              
66 286         1072 $self->_s( 'Freecells:' . ( ' ' x $self->_count ) );
67              
68 286         985 $self->_cells( [ (undef) x $self->_count() ] );
69              
70 286 100       729 if ( exists( $args->{string} ) )
71             {
72 272         607 return $self->_input_from_string( $args->{string} );
73             }
74              
75 14         32 return ();
76             }
77              
78             sub _parse_freecell_card
79             {
80 801     801   1555 my ( $self, $s ) = @_;
81              
82             return (
83 801 100       2792 ( $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 1282 my $self = shift;
97              
98 775         2716 return $self->_count();
99             }
100              
101              
102             sub cell
103             {
104 3856     3856 1 6654 my ( $self, $idx ) = @_;
105              
106 3856         10673 return $self->_cells()->[$idx];
107             }
108              
109              
110             sub assign
111             {
112 2236     2236 1 4216 my ( $self, $idx, $card ) = @_;
113              
114 2236         4731 $self->_cells()->[$idx] = $card;
115             substr(
116 2236 100       6921 $self->{_s}, length('Freecells:') + ( $idx << 2 ) + 2,
117             2, ( defined($card) ? $card->fast_s : ' ' )
118             );
119              
120 2236         5237 return ();
121             }
122              
123              
124             sub to_string
125             {
126 2226     2226 1 10570 ( my $r = $_[0]->{_s} ) =~ s# +\z##;
127 2226         5703 return $r;
128             }
129              
130              
131             sub cell_clone
132             {
133 26     26 1 44 my ( $self, $pos ) = @_;
134              
135 26         57 my $card = $self->cell($pos);
136              
137 26 100       71 return defined($card) ? $card->clone() : undef();
138             }
139              
140              
141             sub clear
142             {
143 578     578 1 1096 my ( $self, $pos ) = @_;
144              
145 578         1606 $self->assign( $pos, undef() );
146              
147 578         1168 return ();
148             }
149              
150              
151             sub clone
152             {
153 7     7 1 14 my $self = shift;
154              
155 7         21 my $copy = __PACKAGE__->new(
156             {
157             count => $self->count(),
158             }
159             );
160              
161 7         24 foreach my $pos ( 0 .. ( $self->count() - 1 ) )
162             {
163 26         66 $copy->assign( $pos, $self->cell_clone($pos) );
164             }
165              
166 7         24 return $copy;
167             }
168              
169              
170             sub num_empty
171             {
172 489     489 1 804 my $self = shift;
173              
174 489         834 my $count = 0;
175              
176 489         1159 foreach my $fc_idx ( 0 .. ( $self->count() - 1 ) )
177             {
178 1692 100       3075 if ( !defined( $self->cell($fc_idx) ) )
179             {
180 251         472 ++$count;
181             }
182             }
183 489         1764 return $count;
184             }
185              
186             1; # End of Games::Solitaire::Verify::Freecells
187              
188             __END__