File Coverage

blib/lib/Acme/Mitey/Cards/Card/Numeric.pm.mite.pm
Criterion Covered Total %
statement 74 90 82.2
branch 26 60 43.3
condition 8 24 33.3
subroutine 9 11 81.8
pod 0 3 0.0
total 117 188 62.2


line stmt bran cond sub pod time code
1             {
2              
3             package Acme::Mitey::Cards::Card::Numeric;
4 3     3   17 use strict;
  3         3  
  3         72  
5 3     3   14 use warnings;
  3         4  
  3         438  
6              
7             our $USES_MITE = "Mite::Class";
8             our $MITE_SHIM = "Acme::Mitey::Cards::Mite";
9             our $MITE_VERSION = "0.007003";
10              
11             BEGIN {
12 3     3   17 require Scalar::Util;
13 3         9 *bare = \&Acme::Mitey::Cards::Mite::bare;
14 3         7 *blessed = \&Scalar::Util::blessed;
15 3         4 *carp = \&Acme::Mitey::Cards::Mite::carp;
16 3         6 *confess = \&Acme::Mitey::Cards::Mite::confess;
17 3         4 *croak = \&Acme::Mitey::Cards::Mite::croak;
18 3         5 *false = \&Acme::Mitey::Cards::Mite::false;
19 3         4 *guard = \&Acme::Mitey::Cards::Mite::guard;
20 3         5 *lazy = \&Acme::Mitey::Cards::Mite::lazy;
21 3         5 *ro = \&Acme::Mitey::Cards::Mite::ro;
22 3         3 *rw = \&Acme::Mitey::Cards::Mite::rw;
23 3         11 *rwp = \&Acme::Mitey::Cards::Mite::rwp;
24 3         103 *true = \&Acme::Mitey::Cards::Mite::true;
25             }
26              
27             BEGIN {
28 3     3   845 require Acme::Mitey::Cards::Card;
29              
30 3     3   17 use mro 'c3';
  3         6  
  3         16  
31 3         8 our @ISA;
32 3         313 push @ISA, "Acme::Mitey::Cards::Card";
33             }
34              
35             sub new {
36 42 50   42 0 142 my $class = ref( $_[0] ) ? ref(shift) : shift;
37 42   66     94 my $meta = ( $Mite::META{$class} ||= $class->__META__ );
38 42         72 my $self = bless {}, $class;
39             my $args =
40             $meta->{HAS_BUILDARGS}
41             ? $class->BUILDARGS(@_)
42 42 50       125 : { ( @_ == 1 ) ? %{ $_[0] } : @_ };
  0 50       0  
43 42         68 my $no_build = delete $args->{__no_BUILD__};
44              
45             # Attribute: deck
46 42 100       68 if ( exists $args->{"deck"} ) {
47             (
48 40 50       44 do {
49 3     3   20 use Scalar::Util ();
  3         6  
  3         491  
50             Scalar::Util::blessed( $args->{"deck"} )
51 40 50       181 and $args->{"deck"}->isa(q[Acme::Mitey::Cards::Deck]);
52             }
53             )
54             or croak "Type check failed in constructor: %s should be %s",
55             "deck", "Deck";
56 40         81 $self->{"deck"} = $args->{"deck"};
57             }
58             require Scalar::Util && Scalar::Util::weaken( $self->{"deck"} )
59 42 100 33     256 if exists $self->{"deck"};
60              
61             # Attribute: reverse
62 42 100       93 if ( exists $args->{"reverse"} ) {
63 2 50       4 do {
64              
65             package Acme::Mitey::Cards::Mite;
66 2 50       3 defined( $args->{"reverse"} ) and do {
67             ref( \$args->{"reverse"} ) eq 'SCALAR'
68 2 50       22 or ref( \( my $val = $args->{"reverse"} ) ) eq 'SCALAR';
69             }
70             }
71             or croak "Type check failed in constructor: %s should be %s",
72             "reverse", "Str";
73 2         5 $self->{"reverse"} = $args->{"reverse"};
74             }
75              
76             # Attribute: suit
77 42 50       66 croak "Missing key in constructor: suit" unless exists $args->{"suit"};
78 42         45 do {
79 42         86 my $coerced_value = do {
80 42         52 my $to_coerce = $args->{"suit"};
81             (
82             (
83             do {
84 3     3   18 use Scalar::Util ();
  3         7  
  3         284  
85 42 50       188 Scalar::Util::blessed($to_coerce)
86             and $to_coerce->isa(q[Acme::Mitey::Cards::Suit]);
87             }
88             )
89             ) ? $to_coerce : (
90             do {
91              
92             package Acme::Mitey::Cards::Mite;
93 0 0       0 defined($to_coerce) and do {
94 0 0       0 ref( \$to_coerce ) eq 'SCALAR'
95             or ref( \( my $val = $to_coerce ) ) eq 'SCALAR';
96             }
97             }
98             )
99             ? scalar(
100 42 0       48 do {
    50          
101 0         0 local $_ = $to_coerce;
102 0         0 do {
103 0         0 my $method = lc($_);
104 0         0 'Acme::Mitey::Cards::Suit'->$method;
105             }
106             }
107             )
108             : $to_coerce;
109             };
110             (
111 42 50       55 do {
112 3     3   19 use Scalar::Util ();
  3         5  
  3         2298  
113 42 50       162 Scalar::Util::blessed($coerced_value)
114             and $coerced_value->isa(q[Acme::Mitey::Cards::Suit]);
115             }
116             )
117             or croak "Type check failed in constructor: %s should be %s",
118             "suit", "Suit";
119 42         80 $self->{"suit"} = $coerced_value;
120             };
121              
122             # Attribute: number
123             croak "Missing key in constructor: number"
124 42 50       64 unless exists $args->{"number"};
125 42         47 do {
126 42         48 my $coerced_value = do {
127 42         68 my $to_coerce = $args->{"number"};
128             (
129             (
130             do {
131              
132             package Acme::Mitey::Cards::Mite;
133             (
134             do {
135             my $tmp = $to_coerce;
136             defined($tmp)
137             and !ref($tmp)
138             and $tmp =~ /\A-?[0-9]+\z/;
139             }
140             );
141             }
142             && ( $to_coerce >= 1 )
143             && ( $to_coerce <= 10 )
144             )
145             ) ? $to_coerce : (
146             do {
147              
148             package Acme::Mitey::Cards::Mite;
149 0 0 0     0 ( defined($to_coerce)
150             and !ref($to_coerce)
151             and $to_coerce =~ m{\A(?:[Aa])\z} );
152             }
153 42 0 33     45 ) ? scalar( do { local $_ = $to_coerce; 1 } ) : $to_coerce;
  0 50       0  
  0         0  
154             };
155             (
156 42 50 33     62 do {
      33        
157              
158             package Acme::Mitey::Cards::Mite;
159             (
160 42         49 do {
161 42         44 my $tmp = $coerced_value;
162 42 50 33     272 defined($tmp)
163             and !ref($tmp)
164             and $tmp =~ /\A-?[0-9]+\z/;
165             }
166             );
167             }
168             && ( $coerced_value >= 1 )
169             && ( $coerced_value <= 10 )
170             )
171             or croak "Type check failed in constructor: %s should be %s",
172             "number", "CardNumber";
173 42         87 $self->{"number"} = $coerced_value;
174             };
175              
176             # Enforce strict constructor
177             my @unknown = grep not(/\A(?:deck|number|reverse|suit)\z/),
178 42         61 keys %{$args};
  42         210  
179             @unknown
180 42 50       83 and croak(
181             "Unexpected keys in constructor: " . join( q[, ], sort @unknown ) );
182              
183             # Call BUILD methods
184 42 50 33     66 $self->BUILDALL($args) if ( !$no_build and @{ $meta->{BUILD} || [] } );
  42 50       114  
185              
186 42         129 return $self;
187             }
188              
189             sub DOES {
190 0     0 0   my ( $self, $role ) = @_;
191 0           our %DOES;
192 0 0         return $DOES{$role} if exists $DOES{$role};
193 0 0         return 1 if $role eq __PACKAGE__;
194 0           return $self->SUPER::DOES($role);
195             }
196              
197             sub does {
198 0     0 0   shift->DOES(@_);
199             }
200              
201             my $__XS = !$ENV{MITE_PURE_PERL}
202             && eval { require Class::XSAccessor; Class::XSAccessor->VERSION("1.19") };
203              
204             # Accessors for number
205             if ($__XS) {
206             Class::XSAccessor->import(
207             chained => 1,
208             "getters" => { "number" => "number" },
209             );
210             }
211             else {
212             *number = sub {
213             @_ > 1
214             ? croak("number is a read-only attribute of @{[ref $_[0]]}")
215             : $_[0]{"number"};
216             };
217             }
218              
219             # Accessors for suit
220             if ($__XS) {
221             Class::XSAccessor->import(
222             chained => 1,
223             "getters" => { "suit" => "suit" },
224             );
225             }
226             else {
227             *suit = sub {
228             @_ > 1
229             ? croak("suit is a read-only attribute of @{[ref $_[0]]}")
230             : $_[0]{"suit"};
231             };
232             }
233              
234             our %SIGNATURE_FOR;
235              
236             $SIGNATURE_FOR{"number_or_a"} = sub {
237             my $__NEXT__ = shift;
238              
239             my ( %tmp, $tmp, @head );
240              
241             @_ == 1
242             or croak(
243             "Wrong number of parameters in signature for %s: %s, got %d",
244             "number_or_a", "expected exactly 1 parameters",
245             scalar(@_)
246             );
247              
248             @head = splice( @_, 0, 1 );
249              
250             # Parameter $head[0] (type: Defined)
251             ( defined( $head[0] ) )
252             or croak(
253             "Type check failed in signature for number_or_a: %s should be %s",
254             "\$_[0]", "Defined" );
255              
256             return ( &$__NEXT__( @head, @_ ) );
257             };
258              
259             $SIGNATURE_FOR{"to_string"} =
260             $Acme::Mitey::Cards::Card::SIGNATURE_FOR{"to_string"};
261              
262             1;
263             }