File Coverage

blib/lib/Games/Solitaire/Verify/Card.pm
Criterion Covered Total %
statement 78 78 100.0
branch 20 20 100.0
condition n/a
subroutine 21 21 100.0
pod 12 12 100.0
total 131 131 100.0


line stmt bran cond sub pod time code
1             package Games::Solitaire::Verify::Card;
2             $Games::Solitaire::Verify::Card::VERSION = '0.2402';
3 11     11   69677 use warnings;
  11         35  
  11         417  
4 11     11   73 use strict;
  11         24  
  11         254  
5              
6              
7 11     11   530 use parent 'Games::Solitaire::Verify::Base';
  11         329  
  11         71  
8              
9 11     11   1569 use Games::Solitaire::Verify::Exception ();
  11         26  
  11         12856  
10              
11             __PACKAGE__->mk_acc_ref(
12             [
13             qw(
14             _flipped
15             _s
16             data
17             id
18             rank
19             suit
20             _game
21             )
22             ]
23             );
24              
25              
26             sub _recalc
27             {
28 23230     23230   37214 my ($self) = @_;
29              
30 23230         37703 $self->_s( $self->to_string() );
31              
32 23230         38443 return;
33             }
34              
35             sub _card_num_normalize
36             {
37 143     143   208 my $arg = shift;
38              
39 143 100       297 if ( ref($arg) eq "" )
40             {
41 132         216 return +{ map { $_ => $arg } (qw(t non_t)) };
  264         629  
42             }
43             else
44             {
45 11         31 return $arg;
46             }
47             }
48              
49             my @card_nums = (
50             map { _card_num_normalize($_) } (
51             "A",
52             ( 2 .. 9 ),
53             {
54             't' => "T",
55             'non_t' => "10",
56             },
57             ,
58             "J", "Q", "K"
59             )
60             );
61              
62             my %ranks_map =
63             ( map { $card_nums[$_]->{t} => ( $_ + 1 ) } ( 0 .. $#card_nums ) );
64              
65             my @suits_map_proto = (
66             [ "H" => { name => "hearts", color => "red", }, ],
67             [ "C" => { name => "clubs", color => "black", }, ],
68             [ "D" => { name => "diamonds", color => "red", }, ],
69             [ "S" => { name => "spades", color => "black", }, ],
70             );
71              
72             my %suits_map = ( map { @$_ } @suits_map_proto );
73              
74              
75             sub get_suits_seq
76             {
77 24     24 1 57 my $class = shift;
78              
79 24         57 return [ map { $_->[0] } @suits_map_proto ];
  96         257  
80             }
81              
82              
83             sub calc_rank
84             {
85 12159     12159 1 20931 my ( $self, $s ) = @_;
86              
87 12159         33981 return $ranks_map{$s};
88             }
89              
90              
91             sub calc_rank_with_0
92             {
93 1096     1096 1 2066 my ( $self, $str ) = @_;
94              
95 1096 100       2171 if ( $str eq "0" )
96             {
97 438         1241 return 0;
98             }
99             else
100             {
101 658         1292 return $self->calc_rank($str);
102             }
103             }
104              
105             sub _from_string
106             {
107 11502     11502   19128 my ( $self, $str ) = @_;
108              
109 11502         16007 my $is_flipped = 0;
110              
111 11502 100       24535 if ( $str =~ s{\A<(.*)>\z}{$1}ms )
112             {
113 1         3 $is_flipped = 1;
114             }
115              
116 11502 100       21016 if ( length($str) != 2 )
117             {
118 1         22 Games::Solitaire::Verify::Exception::Parse::Card->throw(
119             error => "string length is too long", );
120             }
121              
122 11501         29471 my ( $rank, $suit ) = split( //, $str );
123              
124 11501 100       23857 if ( !defined( $self->rank( $self->calc_rank($rank) ) ) )
125             {
126 1         12 Games::Solitaire::Verify::Exception::Parse::Card::UnknownRank->throw(
127             error => "unknown rank", );
128             }
129              
130 11500 100       22548 if ( exists( $suits_map{$suit} ) )
131             {
132 11499         21006 $self->suit($suit);
133             }
134             else
135             {
136 1         11 Games::Solitaire::Verify::Exception::Parse::Card::UnknownSuit->throw(
137             error => "unknown suit", );
138             }
139              
140 11499         24597 $self->set_flipped($is_flipped);
141              
142 11499         16968 return;
143             }
144              
145             sub _init
146             {
147 11733     11733   20197 my ( $self, $args ) = @_;
148              
149 11733 100       22433 if ( exists( $args->{string} ) )
150             {
151 11502         24720 $self->_from_string( $args->{string} );
152 11499         18507 $self->_recalc();
153             }
154              
155 11730 100       22678 if ( exists( $args->{id} ) )
156             {
157 8         20 $self->id( $args->{id} );
158             }
159              
160 11730 100       20406 if ( exists( $args->{data} ) )
161             {
162 7         16 $self->data( $args->{data} );
163             }
164              
165 11730         21443 return;
166             }
167              
168              
169             sub color
170             {
171 1965     1965 1 11175 my ($self) = @_;
172              
173 1965         4007 return $self->color_for_suit( $self->suit() );
174             }
175              
176              
177             sub color_for_suit
178             {
179 1969     1969 1 3530 my ( $self, $suit ) = @_;
180              
181 1969         4734 return $suits_map{$suit}->{'color'};
182             }
183              
184              
185             sub clone
186             {
187 231     231 1 1959 my $self = shift;
188              
189 231         463 my $new_card = Games::Solitaire::Verify::Card->new();
190              
191 231         472 $new_card->data( $self->data() );
192 231         420 $new_card->id( $self->id() );
193 231         446 $new_card->suit( $self->suit() );
194 231         389 $new_card->rank( $self->rank() );
195              
196 231         481 $new_card->_recalc();
197              
198 231         567 return $new_card;
199             }
200              
201              
202             sub _to_string_without_flipped
203             {
204 23865     23865   33611 my $self = shift;
205              
206 23865         42447 return $self->rank_to_string( $self->rank() ) . $self->suit();
207             }
208              
209             sub to_string
210             {
211 23865     23865 1 34634 my $self = shift;
212              
213 23865         36640 my $s = $self->_to_string_without_flipped();
214              
215 23865 100       41508 return ( $self->is_flipped ? "<$s>" : $s );
216             }
217              
218              
219             sub fast_s
220             {
221 27106     27106 1 69298 return shift->_s;
222             }
223              
224              
225             {
226             my @_t_nums = ( '0', ( map { $_->{t} } @card_nums ) );
227              
228             sub get_ranks_strings
229             {
230 8     8 1 42 return \@_t_nums;
231             }
232              
233             sub rank_to_string
234             {
235 23865     23865 1 38183 my ( $class, $rank ) = @_;
236              
237 23865         63597 return $_t_nums[$rank];
238             }
239              
240             }
241              
242              
243             sub is_flipped
244             {
245 23866     23866 1 62621 return shift->_flipped();
246             }
247              
248              
249             sub set_flipped
250             {
251 11500     11500 1 18473 my ( $self, $v ) = @_;
252              
253 11500         19202 $self->_flipped($v);
254              
255 11500         24284 $self->_recalc();
256              
257 11500         16099 return;
258             }
259              
260             1; # End of Games::Solitaire::Verify::Card
261              
262             __END__