File Coverage

blib/lib/Acme/Mitey/Cards/Suit.pm.mite.pm
Criterion Covered Total %
statement 80 116 68.9
branch 23 62 37.1
condition 5 21 23.8
subroutine 14 25 56.0
pod 0 5 0.0
total 122 229 53.2


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