File Coverage

blib/lib/Acme/Mitey/Cards/Card.pm.mite.pm
Criterion Covered Total %
statement 75 95 78.9
branch 27 54 50.0
condition 7 21 33.3
subroutine 11 14 78.5
pod 0 5 0.0
total 120 189 63.4


line stmt bran cond sub pod time code
1             {
2              
3             package Acme::Mitey::Cards::Card;
4 8     8   46 use strict;
  8         15  
  8         193  
5 8     8   33 use warnings;
  8         13  
  8         1215  
6              
7             our $USES_MITE = "Mite::Class";
8             our $MITE_SHIM = "Acme::Mitey::Cards::Mite";
9             our $MITE_VERSION = "0.007003";
10              
11             BEGIN {
12 8     8   64 require Scalar::Util;
13 8         23 *bare = \&Acme::Mitey::Cards::Mite::bare;
14 8         22 *blessed = \&Scalar::Util::blessed;
15 8         15 *carp = \&Acme::Mitey::Cards::Mite::carp;
16 8         15 *confess = \&Acme::Mitey::Cards::Mite::confess;
17 8         10 *croak = \&Acme::Mitey::Cards::Mite::croak;
18 8         13 *false = \&Acme::Mitey::Cards::Mite::false;
19 8         12 *guard = \&Acme::Mitey::Cards::Mite::guard;
20 8         12 *lazy = \&Acme::Mitey::Cards::Mite::lazy;
21 8         12 *ro = \&Acme::Mitey::Cards::Mite::ro;
22 8         12 *rw = \&Acme::Mitey::Cards::Mite::rw;
23 8         13 *rwp = \&Acme::Mitey::Cards::Mite::rwp;
24 8         1226 *true = \&Acme::Mitey::Cards::Mite::true;
25             }
26              
27             sub new {
28 6 50   6 0 1064 my $class = ref( $_[0] ) ? ref(shift) : shift;
29 6   66     49 my $meta = ( $Mite::META{$class} ||= $class->__META__ );
30 6         18 my $self = bless {}, $class;
31             my $args =
32             $meta->{HAS_BUILDARGS}
33             ? $class->BUILDARGS(@_)
34 6 50       31 : { ( @_ == 1 ) ? %{ $_[0] } : @_ };
  0 50       0  
35 6         14 my $no_build = delete $args->{__no_BUILD__};
36              
37             # Attribute: deck
38 6 100       19 if ( exists $args->{"deck"} ) {
39             (
40 2 50       2 do {
41 8     8   50 use Scalar::Util ();
  8         14  
  8         3268  
42             Scalar::Util::blessed( $args->{"deck"} )
43 2 50       14 and $args->{"deck"}->isa(q[Acme::Mitey::Cards::Deck]);
44             }
45             )
46             or croak "Type check failed in constructor: %s should be %s",
47             "deck", "Deck";
48 2         7 $self->{"deck"} = $args->{"deck"};
49             }
50             require Scalar::Util && Scalar::Util::weaken( $self->{"deck"} )
51 6 100 33     37 if exists $self->{"deck"};
52              
53             # Attribute: reverse
54 6 100       16 if ( exists $args->{"reverse"} ) {
55 2 50       3 do {
56              
57             package Acme::Mitey::Cards::Mite;
58 2 50       9 defined( $args->{"reverse"} ) and do {
59             ref( \$args->{"reverse"} ) eq 'SCALAR'
60 2 50       29 or ref( \( my $val = $args->{"reverse"} ) ) eq 'SCALAR';
61             }
62             }
63             or croak "Type check failed in constructor: %s should be %s",
64             "reverse", "Str";
65 2         8 $self->{"reverse"} = $args->{"reverse"};
66             }
67              
68             # Enforce strict constructor
69 6         12 my @unknown = grep not(/\A(?:deck|reverse)\z/), keys %{$args};
  6         42  
70             @unknown
71 6 50       19 and croak(
72             "Unexpected keys in constructor: " . join( q[, ], sort @unknown ) );
73              
74             # Call BUILD methods
75 6 50 33     28 $self->BUILDALL($args) if ( !$no_build and @{ $meta->{BUILD} || [] } );
  6 50       40  
76              
77 6         23 return $self;
78             }
79              
80             sub BUILDALL {
81 0     0 0 0 my $class = ref( $_[0] );
82 0   0     0 my $meta = ( $Mite::META{$class} ||= $class->__META__ );
83 0 0       0 $_->(@_) for @{ $meta->{BUILD} || [] };
  0         0  
84             }
85              
86             sub DESTROY {
87 63     63   3887 my $self = shift;
88 63   33     113 my $class = ref($self) || $self;
89 63   33     117 my $meta = ( $Mite::META{$class} ||= $class->__META__ );
90 63 50       138 my $in_global_destruction =
91             defined ${^GLOBAL_PHASE}
92             ? ${^GLOBAL_PHASE} eq 'DESTRUCT'
93             : Devel::GlobalDestruction::in_global_destruction();
94 63 50       76 for my $demolisher ( @{ $meta->{DEMOLISH} || [] } ) {
  63         123  
95 0         0 my $e = do {
96 0         0 local ( $?, $@ );
97 0         0 eval { $demolisher->( $self, $in_global_destruction ) };
  0         0  
98 0         0 $@;
99             };
100 8     8   62 no warnings 'misc'; # avoid (in cleanup) warnings
  8         30  
  8         631  
101 0 0       0 die $e if $e; # rethrow
102             }
103 63         750 return;
104             }
105              
106             sub __META__ {
107 8     8   51 no strict 'refs';
  8         22  
  8         225  
108 8     8   39 no warnings 'once';
  8         13  
  8         4794  
109 9     9   19 my $class = shift;
110 9   33     36 $class = ref($class) || $class;
111 9         51 my $linear_isa = mro::get_linear_isa($class);
112             return {
113             BUILD => [
114 15 50       20 map { ( *{$_}{CODE} ) ? ( *{$_}{CODE} ) : () }
  15         73  
  0         0  
115 15         45 map { "$_\::BUILD" } reverse @$linear_isa
116             ],
117             DEMOLISH => [
118 15 50       22 map { ( *{$_}{CODE} ) ? ( *{$_}{CODE} ) : () }
  15         147  
  0         0  
119 9         28 map { "$_\::DEMOLISH" } @$linear_isa
  15         38  
120             ],
121             HAS_BUILDARGS => $class->can('BUILDARGS'),
122             HAS_FOREIGNBUILDARGS => $class->can('FOREIGNBUILDARGS'),
123             };
124             }
125              
126             sub DOES {
127 0     0 0 0 my ( $self, $role ) = @_;
128 0         0 our %DOES;
129 0 0       0 return $DOES{$role} if exists $DOES{$role};
130 0 0       0 return 1 if $role eq __PACKAGE__;
131 0         0 return $self->SUPER::DOES($role);
132             }
133              
134             sub does {
135 0     0 0 0 shift->DOES(@_);
136             }
137              
138             my $__XS = !$ENV{MITE_PURE_PERL}
139             && eval { require Class::XSAccessor; Class::XSAccessor->VERSION("1.19") };
140              
141             # Accessors for deck
142             if ($__XS) {
143             Class::XSAccessor->import(
144             chained => 1,
145             "getters" => { "deck" => "deck" },
146             );
147             }
148             else {
149             *deck = sub {
150             @_ > 1
151             ? croak("deck is a read-only attribute of @{[ref $_[0]]}")
152             : $_[0]{"deck"};
153             };
154             }
155              
156             # Accessors for reverse
157             sub reverse {
158             @_ > 1
159 0         0 ? croak("reverse is a read-only attribute of @{[ref $_[0]]}")
160             : (
161             exists( $_[0]{"reverse"} ) ? $_[0]{"reverse"} : (
162 6 100   6 0 750 $_[0]{"reverse"} = do {
    50          
163 1         6 my $default_value = $_[0]->_build_reverse;
164 1 50       2 do {
165              
166             package Acme::Mitey::Cards::Mite;
167 1 50       4 defined($default_value) and do {
168 1 50       6 ref( \$default_value ) eq 'SCALAR'
169             or ref( \( my $val = $default_value ) ) eq
170             'SCALAR';
171             }
172             }
173             or croak( "Type check failed in default: %s should be %s",
174             "reverse", "Str" );
175 1         7 $default_value;
176             }
177             )
178             );
179             }
180              
181             our %SIGNATURE_FOR;
182              
183             $SIGNATURE_FOR{"to_string"} = sub {
184             my $__NEXT__ = shift;
185              
186             my ( %tmp, $tmp, @head );
187              
188             @_ == 1
189             or croak(
190             "Wrong number of parameters in signature for %s: %s, got %d",
191             "to_string", "expected exactly 1 parameters",
192             scalar(@_)
193             );
194              
195             @head = splice( @_, 0, 1 );
196              
197             # Parameter $head[0] (type: Defined)
198             ( defined( $head[0] ) )
199             or croak(
200             "Type check failed in signature for to_string: %s should be %s",
201             "\$_[0]", "Defined" );
202              
203             return ( &$__NEXT__( @head, @_ ) );
204             };
205              
206             1;
207             }