File Coverage

blib/lib/Games/Cards/Pair/Card.pm
Criterion Covered Total %
statement 32 32 100.0
branch 12 12 100.0
condition 20 24 83.3
subroutine 10 10 100.0
pod 2 3 66.6
total 76 81 93.8


line stmt bran cond sub pod time code
1             package Games::Cards::Pair::Card;
2              
3             $Games::Cards::Pair::Card::VERSION = '0.18';
4             $Games::Cards::Pair::Card::AUTHORITY = 'cpan:MANWAR';
5              
6             =head1 NAME
7              
8             Games::Cards::Pair::Card - Object representation of a card.
9              
10             =head1 VERSION
11              
12             Version 0.18
13              
14             =cut
15              
16 5     5   86 use 5.006;
  5         17  
17 5     5   26 use Data::Dumper;
  5         10  
  5         334  
18 5     5   30 use Types::Standard qw(Int);
  5         9  
  5         30  
19 5     5   3362 use Games::Cards::Pair::Params qw(Value Suit);
  5         9  
  5         27  
20              
21 5     5   2152 use Moo;
  5         10  
  5         38  
22 5     5   1999 use namespace::clean;
  5         9  
  5         39  
23              
24 5     5   1578 use overload ( '""' => \&as_string );
  5         10  
  5         35  
25              
26             has 'index' => (is => 'rw', isa => Int );
27             has 'suit' => (is => 'ro', isa => Suit);
28             has 'value' => (is => 'ro', isa => Value, required => 1);
29              
30             =head1 DESCRIPTION
31              
32             Only for internal use of Games::Cards::Pair class. Avoid using it directly.
33              
34             =cut
35              
36             sub BUILDARGS {
37 42     42 0 11777 my ($class, $args) = @_;
38              
39 42 100 100     194 if (defined($args->{'value'}) && ($args->{'value'} =~ /Joker/i)) {
40 7 100       24 die("Attribute (suit) is NOT required for Joker.") if defined $args->{'suit'};
41             }
42             else {
43 35 100       99 die("Attribute (suit) is required.") unless defined $args->{'suit'};
44             }
45              
46 39         628 return $args;
47             };
48              
49             =head1 METHODS
50              
51             =head2 equal()
52              
53             Returns 1 or 0 depending whether the two cards are same in value or one of them is a Joker.
54              
55             use strict; use warnings;
56             use Games::Cards::Pair::Card;
57              
58             my ($card1, $card2);
59             $card1 = Games::Cards::Pair::Card->new({ suit => 'Clubs', value => '2' });
60             $card2 = Games::Cards::Pair::Card->new({ suit => 'Diamonds', value => '2' });
61             print "Card are the same.\n" if $card1->equal($card2);
62              
63             $card2 = Games::Cards::Pair::Card->new({ value => 'Joker' });
64             print "Card are the same.\n" if $card1->equal($card2);
65              
66             =cut
67              
68             sub equal {
69 7     7 1 236 my ($self, $other) = @_;
70              
71 7 100 100     51 return 0 unless (defined($other) && (ref($other) eq 'Games::Cards::Pair::Card'));
72              
73             return 1
74             if ((defined($self->{value}) && ($self->{value} =~ /Joker/i))
75             ||
76             (defined($other->{value}) && ($other->{value} =~ /Joker/i))
77             ||
78 5 100 66     99 (defined($self->{value}) && (defined($other->{value}) && (lc($self->{value}) eq lc($other->{value})))));
      66        
      100        
      66        
      66        
      100        
79              
80 1         8 return 0;
81             }
82              
83             =head2 as_string()
84              
85             Returns the card object in readable format. This is overloaded as string context for printing.
86              
87             use strict; use warnings;
88             use Games::Cards::Pair::Card;
89              
90             my $card = Games::Cards::Pair::Card->new({ suit => 'Clubs', value => '2' });
91             print "Card: $card\n";
92             # or
93             print "Card: " . $card->as_string() . "\n";
94              
95             =cut
96              
97             sub as_string {
98 10     10 1 11 my ($self) = @_;
99              
100 10 100       34 return sprintf("%4s%s", $self->value, $self->suit) if defined $self->suit;
101              
102 1         5 return sprintf("%5s", $self->value);
103             }
104              
105             =head1 AUTHOR
106              
107             Mohammad S Anwar, C<< >>
108              
109             =head1 REPOSITORY
110              
111             L
112              
113             =head1 BUGS
114              
115             Please report any bugs / feature requests to C,or through
116             the web interface at L.I will
117             be notified, & then you'll automatically be notified of progress on your bug as I make changes.
118              
119             =head1 SUPPORT
120              
121             You can find documentation for this module with the perldoc command.
122              
123             perldoc Games::Cards::Pair::Card
124              
125             You can also look for information at:
126              
127             =over 4
128              
129             =item * RT: CPAN's request tracker (report bugs here)
130              
131             L
132              
133             =item * AnnoCPAN: Annotated CPAN documentation
134              
135             L
136              
137             =item * CPAN Ratings
138              
139             L
140              
141             =item * Search CPAN
142              
143             L
144              
145             =back
146              
147             =head1 LICENSE AND COPYRIGHT
148              
149             Copyright (C) 2012 - 2016 Mohammad S Anwar.
150              
151             This program is free software; you can redistribute it and / or modify it under
152             the terms of the the Artistic License (2.0). You may obtain a copy of the full
153             license at:
154              
155             L
156              
157             Any use, modification, and distribution of the Standard or Modified Versions is
158             governed by this Artistic License.By using, modifying or distributing the Package,
159             you accept this license. Do not use, modify, or distribute the Package, if you do
160             not accept this license.
161              
162             If your Modified Version has been derived from a Modified Version made by someone
163             other than you,you are nevertheless required to ensure that your Modified Version
164             complies with the requirements of this license.
165              
166             This license does not grant you the right to use any trademark, service mark,
167             tradename, or logo of the Copyright Holder.
168              
169             This license includes the non-exclusive, worldwide, free-of-charge patent license
170             to make, have made, use, offer to sell, sell, import and otherwise transfer the
171             Package with respect to any patent claims licensable by the Copyright Holder that
172             are necessarily infringed by the Package. If you institute patent litigation
173             (including a cross-claim or counterclaim) against any party alleging that the
174             Package constitutes direct or contributory patent infringement,then this Artistic
175             License to you shall terminate on the date that such litigation is filed.
176              
177             Disclaimer of Warranty: THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER AND
178             CONTRIBUTORS "AS IS' AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES. THE IMPLIED
179             WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE, OR
180             NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY YOUR LOCAL LAW. UNLESS
181             REQUIRED BY LAW, NO COPYRIGHT HOLDER OR CONTRIBUTOR WILL BE LIABLE FOR ANY DIRECT,
182             INDIRECT, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING IN ANY WAY OUT OF THE USE
183             OF THE PACKAGE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
184              
185             =cut
186              
187             1; # End of Games::Cards::Pair::Card