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.2401';
3 11     11   69833 use warnings;
  11         36  
  11         387  
4 11     11   71 use strict;
  11         21  
  11         245  
5              
6              
7 11     11   558 use parent 'Games::Solitaire::Verify::Base';
  11         320  
  11         60  
8              
9 11     11   1554 use Games::Solitaire::Verify::Exception ();
  11         26  
  11         12740  
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   35980 my ($self) = @_;
29              
30 23230         39008 $self->_s( $self->to_string() );
31              
32 23230         37963 return;
33             }
34              
35             sub _card_num_normalize
36             {
37 143     143   213 my $arg = shift;
38              
39 143 100       293 if ( ref($arg) eq "" )
40             {
41 132         209 return +{ map { $_ => $arg } (qw(t non_t)) };
  264         681  
42             }
43             else
44             {
45 11         30 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 53 my $class = shift;
78              
79 24         58 return [ map { $_->[0] } @suits_map_proto ];
  96         255  
80             }
81              
82              
83             sub calc_rank
84             {
85 12159     12159 1 20786 my ( $self, $s ) = @_;
86              
87 12159         34209 return $ranks_map{$s};
88             }
89              
90              
91             sub calc_rank_with_0
92             {
93 1096     1096 1 2048 my ( $self, $str ) = @_;
94              
95 1096 100       2077 if ( $str eq "0" )
96             {
97 438         1161 return 0;
98             }
99             else
100             {
101 658         1331 return $self->calc_rank($str);
102             }
103             }
104              
105             sub _from_string
106             {
107 11502     11502   18650 my ( $self, $str ) = @_;
108              
109 11502         16276 my $is_flipped = 0;
110              
111 11502 100       25482 if ( $str =~ s{\A<(.*)>\z}{$1}ms )
112             {
113 1         3 $is_flipped = 1;
114             }
115              
116 11502 100       21297 if ( length($str) != 2 )
117             {
118 1         19 Games::Solitaire::Verify::Exception::Parse::Card->throw(
119             error => "string length is too long", );
120             }
121              
122 11501         28862 my ( $rank, $suit ) = split( //, $str );
123              
124 11501 100       24463 if ( !defined( $self->rank( $self->calc_rank($rank) ) ) )
125             {
126 1         13 Games::Solitaire::Verify::Exception::Parse::Card::UnknownRank->throw(
127             error => "unknown rank", );
128             }
129              
130 11500 100       22540 if ( exists( $suits_map{$suit} ) )
131             {
132 11499         20932 $self->suit($suit);
133             }
134             else
135             {
136 1         12 Games::Solitaire::Verify::Exception::Parse::Card::UnknownSuit->throw(
137             error => "unknown suit", );
138             }
139              
140 11499         24273 $self->set_flipped($is_flipped);
141              
142 11499         16861 return;
143             }
144              
145             sub _init
146             {
147 11733     11733   19838 my ( $self, $args ) = @_;
148              
149 11733 100       22523 if ( exists( $args->{string} ) )
150             {
151 11502         26140 $self->_from_string( $args->{string} );
152 11499         19049 $self->_recalc();
153             }
154              
155 11730 100       22915 if ( exists( $args->{id} ) )
156             {
157 8         19 $self->id( $args->{id} );
158             }
159              
160 11730 100       20963 if ( exists( $args->{data} ) )
161             {
162 7         13 $self->data( $args->{data} );
163             }
164              
165 11730         21592 return;
166             }
167              
168              
169             sub color
170             {
171 1965     1965 1 10701 my ($self) = @_;
172              
173 1965         3957 return $self->color_for_suit( $self->suit() );
174             }
175              
176              
177             sub color_for_suit
178             {
179 1969     1969 1 3410 my ( $self, $suit ) = @_;
180              
181 1969         4857 return $suits_map{$suit}->{'color'};
182             }
183              
184              
185             sub clone
186             {
187 231     231 1 1942 my $self = shift;
188              
189 231         467 my $new_card = Games::Solitaire::Verify::Card->new();
190              
191 231         508 $new_card->data( $self->data() );
192 231         404 $new_card->id( $self->id() );
193 231         430 $new_card->suit( $self->suit() );
194 231         403 $new_card->rank( $self->rank() );
195              
196 231         467 $new_card->_recalc();
197              
198 231         573 return $new_card;
199             }
200              
201              
202             sub _to_string_without_flipped
203             {
204 23865     23865   31930 my $self = shift;
205              
206 23865         42440 return $self->rank_to_string( $self->rank() ) . $self->suit();
207             }
208              
209             sub to_string
210             {
211 23865     23865 1 33581 my $self = shift;
212              
213 23865         37202 my $s = $self->_to_string_without_flipped();
214              
215 23865 100       41543 return ( $self->is_flipped ? "<$s>" : $s );
216             }
217              
218              
219             sub fast_s
220             {
221 27106     27106 1 67261 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 38 return \@_t_nums;
231             }
232              
233             sub rank_to_string
234             {
235 23865     23865 1 38292 my ( $class, $rank ) = @_;
236              
237 23865         63211 return $_t_nums[$rank];
238             }
239              
240             }
241              
242              
243             sub is_flipped
244             {
245 23866     23866 1 62828 return shift->_flipped();
246             }
247              
248              
249             sub set_flipped
250             {
251 11500     11500 1 18646 my ( $self, $v ) = @_;
252              
253 11500         18636 $self->_flipped($v);
254              
255 11500         24886 $self->_recalc();
256              
257 11500         17032 return;
258             }
259              
260             1; # End of Games::Solitaire::Verify::Card
261              
262             __END__