File Coverage

blib/lib/Acme/Mitey/Cards/Set.pm.mite.pm
Criterion Covered Total %
statement 96 121 79.3
branch 22 48 45.8
condition 7 21 33.3
subroutine 17 27 62.9
pod 0 5 0.0
total 142 222 63.9


line stmt bran cond sub pod time code
1             {
2              
3             package Acme::Mitey::Cards::Set;
4 4     4   23 use strict;
  4         8  
  4         97  
5 4     4   25 use warnings;
  4         6  
  4         90  
6 4     4   15 no warnings qw( once void );
  4         6  
  4         448  
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 4     4   16 my ( $SHIM, $CALLER ) =
15             ( "Acme::Mitey::Cards::Mite", "Acme::Mitey::Cards::Set" );
16             (
17             *after, *around, *before, *extends, *field,
18             *has, *param, *signature_for, *with
19             )
20 4         6 = do {
21              
22             package Acme::Mitey::Cards::Mite;
23 4     4   23 no warnings 'redefine';
  4         9  
  4         751  
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       0     sub { },
29 0     0   0 sub { $SHIM->HANDLE_has( $CALLER, field => @_ ) },
30 4     4   19 sub { $SHIM->HANDLE_has( $CALLER, has => @_ ) },
31 0     0   0 sub { $SHIM->HANDLE_has( $CALLER, param => @_ ) },
32 12     12   36 sub { $SHIM->HANDLE_signature_for( $CALLER, "class", @_ ) },
33 0     0   0 sub { $SHIM->HANDLE_with( $CALLER, @_ ) },
34 4         594 );
35             };
36             }
37              
38             # Mite imports
39             BEGIN {
40 4     4   24 require Scalar::Util;
41 4         12 *STRICT = \&Acme::Mitey::Cards::Mite::STRICT;
42 4         6 *bare = \&Acme::Mitey::Cards::Mite::bare;
43 4         7 *blessed = \&Scalar::Util::blessed;
44 4         8 *carp = \&Acme::Mitey::Cards::Mite::carp;
45 4         5 *confess = \&Acme::Mitey::Cards::Mite::confess;
46 4         8 *croak = \&Acme::Mitey::Cards::Mite::croak;
47 4         4 *false = \&Acme::Mitey::Cards::Mite::false;
48 4         6 *guard = \&Acme::Mitey::Cards::Mite::guard;
49 4         6 *lazy = \&Acme::Mitey::Cards::Mite::lazy;
50 4         13 *ro = \&Acme::Mitey::Cards::Mite::ro;
51 4         15 *rw = \&Acme::Mitey::Cards::Mite::rw;
52 4         5 *rwp = \&Acme::Mitey::Cards::Mite::rwp;
53 4         112 *true = \&Acme::Mitey::Cards::Mite::true;
54             }
55              
56             # Gather metadata for constructor and destructor
57             sub __META__ {
58 4     4   20 no strict 'refs';
  4         6  
  4         116  
59 4     4   17 no warnings 'once';
  4         8  
  4         1148  
60 5     5   10 my $class = shift;
61 5   33     19 $class = ref($class) || $class;
62 5         17 my $linear_isa = mro::get_linear_isa($class);
63             return {
64             BUILD => [
65 8 50       10 map { ( *{$_}{CODE} ) ? ( *{$_}{CODE} ) : () }
  8         44  
  0         0  
66 8         23 map { "$_\::BUILD" } reverse @$linear_isa
67             ],
68             DEMOLISH => [
69 8 50       12 map { ( *{$_}{CODE} ) ? ( *{$_}{CODE} ) : () }
  8         81  
  0         0  
70 5         10 map { "$_\::DEMOLISH" } @$linear_isa
  8         19  
71             ],
72             HAS_BUILDARGS => $class->can('BUILDARGS'),
73             HAS_FOREIGNBUILDARGS => $class->can('FOREIGNBUILDARGS'),
74             };
75             }
76              
77             # Standard Moose/Moo-style constructor
78             sub new {
79 6 50   6 0 447 my $class = ref( $_[0] ) ? ref(shift) : shift;
80 6   66     18 my $meta = ( $Mite::META{$class} ||= $class->__META__ );
81 6         14 my $self = bless {}, $class;
82             my $args =
83             $meta->{HAS_BUILDARGS}
84             ? $class->BUILDARGS(@_)
85 6 50       20 : { ( @_ == 1 ) ? %{ $_[0] } : @_ };
  0 50       0  
86 6         8 my $no_build = delete $args->{__no_BUILD__};
87              
88             # Attribute cards (type: CardArray)
89             # has declaration, file lib/Acme/Mitey/Cards/Set.pm, line 11
90 6 100       16 if ( exists $args->{"cards"} ) {
91             (
92             do {
93              
94             package Acme::Mitey::Cards::Mite;
95 5         17 ref( $args->{"cards"} ) eq 'ARRAY';
96             }
97 5 50 33     5 and do {
98 5         8 my $ok = 1;
99 5         6 for my $i ( @{ $args->{"cards"} } ) {
  5         19  
100             ( $ok = 0, last )
101             unless (
102 19 50       23 do {
103 4     4   25 use Scalar::Util ();
  4         7  
  4         1374  
104 19 50       82 Scalar::Util::blessed($i)
105             and $i->isa(q[Acme::Mitey::Cards::Card]);
106             }
107             );
108             };
109 5         14 $ok;
110             }
111             )
112             or croak "Type check failed in constructor: %s should be %s",
113             "cards", "CardArray";
114 5         13 $self->{"cards"} = $args->{"cards"};
115             }
116              
117             # Call BUILD methods
118 6 50 33     14 $self->BUILDALL($args) if ( !$no_build and @{ $meta->{BUILD} || [] } );
  6 50       19  
119              
120             # Unrecognized parameters
121 6         10 my @unknown = grep not(/\Acards\z/), keys %{$args};
  6         28  
122             @unknown
123 6 50       14 and croak(
124             "Unexpected keys in constructor: " . join( q[, ], sort @unknown ) );
125              
126 6         22 return $self;
127             }
128              
129             # Used by constructor to call BUILD methods
130             sub BUILDALL {
131 0     0 0 0 my $class = ref( $_[0] );
132 0   0     0 my $meta = ( $Mite::META{$class} ||= $class->__META__ );
133 0 0       0 $_->(@_) for @{ $meta->{BUILD} || [] };
  0         0  
134             }
135              
136             # Destructor should call DEMOLISH methods
137             sub DESTROY {
138 10     10   4220 my $self = shift;
139 10   33     25 my $class = ref($self) || $self;
140 10   33     25 my $meta = ( $Mite::META{$class} ||= $class->__META__ );
141 10 50       30 my $in_global_destruction =
142             defined ${^GLOBAL_PHASE}
143             ? ${^GLOBAL_PHASE} eq 'DESTRUCT'
144             : Devel::GlobalDestruction::in_global_destruction();
145 10 50       19 for my $demolisher ( @{ $meta->{DEMOLISH} || [] } ) {
  10         28  
146 0         0 my $e = do {
147 0         0 local ( $?, $@ );
148 0         0 eval { $demolisher->( $self, $in_global_destruction ) };
  0         0  
149 0         0 $@;
150             };
151 4     4   24 no warnings 'misc'; # avoid (in cleanup) warnings
  4         7  
  4         704  
152 0 0       0 die $e if $e; # rethrow
153             }
154 10         160 return;
155             }
156              
157             my $__XS = !$ENV{MITE_PURE_PERL}
158             && eval { require Class::XSAccessor; Class::XSAccessor->VERSION("1.19") };
159              
160             # Accessors for cards
161             # has declaration, file lib/Acme/Mitey/Cards/Set.pm, line 11
162             sub cards {
163 41 50   41 0 78 @_ == 1 or croak('Reader "cards" usage: $self->cards()');
164             (
165             exists( $_[0]{"cards"} ) ? $_[0]{"cards"} : (
166 41 100       305 $_[0]{"cards"} = do {
167 3         11 my $default_value = $_[0]->_build_cards;
168 3 50       6 do {
169              
170             package Acme::Mitey::Cards::Mite;
171 3 50       10 ( ref($default_value) eq 'ARRAY' ) and do {
172 3         5 my $ok = 1;
173 3         4 for my $i ( @{$default_value} ) {
  3         7  
174             ( $ok = 0, last )
175             unless (
176 54 50       64 do {
177 4     4   25 use Scalar::Util ();
  4         5  
  4         2240  
178 54 50       182 Scalar::Util::blessed($i)
179             and
180             $i->isa(q[Acme::Mitey::Cards::Card]);
181             }
182             );
183             };
184 3         17 $ok;
185             }
186             }
187             or croak( "Type check failed in default: %s should be %s",
188             "cards", "CardArray" );
189 3         21 $default_value;
190             }
191             )
192             );
193             }
194              
195             # See UNIVERSAL
196             sub DOES {
197 0     0 0   my ( $self, $role ) = @_;
198 0           our %DOES;
199 0 0         return $DOES{$role} if exists $DOES{$role};
200 0 0         return 1 if $role eq __PACKAGE__;
201 0           return $self->SUPER::DOES($role);
202             }
203              
204             # Alias for Moose/Moo-compatibility
205             sub does {
206 0     0 0   shift->DOES(@_);
207             }
208              
209             # Method signatures
210             our %SIGNATURE_FOR;
211              
212             $SIGNATURE_FOR{"count"} = sub {
213             my $__NEXT__ = shift;
214              
215             my ( %tmp, $tmp, @head );
216              
217             @_ == 1
218             or
219             croak( "Wrong number of parameters in signature for %s: got %d, %s",
220             "count", scalar(@_), "expected exactly 1 parameters" );
221              
222             @head = splice( @_, 0, 1 );
223              
224             # Parameter invocant (type: Defined)
225             ( defined( $head[0] ) )
226             or croak( "Type check failed in signature for count: %s should be %s",
227             "\$_[0]", "Defined" );
228              
229             return ( &$__NEXT__( @head, @_ ) );
230             };
231              
232             $SIGNATURE_FOR{"take"} = sub {
233             my $__NEXT__ = shift;
234              
235             my ( %tmp, $tmp, @head );
236              
237             @_ == 2
238             or
239             croak( "Wrong number of parameters in signature for %s: got %d, %s",
240             "take", scalar(@_), "expected exactly 2 parameters" );
241              
242             @head = splice( @_, 0, 1 );
243              
244             # Parameter invocant (type: Defined)
245             ( defined( $head[0] ) )
246             or croak( "Type check failed in signature for take: %s should be %s",
247             "\$_[0]", "Defined" );
248              
249             # Parameter $_[0] (type: Int)
250             (
251             do {
252             my $tmp = $_[0];
253             defined($tmp) and !ref($tmp) and $tmp =~ /\A-?[0-9]+\z/;
254             }
255             )
256             or croak( "Type check failed in signature for take: %s should be %s",
257             "\$_[1]", "Int" );
258              
259             return ( &$__NEXT__( @head, @_ ) );
260             };
261              
262             $SIGNATURE_FOR{"to_string"} = sub {
263             my $__NEXT__ = shift;
264              
265             my ( %tmp, $tmp, @head );
266              
267             @_ == 1
268             or
269             croak( "Wrong number of parameters in signature for %s: got %d, %s",
270             "to_string", scalar(@_), "expected exactly 1 parameters" );
271              
272             @head = splice( @_, 0, 1 );
273              
274             # Parameter invocant (type: Defined)
275             ( defined( $head[0] ) )
276             or croak(
277             "Type check failed in signature for to_string: %s should be %s",
278             "\$_[0]", "Defined" );
279              
280             return ( &$__NEXT__( @head, @_ ) );
281             };
282              
283             1;
284             }