File Coverage

blib/lib/Acme/Mitey/Cards/Suit.pm.mite.pm
Criterion Covered Total %
statement 79 119 66.3
branch 23 66 34.8
condition 5 33 15.1
subroutine 13 25 52.0
pod 0 6 0.0
total 120 249 48.1


line stmt bran cond sub pod time code
1             {
2              
3             package Acme::Mitey::Cards::Suit;
4 6     6   45 use strict;
  6         12  
  6         186  
5 6     6   31 use warnings;
  6         13  
  6         169  
6 6     6   38 no warnings qw( once void );
  6         16  
  6         848  
7              
8             our $USES_MITE = "Mite::Class";
9             our $MITE_SHIM = "Acme::Mitey::Cards::Mite";
10             our $MITE_VERSION = "0.011000";
11              
12             # Mite keywords
13             BEGIN {
14 6     6   32 my ( $SHIM, $CALLER ) =
15             ( "Acme::Mitey::Cards::Mite", "Acme::Mitey::Cards::Suit" );
16             (
17             *after, *around, *before, *extends, *field,
18             *has, *param, *signature_for, *with
19             )
20 6         13 = do {
21              
22             package Acme::Mitey::Cards::Mite;
23 6     6   44 no warnings 'redefine';
  6         28  
  6         1426  
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 18     18   84 sub { $SHIM->HANDLE_has( $CALLER, has => @_ ) },
31 0     0   0 sub { $SHIM->HANDLE_has( $CALLER, param => @_ ) },
32 30     30   113 sub { $SHIM->HANDLE_signature_for( $CALLER, "class", @_ ) },
33 0     0   0 sub { $SHIM->HANDLE_with( $CALLER, @_ ) },
34 6         1242 );
35             };
36             }
37              
38             # Mite imports
39             BEGIN {
40 6     6   50 require Scalar::Util;
41 6         21 *STRICT = \&Acme::Mitey::Cards::Mite::STRICT;
42 6         14 *bare = \&Acme::Mitey::Cards::Mite::bare;
43 6         15 *blessed = \&Scalar::Util::blessed;
44 6         11 *carp = \&Acme::Mitey::Cards::Mite::carp;
45 6         12 *confess = \&Acme::Mitey::Cards::Mite::confess;
46 6         22 *croak = \&Acme::Mitey::Cards::Mite::croak;
47 6         13 *false = \&Acme::Mitey::Cards::Mite::false;
48 6         14 *guard = \&Acme::Mitey::Cards::Mite::guard;
49 6         14 *lazy = \&Acme::Mitey::Cards::Mite::lazy;
50 6         12 *lock = \&Acme::Mitey::Cards::Mite::lock;
51 6         13 *ro = \&Acme::Mitey::Cards::Mite::ro;
52 6         9 *rw = \&Acme::Mitey::Cards::Mite::rw;
53 6         22 *rwp = \&Acme::Mitey::Cards::Mite::rwp;
54 6         16 *true = \&Acme::Mitey::Cards::Mite::true;
55 6         220 *unlock = \&Acme::Mitey::Cards::Mite::unlock;
56             }
57              
58             # Gather metadata for constructor and destructor
59             sub __META__ {
60 6     6   39 no strict 'refs';
  6         11  
  6         5452  
61 4     4   11 my $class = shift;
62 4   33     36 $class = ref($class) || $class;
63 4         22 my $linear_isa = mro::get_linear_isa($class);
64             return {
65             BUILD => [
66 4 50       8 map { ( *{$_}{CODE} ) ? ( *{$_}{CODE} ) : () }
  4         38  
  0         0  
67 4         18 map { "$_\::BUILD" } reverse @$linear_isa
68             ],
69             DEMOLISH => [
70 4 50       9 map { ( *{$_}{CODE} ) ? ( *{$_}{CODE} ) : () }
  4         91  
  0         0  
71 4         16 map { "$_\::DEMOLISH" } @$linear_isa
  4         29  
72             ],
73             HAS_BUILDARGS => $class->can('BUILDARGS'),
74             HAS_FOREIGNBUILDARGS => $class->can('FOREIGNBUILDARGS'),
75             };
76             }
77              
78             # Moose-compatibility method
79             sub meta {
80 0     0 0 0 require Acme::Mitey::Cards::MOP;
81 0   0     0 Moose::Util::find_meta( ref $_[0] or $_[0] );
82             }
83              
84             # Standard Moose/Moo-style constructor
85             sub new {
86 12 50   12 0 38 my $class = ref( $_[0] ) ? ref(shift) : shift;
87 12   66     59 my $meta = ( $Mite::META{$class} ||= $class->__META__ );
88 12         31 my $self = bless {}, $class;
89             my $args =
90             $meta->{HAS_BUILDARGS}
91             ? $class->BUILDARGS(@_)
92 12 50       63 : { ( @_ == 1 ) ? %{ $_[0] } : @_ };
  0 50       0  
93 12         25 my $no_build = delete $args->{__no_BUILD__};
94              
95             # Attribute name (type: NonEmptyStr)
96             # has declaration, file lib/Acme/Mitey/Cards/Suit.pm, line 9
97 12 50       42 croak "Missing key in constructor: name" unless exists $args->{"name"};
98             (
99             (
100             do {
101              
102             package Acme::Mitey::Cards::Mite;
103 12 50       38 defined( $args->{"name"} ) and do {
104             ref( \$args->{"name"} ) eq 'SCALAR'
105 12 50       72 or ref( \( my $val = $args->{"name"} ) ) eq 'SCALAR';
106             }
107             }
108             )
109 12 50 33     18 && do {
110              
111             package Acme::Mitey::Cards::Mite;
112 12         45 length( $args->{"name"} ) > 0;
113             }
114             )
115             or croak "Type check failed in constructor: %s should be %s", "name",
116             "NonEmptyStr";
117 12         41 $self->{"name"} = $args->{"name"};
118              
119             # Attribute abbreviation (type: Str)
120             # has declaration, file lib/Acme/Mitey/Cards/Suit.pm, line 19
121 12 50       30 if ( exists $args->{"abbreviation"} ) {
122 0 0       0 do {
123              
124             package Acme::Mitey::Cards::Mite;
125 0 0       0 defined( $args->{"abbreviation"} ) and do {
126             ref( \$args->{"abbreviation"} ) eq 'SCALAR'
127 0 0       0 or ref( \( my $val = $args->{"abbreviation"} ) ) eq
128             'SCALAR';
129             }
130             }
131             or croak "Type check failed in constructor: %s should be %s",
132             "abbreviation", "Str";
133 0         0 $self->{"abbreviation"} = $args->{"abbreviation"};
134             }
135              
136             # Attribute colour (type: Str)
137             # has declaration, file lib/Acme/Mitey/Cards/Suit.pm, line 21
138             croak "Missing key in constructor: colour"
139 12 50       30 unless exists $args->{"colour"};
140 12 50       19 do {
141              
142             package Acme::Mitey::Cards::Mite;
143 12 50       35 defined( $args->{"colour"} ) and do {
144             ref( \$args->{"colour"} ) eq 'SCALAR'
145 12 50       53 or ref( \( my $val = $args->{"colour"} ) ) eq 'SCALAR';
146             }
147             }
148             or croak "Type check failed in constructor: %s should be %s",
149             "colour", "Str";
150 12         29 $self->{"colour"} = $args->{"colour"};
151              
152             # Call BUILD methods
153 12 50 33     30 $self->BUILDALL($args) if ( !$no_build and @{ $meta->{BUILD} || [] } );
  12 50       53  
154              
155             # Unrecognized parameters
156             my @unknown = grep not(/\A(?:abbreviation|colour|name)\z/),
157 12         24 keys %{$args};
  12         134  
158             @unknown
159 12 50       37 and croak(
160             "Unexpected keys in constructor: " . join( q[, ], sort @unknown ) );
161              
162 12         182 return $self;
163             }
164              
165             # Used by constructor to call BUILD methods
166             sub BUILDALL {
167 0     0 0 0 my $class = ref( $_[0] );
168 0   0     0 my $meta = ( $Mite::META{$class} ||= $class->__META__ );
169 0 0       0 $_->(@_) for @{ $meta->{BUILD} || [] };
  0         0  
170             }
171              
172             # Destructor should call DEMOLISH methods
173             sub DESTROY {
174 0     0   0 my $self = shift;
175 0   0     0 my $class = ref($self) || $self;
176 0   0     0 my $meta = ( $Mite::META{$class} ||= $class->__META__ );
177 0 0       0 my $in_global_destruction =
178             defined ${^GLOBAL_PHASE}
179             ? ${^GLOBAL_PHASE} eq 'DESTRUCT'
180             : Devel::GlobalDestruction::in_global_destruction();
181 0 0       0 for my $demolisher ( @{ $meta->{DEMOLISH} || [] } ) {
  0         0  
182 0         0 my $e = do {
183 0         0 local ( $?, $@ );
184 0         0 eval { $demolisher->( $self, $in_global_destruction ) };
  0         0  
185 0         0 $@;
186             };
187 6     6   49 no warnings 'misc'; # avoid (in cleanup) warnings
  6         13  
  6         7317  
188 0 0       0 die $e if $e; # rethrow
189             }
190 0         0 return;
191             }
192              
193             my $__XS = !$ENV{PERL_ONLY}
194             && eval { require Class::XSAccessor; Class::XSAccessor->VERSION("1.19") };
195              
196             # Accessors for abbreviation
197             # has declaration, file lib/Acme/Mitey/Cards/Suit.pm, line 19
198             sub abbreviation {
199 164 50   164 0 337 @_ == 1 or croak('Reader "abbreviation" usage: $self->abbreviation()');
200             (
201             exists( $_[0]{"abbreviation"} ) ? $_[0]{"abbreviation"} : (
202 164 100       3579 $_[0]{"abbreviation"} = do {
203 12         38 my $default_value = $_[0]->_build_abbreviation;
204 12 50       21 do {
205              
206             package Acme::Mitey::Cards::Mite;
207 12 50       44 defined($default_value) and do {
208 12 50       82 ref( \$default_value ) eq 'SCALAR'
209             or ref( \( my $val = $default_value ) ) eq
210             'SCALAR';
211             }
212             }
213             or croak( "Type check failed in default: %s should be %s",
214             "abbreviation", "Str" );
215 12         161 $default_value;
216             }
217             )
218             );
219             }
220              
221             # Accessors for colour
222             # has declaration, file lib/Acme/Mitey/Cards/Suit.pm, line 21
223             if ($__XS) {
224             Class::XSAccessor->import(
225             chained => 1,
226             "getters" => { "colour" => "colour" },
227             );
228             }
229             else {
230             *colour = sub {
231             @_ == 1 or croak('Reader "colour" usage: $self->colour()');
232             $_[0]{"colour"};
233             };
234             }
235              
236             # Accessors for name
237             # has declaration, file lib/Acme/Mitey/Cards/Suit.pm, line 9
238             if ($__XS) {
239             Class::XSAccessor->import(
240             chained => 1,
241             "getters" => { "name" => "name" },
242             );
243             }
244             else {
245             *name = sub {
246             @_ == 1 or croak('Reader "name" usage: $self->name()');
247             $_[0]{"name"};
248             };
249             }
250              
251             # See UNIVERSAL
252             sub DOES {
253 0     0 0   my ( $self, $role ) = @_;
254 0           our %DOES;
255 0 0         return $DOES{$role} if exists $DOES{$role};
256 0 0         return 1 if $role eq __PACKAGE__;
257 0 0 0       if ( $INC{'Moose/Util.pm'}
      0        
258             and my $meta = Moose::Util::find_meta( ref $self or $self ) )
259             {
260 0 0 0       $meta->can('does_role') and $meta->does_role($role) and return 1;
261             }
262 0           return $self->SUPER::DOES($role);
263             }
264              
265             # Alias for Moose/Moo-compatibility
266             sub does {
267 0     0 0   shift->DOES(@_);
268             }
269              
270             # Method signatures
271             our %SIGNATURE_FOR;
272              
273             $SIGNATURE_FOR{"clubs"} = sub {
274             my $__NEXT__ = shift;
275              
276             my ( %tmp, $tmp, @head );
277              
278             @_ == 1
279             or
280             croak( "Wrong number of parameters in signature for %s: got %d, %s",
281             "clubs", scalar(@_), "expected exactly 1 parameters" );
282              
283             @head = splice( @_, 0, 1 );
284              
285             # Parameter invocant (type: Defined)
286             ( defined( $head[0] ) )
287             or croak( "Type check failed in signature for clubs: %s should be %s",
288             "\$_[0]", "Defined" );
289              
290             do { @_ = ( @head, @_ ); goto $__NEXT__ };
291             };
292              
293             $SIGNATURE_FOR{"diamonds"} = sub {
294             my $__NEXT__ = shift;
295              
296             my ( %tmp, $tmp, @head );
297              
298             @_ == 1
299             or
300             croak( "Wrong number of parameters in signature for %s: got %d, %s",
301             "diamonds", scalar(@_), "expected exactly 1 parameters" );
302              
303             @head = splice( @_, 0, 1 );
304              
305             # Parameter invocant (type: Defined)
306             ( defined( $head[0] ) )
307             or
308             croak( "Type check failed in signature for diamonds: %s should be %s",
309             "\$_[0]", "Defined" );
310              
311             do { @_ = ( @head, @_ ); goto $__NEXT__ };
312             };
313              
314             $SIGNATURE_FOR{"hearts"} = sub {
315             my $__NEXT__ = shift;
316              
317             my ( %tmp, $tmp, @head );
318              
319             @_ == 1
320             or
321             croak( "Wrong number of parameters in signature for %s: got %d, %s",
322             "hearts", scalar(@_), "expected exactly 1 parameters" );
323              
324             @head = splice( @_, 0, 1 );
325              
326             # Parameter invocant (type: Defined)
327             ( defined( $head[0] ) )
328             or
329             croak( "Type check failed in signature for hearts: %s should be %s",
330             "\$_[0]", "Defined" );
331              
332             do { @_ = ( @head, @_ ); goto $__NEXT__ };
333             };
334              
335             $SIGNATURE_FOR{"spades"} = sub {
336             my $__NEXT__ = shift;
337              
338             my ( %tmp, $tmp, @head );
339              
340             @_ == 1
341             or
342             croak( "Wrong number of parameters in signature for %s: got %d, %s",
343             "spades", scalar(@_), "expected exactly 1 parameters" );
344              
345             @head = splice( @_, 0, 1 );
346              
347             # Parameter invocant (type: Defined)
348             ( defined( $head[0] ) )
349             or
350             croak( "Type check failed in signature for spades: %s should be %s",
351             "\$_[0]", "Defined" );
352              
353             do { @_ = ( @head, @_ ); goto $__NEXT__ };
354             };
355              
356             $SIGNATURE_FOR{"standard_suits"} = sub {
357             my $__NEXT__ = shift;
358              
359             my ( %tmp, $tmp, @head );
360              
361             @_ == 1
362             or
363             croak( "Wrong number of parameters in signature for %s: got %d, %s",
364             "standard_suits", scalar(@_), "expected exactly 1 parameters" );
365              
366             @head = splice( @_, 0, 1 );
367              
368             # Parameter invocant (type: Defined)
369             ( defined( $head[0] ) )
370             or croak(
371             "Type check failed in signature for standard_suits: %s should be %s",
372             "\$_[0]", "Defined"
373             );
374              
375             do { @_ = ( @head, @_ ); goto $__NEXT__ };
376             };
377              
378             1;
379             }