File Coverage

blib/lib/Games/Solitaire/Verify/Column.pm
Criterion Covered Total %
statement 71 72 98.6
branch 5 6 83.3
condition n/a
subroutine 18 18 100.0
pod 10 10 100.0
total 104 106 98.1


line stmt bran cond sub pod time code
1             package Games::Solitaire::Verify::Column;
2             $Games::Solitaire::Verify::Column::VERSION = '0.2401';
3 10     10   70118 use warnings;
  10         29  
  10         361  
4 10     10   57 use strict;
  10         19  
  10         242  
5              
6              
7 10     10   512 use parent 'Games::Solitaire::Verify::Base';
  10         309  
  10         51  
8              
9 10     10   1052 use Games::Solitaire::Verify::Exception ();
  10         32  
  10         210  
10 10     10   547 use Games::Solitaire::Verify::Card ();
  10         20  
  10         7925  
11              
12             __PACKAGE__->mk_acc_ref(
13             [
14             qw(
15             _cards
16             _s
17             )
18             ]
19             );
20              
21              
22             sub _from_string
23             {
24 2237     2237   4085 my ( $self, $str ) = @_;
25              
26 2237 100       9804 if ( $str !~ s{\A:(?: )?}{} )
27             {
28 2         25 Games::Solitaire::Verify::Exception::Parse::Column::Prefix->throw(
29             error => "String does not start with \": \"", );
30             }
31              
32             # Ignore trailing whitespace, so we don't have -1.
33 2235         9901 my @cards = split( / +/, $str );
34              
35             $self->_cards(
36             [
37 2235         4801 map { Games::Solitaire::Verify::Card->new( { string => $_ } ) }
  10733         30624  
38             @cards
39             ]
40             );
41              
42 2235         6242 $self->_recalc;
43              
44 2235         5451 return;
45             }
46              
47             sub _init
48             {
49 2311     2311   4317 my ( $self, $args ) = @_;
50              
51 2311 100       4901 if ( exists( $args->{string} ) )
    50          
52             {
53 2237         4353 return $self->_from_string( $args->{string} );
54             }
55             elsif ( exists( $args->{cards} ) )
56             {
57 74         141 $self->_cards( $args->{cards} );
58              
59 74         165 $self->_recalc;
60 74         143 return;
61             }
62             else
63             {
64 0         0 die "Cannot init - no 'string' or 'cards' specified.";
65             }
66             }
67              
68              
69             sub len
70             {
71 9847     9847 1 14527 my $self = shift;
72              
73 9847         13463 return scalar( @{ $self->_cards() } );
  9847         28483  
74             }
75              
76              
77             sub pos
78             {
79 6014     6014 1 8762 my $self = shift;
80 6014         8364 my $idx = shift;
81              
82 6014         14755 return $self->_cards->[$idx];
83             }
84              
85              
86             sub top
87             {
88 3272     3272 1 5244 my $self = shift;
89              
90 3272         5773 return $self->pos(-1);
91             }
92              
93              
94             sub clone
95             {
96 58     58 1 88 my $self = shift;
97              
98             my $new_col = Games::Solitaire::Verify::Column->new(
99             {
100 58         91 cards => [ map { $_->clone() } @{ $self->_cards() } ],
  222         436  
  58         122  
101             }
102             );
103              
104 58         192 return $new_col;
105             }
106              
107              
108             sub append_cards
109             {
110 613     613 1 1128 my ( $S, $c ) = @_;
111 613         933 push @{ $S->_cards() }, @$c;
  613         1475  
112 613         1466 $S->_recalc;
113 613         1134 return;
114             }
115              
116              
117             sub append
118             {
119 1     1 1 20 my ( $self, $more_cards ) = @_;
120              
121 1         5 my $more_copy = $more_cards->clone();
122              
123 1         5 return $self->append_cards( $more_copy->_cards );
124             }
125              
126              
127             sub push
128             {
129 466     466 1 847 my ( $self, $card ) = @_;
130              
131 466         756 push @{ $self->_cards() }, $card;
  466         1047  
132              
133 466         1136 $self->_recalc;
134              
135 466         846 return;
136             }
137              
138              
139             sub pop
140             {
141 1508     1508 1 2389 my $self = shift;
142              
143 1508         2200 my $card = pop( @{ $self->_cards() } );
  1508         2864  
144              
145 1508         3857 $self->_recalc;
146              
147 1508         3559 return $card;
148             }
149              
150              
151             sub popN
152             {
153 612     612 1 1240 my ( $S, $c ) = @_;
154              
155 612         912 my @r = splice( @{ $S->_cards() }, -$c );
  612         1903  
156              
157 612         1625 $S->_recalc;
158              
159 612         1906 return \@r;
160             }
161              
162              
163             sub _recalc
164             {
165 5508     5508   8543 my $self = shift;
166              
167             $self->_s(
168 5508         8929 join( ' ', ':', ( map { $_->fast_s() } @{ $self->_cards() } ) ) );
  23191         43383  
  5508         11879  
169              
170 5508         11539 return;
171             }
172              
173             sub to_string
174             {
175 18170     18170 1 46043 return shift->_s;
176             }
177              
178             1; # End of Games::Solitaire::Verify::Column
179              
180             __END__