File Coverage

blib/lib/Acme/Mitey/Cards/Card.pm.mite.pm
Criterion Covered Total %
statement 84 109 77.0
branch 26 52 50.0
condition 8 24 33.3
subroutine 15 25 60.0
pod 0 5 0.0
total 133 215 61.8


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