File Coverage

blib/lib/Acme/Mitey/Cards/Deck.pm.mite.pm
Criterion Covered Total %
statement 85 117 72.6
branch 18 52 34.6
condition 3 15 20.0
subroutine 20 29 68.9
pod 0 4 0.0
total 126 217 58.0


line stmt bran cond sub pod time code
1             {
2              
3             package Acme::Mitey::Cards::Deck;
4 2     2   12 use strict;
  2         7  
  2         50  
5 2     2   9 use warnings;
  2         4  
  2         44  
6 2     2   8 no warnings qw( once void );
  2         3  
  2         219  
7              
8             our $USES_MITE = "Mite::Class";
9             our $MITE_SHIM = "Acme::Mitey::Cards::Mite";
10             our $MITE_VERSION = "0.010002";
11              
12             # Mite keywords
13             BEGIN {
14 2     2   8 my ( $SHIM, $CALLER ) =
15             ( "Acme::Mitey::Cards::Mite", "Acme::Mitey::Cards::Deck" );
16             (
17             *after, *around, *before, *extends, *field,
18             *has, *param, *signature_for, *with
19             )
20 2         3 = do {
21              
22             package Acme::Mitey::Cards::Mite;
23 2     2   11 no warnings 'redefine';
  2         4  
  2         384  
24             (
25 0     0   0 sub { $SHIM->HANDLE_after( $CALLER, "class", @_ ) },
26 0     0   0 sub { $SHIM->HANDLE_around( $CALLER, "class", @_ ) },
27 0     0   0 sub { $SHIM->HANDLE_before( $CALLER, "class", @_ ) },
28       2     sub { },
29 0     0   0 sub { $SHIM->HANDLE_has( $CALLER, field => @_ ) },
30 4     4   14 sub { $SHIM->HANDLE_has( $CALLER, has => @_ ) },
31 0     0   0 sub { $SHIM->HANDLE_has( $CALLER, param => @_ ) },
32 4     4   12 sub { $SHIM->HANDLE_signature_for( $CALLER, "class", @_ ) },
33 0     0   0 sub { $SHIM->HANDLE_with( $CALLER, @_ ) },
34 2         321 );
35             };
36             }
37              
38             # Mite imports
39             BEGIN {
40 2     2   12 require Scalar::Util;
41 2         6 *STRICT = \&Acme::Mitey::Cards::Mite::STRICT;
42 2         3 *bare = \&Acme::Mitey::Cards::Mite::bare;
43 2         3 *blessed = \&Scalar::Util::blessed;
44 2         2 *carp = \&Acme::Mitey::Cards::Mite::carp;
45 2         4 *confess = \&Acme::Mitey::Cards::Mite::confess;
46 2         2 *croak = \&Acme::Mitey::Cards::Mite::croak;
47 2         3 *false = \&Acme::Mitey::Cards::Mite::false;
48 2         3 *guard = \&Acme::Mitey::Cards::Mite::guard;
49 2         3 *lazy = \&Acme::Mitey::Cards::Mite::lazy;
50 2         3 *ro = \&Acme::Mitey::Cards::Mite::ro;
51 2         3 *rw = \&Acme::Mitey::Cards::Mite::rw;
52 2         2 *rwp = \&Acme::Mitey::Cards::Mite::rwp;
53 2         87 *true = \&Acme::Mitey::Cards::Mite::true;
54             }
55              
56             BEGIN {
57 2     2   451 require Acme::Mitey::Cards::Set;
58              
59 2     2   18 use mro 'c3';
  2         4  
  2         9  
60 2         4 our @ISA;
61 2         304 push @ISA, "Acme::Mitey::Cards::Set";
62             }
63              
64             # Standard Moose/Moo-style constructor
65             sub new {
66 1 50   1 0 464 my $class = ref( $_[0] ) ? ref(shift) : shift;
67 1   33     9 my $meta = ( $Mite::META{$class} ||= $class->__META__ );
68 1         3 my $self = bless {}, $class;
69             my $args =
70             $meta->{HAS_BUILDARGS}
71             ? $class->BUILDARGS(@_)
72 1 50       5 : { ( @_ == 1 ) ? %{ $_[0] } : @_ };
  0 50       0  
73 1         2 my $no_build = delete $args->{__no_BUILD__};
74              
75             # Attribute cards (type: CardArray)
76             # has declaration, file lib/Acme/Mitey/Cards/Set.pm, line 11
77 1 50       3 if ( exists $args->{"cards"} ) {
78             (
79             do {
80              
81             package Acme::Mitey::Cards::Mite;
82 0         0 ref( $args->{"cards"} ) eq 'ARRAY';
83             }
84 0 0 0     0 and do {
85 0         0 my $ok = 1;
86 0         0 for my $i ( @{ $args->{"cards"} } ) {
  0         0  
87             ( $ok = 0, last )
88             unless (
89 0 0       0 do {
90 2     2   12 use Scalar::Util ();
  2         4  
  2         340  
91 0 0       0 Scalar::Util::blessed($i)
92             and $i->isa(q[Acme::Mitey::Cards::Card]);
93             }
94             );
95             };
96 0         0 $ok;
97             }
98             )
99             or croak "Type check failed in constructor: %s should be %s",
100             "cards", "CardArray";
101 0         0 $self->{"cards"} = $args->{"cards"};
102             }
103              
104             # Attribute reverse (type: NonEmptyStr)
105             # has declaration, file lib/Acme/Mitey/Cards/Deck.pm, line 17
106 1         10 do {
107             my $value =
108 1 50       9 exists( $args->{"reverse"} ) ? $args->{"reverse"} : "plain";
109             (
110             (
111 1 50 33     2 do {
112              
113             package Acme::Mitey::Cards::Mite;
114 1 50       3 defined($value) and do {
115 1 50       8 ref( \$value ) eq 'SCALAR'
116             or ref( \( my $val = $value ) ) eq 'SCALAR';
117             }
118             }
119             )
120             && ( length($value) > 0 )
121             )
122             or croak "Type check failed in constructor: %s should be %s",
123             "reverse", "NonEmptyStr";
124 1         6 $self->{"reverse"} = $value;
125             };
126              
127             # Attribute original_cards (type: CardArray)
128             # has declaration, file lib/Acme/Mitey/Cards/Deck.pm, line 23
129 1 50       3 if ( exists $args->{"original_cards"} ) {
130             (
131             do {
132              
133             package Acme::Mitey::Cards::Mite;
134 0         0 ref( $args->{"original_cards"} ) eq 'ARRAY';
135             }
136 0 0 0     0 and do {
137 0         0 my $ok = 1;
138 0         0 for my $i ( @{ $args->{"original_cards"} } ) {
  0         0  
139             ( $ok = 0, last )
140             unless (
141 0 0       0 do {
142 2     2   11 use Scalar::Util ();
  2         3  
  2         575  
143 0 0       0 Scalar::Util::blessed($i)
144             and $i->isa(q[Acme::Mitey::Cards::Card]);
145             }
146             );
147             };
148 0         0 $ok;
149             }
150             )
151             or croak "Type check failed in constructor: %s should be %s",
152             "original_cards", "CardArray";
153 0         0 $self->{"original_cards"} = $args->{"original_cards"};
154             }
155              
156             # Call BUILD methods
157 1 50 33     3 $self->BUILDALL($args) if ( !$no_build and @{ $meta->{BUILD} || [] } );
  1 50       4  
158              
159             # Unrecognized parameters
160             my @unknown = grep not(/\A(?:cards|original_cards|reverse)\z/),
161 1         1 keys %{$args};
  1         3  
162             @unknown
163 1 50       2 and croak(
164             "Unexpected keys in constructor: " . join( q[, ], sort @unknown ) );
165              
166 1         4 return $self;
167             }
168              
169             my $__XS = !$ENV{MITE_PURE_PERL}
170             && eval { require Class::XSAccessor; Class::XSAccessor->VERSION("1.19") };
171              
172             # Accessors for original_cards
173             # has declaration, file lib/Acme/Mitey/Cards/Deck.pm, line 23
174             sub original_cards {
175 1 50   1 0 2 @_ == 1
176             or croak('Reader "original_cards" usage: $self->original_cards()');
177             (
178             exists( $_[0]{"original_cards"} ) ? $_[0]{"original_cards"} : (
179 1 50       2 $_[0]{"original_cards"} = do {
180 1         2 my $default_value = $_[0]->_build_original_cards;
181 1 50       8 do {
182              
183             package Acme::Mitey::Cards::Mite;
184 1 50       10 ( ref($default_value) eq 'ARRAY' ) and do {
185 1         2 my $ok = 1;
186 1         2 for my $i ( @{$default_value} ) {
  1         2  
187             ( $ok = 0, last )
188             unless (
189 54 50       63 do {
190 2     2   12 use Scalar::Util ();
  2         3  
  2         1045  
191 54 50       189 Scalar::Util::blessed($i)
192             and
193             $i->isa(q[Acme::Mitey::Cards::Card]);
194             }
195             );
196             };
197 1         4 $ok;
198             }
199             }
200             or croak( "Type check failed in default: %s should be %s",
201             "original_cards", "CardArray" );
202 1         6 $default_value;
203             }
204             )
205             );
206             }
207              
208             # Accessors for reverse
209             # has declaration, file lib/Acme/Mitey/Cards/Deck.pm, line 17
210             if ($__XS) {
211             Class::XSAccessor->import(
212             chained => 1,
213             "getters" => { "reverse" => "reverse" },
214             );
215             }
216             else {
217             *reverse = sub {
218             @_ == 1 or croak('Reader "reverse" usage: $self->reverse()');
219             $_[0]{"reverse"};
220             };
221             }
222              
223             # See UNIVERSAL
224             sub DOES {
225 0     0 0 0 my ( $self, $role ) = @_;
226 0         0 our %DOES;
227 0 0       0 return $DOES{$role} if exists $DOES{$role};
228 0 0       0 return 1 if $role eq __PACKAGE__;
229 0         0 return $self->SUPER::DOES($role);
230             }
231              
232             # Alias for Moose/Moo-compatibility
233             sub does {
234 0     0 0 0 shift->DOES(@_);
235             }
236              
237             # Method signatures
238             our %SIGNATURE_FOR;
239              
240             $SIGNATURE_FOR{"deal_hand"} = sub {
241             my $__NEXT__ = shift;
242              
243             my ( %out, %in, %tmp, $tmp, $dtmp, @head );
244              
245             @_ == 2 && ( ref( $_[1] ) eq 'HASH' )
246             or @_ % 2 == 1 && @_ >= 1
247             or
248             croak( "Wrong number of parameters in signature for %s: got %d, %s",
249             "deal_hand", scalar(@_), "that does not seem right" );
250              
251             @head = splice( @_, 0, 1 );
252              
253             # Parameter invocant (type: Defined)
254             ( defined( $head[0] ) )
255             or croak(
256             "Type check failed in signature for deal_hand: %s should be %s",
257             "\$_[0]", "Defined" );
258              
259             %in = ( @_ == 1 and ( ref( $_[0] ) eq 'HASH' ) ) ? %{ $_[0] } : @_;
260              
261             # Parameter count (type: Int)
262             $dtmp = exists( $in{"count"} ) ? $in{"count"} : "7";
263             (
264             do {
265             my $tmp = $dtmp;
266             defined($tmp) and !ref($tmp) and $tmp =~ /\A-?[0-9]+\z/;
267             }
268             )
269             or croak(
270             "Type check failed in signature for deal_hand: %s should be %s",
271             "\$_{\"count\"}", "Int" );
272             $out{"count"} = $dtmp;
273             delete( $in{"count"} );
274              
275             my $SLURPY = \%in;
276              
277             # Parameter args_for_hand (type: Slurpy[HashRef])
278             ( ( ref($SLURPY) eq 'HASH' ) )
279             or croak(
280             "Type check failed in signature for deal_hand: %s should be %s",
281             "\$SLURPY", "HashRef" );
282             $out{"args_for_hand"} = $SLURPY;
283              
284             return (
285             &$__NEXT__(
286             @head,
287             bless(
288             \%out,
289             "Acme::Mitey::Cards::Deck::__NAMED_ARGUMENTS__::deal_hand"
290             )
291             )
292             );
293             };
294              
295             {
296              
297             package Acme::Mitey::Cards::Deck::__NAMED_ARGUMENTS__::deal_hand;
298 2     2   14 use strict;
  2         3  
  2         47  
299 2     2   8 no warnings;
  2         3  
  2         434  
300 2     2   6 sub args_for_hand { $_[0]{"args_for_hand"} }
301 4     4   78 sub count { $_[0]{"count"} }
302 0     0     sub has_count { exists $_[0]{"count"} }
303             1;
304             }
305              
306             $SIGNATURE_FOR{"discard_jokers"} = sub {
307             my $__NEXT__ = shift;
308              
309             my ( %tmp, $tmp, @head );
310              
311             @_ == 1
312             or
313             croak( "Wrong number of parameters in signature for %s: got %d, %s",
314             "discard_jokers", scalar(@_), "expected exactly 1 parameters" );
315              
316             @head = splice( @_, 0, 1 );
317              
318             # Parameter invocant (type: Defined)
319             ( defined( $head[0] ) )
320             or croak(
321             "Type check failed in signature for discard_jokers: %s should be %s",
322             "\$_[0]", "Defined"
323             );
324              
325             return ( &$__NEXT__( @head, @_ ) );
326             };
327              
328             1;
329             }