File Coverage

/tmp/0dVHCKUbrH.mite.pm
Criterion Covered Total %
statement 97 168 57.7
branch 11 58 18.9
condition 3 41 7.3
subroutine 21 26 80.7
pod n/a
total 132 293 45.0


line stmt bran cond sub pod time code
1             {
2             package MyTest::R;
3 1     1   7 use strict;
  1         2  
  1         29  
4 1     1   4 use warnings;
  1         1  
  1         39  
5 1     1   6 no warnings qw( once void );
  1         1  
  1         200  
6              
7             our $USES_MITE = "Mite::Role";
8             our $MITE_SHIM = "Mite::Shim";
9             our $MITE_VERSION = "0.012000";
10             # Mite keywords
11             BEGIN {
12 1     1   14 my ( $SHIM, $CALLER ) = ( "Mite::Shim", "MyTest::R" );
13 1         3 ( *after, *around, *before, *field, *has, *param, *requires, *signature_for, *with ) = do {
14             package Mite::Shim;
15 1     1   13 no warnings 'redefine';
  1         2  
  1         289  
16             (
17 0         0 sub { $SHIM->HANDLE_after( $CALLER, "role", @_ ) },
18 0         0 sub { $SHIM->HANDLE_around( $CALLER, "role", @_ ) },
19 0         0 sub { $SHIM->HANDLE_before( $CALLER, "role", @_ ) },
20 0         0 sub { $SHIM->HANDLE_has( $CALLER, field => @_ ) },
21 0         0 sub { $SHIM->HANDLE_has( $CALLER, has => @_ ) },
22 0         0 sub { $SHIM->HANDLE_has( $CALLER, param => @_ ) },
23             sub {},
24 1         5 sub { $SHIM->HANDLE_signature_for( $CALLER, "role", @_ ) },
25 0         0 sub { $SHIM->HANDLE_with( $CALLER, @_ ) },
26 1         200 );
27             };
28             };
29              
30             # Mite imports
31             BEGIN {
32 1     1   7 require Scalar::Util;
33 1         3 *STRICT = \&Mite::Shim::STRICT;
34 1         2 *bare = \&Mite::Shim::bare;
35 1         2 *blessed = \&Scalar::Util::blessed;
36 1         3 *carp = \&Mite::Shim::carp;
37 1         2 *confess = \&Mite::Shim::confess;
38 1         1 *croak = \&Mite::Shim::croak;
39 1         2 *false = \&Mite::Shim::false;
40 1         2 *guard = \&Mite::Shim::guard;
41 1         2 *lazy = \&Mite::Shim::lazy;
42 1         2 *lock = \&Mite::Shim::lock;
43 1         1 *ro = \&Mite::Shim::ro;
44 1         2 *rw = \&Mite::Shim::rw;
45 1         3 *rwp = \&Mite::Shim::rwp;
46 1         1 *true = \&Mite::Shim::true;
47 1         37 *unlock = \&Mite::Shim::unlock;
48             };
49              
50             # Gather metadata for constructor and destructor
51             sub __META__ {
52 1     1   5 no strict 'refs';
  1         2  
  1         795  
53 0   0 0   0 my $class = shift; $class = ref($class) || $class;
  0         0  
54 0         0 my $linear_isa = mro::get_linear_isa( $class );
55             return {
56             BUILD => [
57 0 0       0 map { ( *{$_}{CODE} ) ? ( *{$_}{CODE} ) : () }
  0         0  
  0         0  
58 0         0 map { "$_\::BUILD" } reverse @$linear_isa
59             ],
60             DEMOLISH => [
61 0 0       0 map { ( *{$_}{CODE} ) ? ( *{$_}{CODE} ) : () }
  0         0  
  0         0  
62 0         0 map { "$_\::DEMOLISH" } @$linear_isa
  0         0  
63             ],
64             HAS_BUILDARGS => $class->can('BUILDARGS'),
65             HAS_FOREIGNBUILDARGS => $class->can('FOREIGNBUILDARGS'),
66             };
67             }
68              
69             # See UNIVERSAL
70             sub DOES {
71 24     24   35 my ( $self, $role ) = @_;
72 24         20 our %DOES;
73 24 50       34 return $DOES{$role} if exists $DOES{$role};
74 24 50       36 return 1 if $role eq __PACKAGE__;
75 24 50 0     38 if ( $INC{'Moose/Util.pm'} and my $meta = Moose::Util::find_meta( ref $self or $self ) ) {
      33        
76 0 0 0     0 $meta->can( 'does_role' ) and $meta->does_role( $role ) and return 1;
77             }
78 24         102 return $self->SUPER::DOES( $role );
79             }
80              
81             # Alias for Moose/Moo-compatibility
82             sub does {
83 24     24   2578 shift->DOES( @_ );
84             }
85              
86             # Method signatures
87             our %SIGNATURE_FOR;
88              
89             $SIGNATURE_FOR{"foo"} = sub {
90             my $__NEXT__ = shift;
91              
92             my ( @out, %tmp, $tmp, $dtmp, @head );
93              
94             @_ == 3
95             or croak( "Wrong number of parameters in signature for %s: got %d, %s", "foo", scalar( @_ ), "expected exactly 3 parameters" );
96              
97             @head = splice( @_, 0, 1 );
98              
99             # Parameter invocant (type: Defined)
100             (defined($head[0]))
101             or croak( "Type check failed in signature for foo: %s should be %s", "\$_[0]", "Defined" );
102              
103             # Parameter $_[0] (type: Int)
104             (do { my $tmp = $_[0]; defined($tmp) and !ref($tmp) and $tmp =~ /\A-?[0-9]+\z/ })
105             or croak( "Type check failed in signature for foo: %s should be %s", "\$_[1]", "Int" );
106             push( @out, $_[0] );
107              
108             # Parameter $_[1] (type: Bool)
109             $tmp = ((!ref $_[1] and (!defined $_[1] or $_[1] eq q() or $_[1] eq '0' or $_[1] eq '1'))) ? $_[1] : ((!!1)) ? scalar(do { local $_ = $_[1]; !!$_ }) : $_[1];
110             (!ref $tmp and (!defined $tmp or $tmp eq q() or $tmp eq '0' or $tmp eq '1'))
111             or croak( "Type check failed in signature for foo: %s should be %s", "\$_[2]", "Bool" );
112             push( @out, $tmp );
113              
114             do { @_ = ( @head, @out ); goto $__NEXT__ };
115             };
116              
117              
118             # Callback which classes consuming this role will call
119             sub __FINALIZE_APPLICATION__ {
120 1     1   3 my ( $me, $target, $args ) = @_;
121 1         1 our ( %CONSUMERS, @METHOD_MODIFIERS );
122              
123             # Ensure a given target only consumes this role once.
124 1 50       3 if ( exists $CONSUMERS{$target} ) {
125 0         0 return;
126             }
127 1         2 $CONSUMERS{$target} = 1;
128              
129 1     1   10 my $type = do { no strict 'refs'; ${"$target\::USES_MITE"} };
  1         1  
  1         283  
  1         1  
  1         2  
  1         3  
130 1 50       3 return if $type ne 'Mite::Class';
131              
132 1         1 my @missing_methods;
133 1 50       3 @missing_methods = ()
134             and croak( "$me requires $target to implement methods: " . join q[, ], @missing_methods );
135              
136 1         1 my @roles = ( );
137 1 50       1 my %nextargs = %{ $args || {} };
  1         7  
138 1   50     6 ( $nextargs{-indirect} ||= 0 )++;
139 1 50       19 croak( "PANIC!" ) if $nextargs{-indirect} > 100;
140 1         3 for my $role ( @roles ) {
141 0         0 $role->__FINALIZE_APPLICATION__( $target, { %nextargs } );
142             }
143              
144 1         2 my $shim = "Mite::Shim";
145 1         2 for my $modifier_rule ( @METHOD_MODIFIERS ) {
146 1         2 my ( $modification, $names, $coderef ) = @$modifier_rule;
147 1         2 my $handler = "HANDLE_$modification";
148 1         5 $shim->$handler( $target, "class", $names, $coderef );
149             }
150              
151 1         5 return;
152             }
153              
154             1;
155             }{
156             package MyTest;
157 1     1   10 use strict;
  1         2  
  1         20  
158 1     1   4 use warnings;
  1         2  
  1         49  
159 1     1   10 no warnings qw( once void );
  1         2  
  1         144  
160              
161             our $USES_MITE = "Mite::Class";
162             our $MITE_SHIM = "Mite::Shim";
163             our $MITE_VERSION = "0.012000";
164             # Mite keywords
165             BEGIN {
166 1     1   12 my ( $SHIM, $CALLER ) = ( "Mite::Shim", "MyTest" );
167 1         13 ( *after, *around, *before, *extends, *has, *signature_for, *with ) = do {
168             package Mite::Shim;
169 1     1   7 no warnings 'redefine';
  1         1  
  1         201  
170             (
171 0         0 sub { $SHIM->HANDLE_after( $CALLER, "class", @_ ) },
172 0         0 sub { $SHIM->HANDLE_around( $CALLER, "class", @_ ) },
173 0         0 sub { $SHIM->HANDLE_before( $CALLER, "class", @_ ) },
174             sub {},
175 0         0 sub { $SHIM->HANDLE_has( $CALLER, has => @_ ) },
176 0         0 sub { $SHIM->HANDLE_signature_for( $CALLER, "class", @_ ) },
177 1         4 sub { $SHIM->HANDLE_with( $CALLER, @_ ) },
178 1         54 );
179             };
180             };
181              
182             # Gather metadata for constructor and destructor
183             sub __META__ {
184 1     1   14 no strict 'refs';
  1         2  
  1         640  
185 0   0 0   0 my $class = shift; $class = ref($class) || $class;
  0         0  
186 0         0 my $linear_isa = mro::get_linear_isa( $class );
187             return {
188             BUILD => [
189 0 0       0 map { ( *{$_}{CODE} ) ? ( *{$_}{CODE} ) : () }
  0         0  
  0         0  
190 0         0 map { "$_\::BUILD" } reverse @$linear_isa
191             ],
192             DEMOLISH => [
193 0 0       0 map { ( *{$_}{CODE} ) ? ( *{$_}{CODE} ) : () }
  0         0  
  0         0  
194 0         0 map { "$_\::DEMOLISH" } @$linear_isa
  0         0  
195             ],
196             HAS_BUILDARGS => $class->can('BUILDARGS'),
197             HAS_FOREIGNBUILDARGS => $class->can('FOREIGNBUILDARGS'),
198             };
199             }
200              
201              
202             # Standard Moose/Moo-style constructor
203             sub new {
204 0 0   0   0 my $class = ref($_[0]) ? ref(shift) : shift;
205 0   0     0 my $meta = ( $Mite::META{$class} ||= $class->__META__ );
206 0         0 my $self = bless {}, $class;
207 0 0       0 my $args = $meta->{HAS_BUILDARGS} ? $class->BUILDARGS( @_ ) : { ( @_ == 1 ) ? %{$_[0]} : @_ };
  0 0       0  
208 0         0 my $no_build = delete $args->{__no_BUILD__};
209              
210              
211              
212             # Call BUILD methods
213 0 0 0     0 $self->BUILDALL( $args ) if ( ! $no_build and @{ $meta->{BUILD} || [] } );
  0 0       0  
214              
215             # Unrecognized parameters
216 0 0       0 my @unknown = grep not( do { package MyTest::__SAFE_NAMESPACE__; defined($_) and do { ref(\$_) eq 'SCALAR' or ref(\(my $val = $_)) eq 'SCALAR' } } ), keys %{$args}; @unknown and Mite::Shim::croak( "Unexpected keys in constructor: " . join( q[, ], sort @unknown ) );
  0 0       0  
  0 0       0  
  0         0  
  0         0  
217              
218 0         0 return $self;
219             }
220              
221             # Used by constructor to call BUILD methods
222             sub BUILDALL {
223 0     0   0 my $class = ref( $_[0] );
224 0   0     0 my $meta = ( $Mite::META{$class} ||= $class->__META__ );
225 0 0       0 $_->( @_ ) for @{ $meta->{BUILD} || [] };
  0         0  
226             }
227              
228             # Destructor should call DEMOLISH methods
229             sub DESTROY {
230 0     0   0 my $self = shift;
231 0   0     0 my $class = ref( $self ) || $self;
232 0   0     0 my $meta = ( $Mite::META{$class} ||= $class->__META__ );
233 0 0       0 my $in_global_destruction = defined ${^GLOBAL_PHASE}
234             ? ${^GLOBAL_PHASE} eq 'DESTRUCT'
235             : Devel::GlobalDestruction::in_global_destruction();
236 0 0       0 for my $demolisher ( @{ $meta->{DEMOLISH} || [] } ) {
  0         0  
237 0         0 my $e = do {
238 0         0 local ( $?, $@ );
239 0         0 eval { $demolisher->( $self, $in_global_destruction ) };
  0         0  
240 0         0 $@;
241             };
242 1     1   15 no warnings 'misc'; # avoid (in cleanup) warnings
  1         3  
  1         101  
243 0 0       0 die $e if $e; # rethrow
244             }
245 0         0 return;
246             }
247              
248              
249             BEGIN {
250            
251            
252 1     1   201 our %DOES = ( "MyTest" => 1, "MyTest::R" => 1 );
253             }
254              
255             # See UNIVERSAL
256             sub DOES {
257 7     7   12 my ( $self, $role ) = @_;
258 7         7 our %DOES;
259 7 50       11 return $DOES{$role} if exists $DOES{$role};
260 7 50       12 return 1 if $role eq __PACKAGE__;
261 7 50 0     12 if ( $INC{'Moose/Util.pm'} and my $meta = Moose::Util::find_meta( ref $self or $self ) ) {
      33        
262 0 0 0     0 $meta->can( 'does_role' ) and $meta->does_role( $role ) and return 1;
263             }
264 7         33 return $self->SUPER::DOES( $role );
265             }
266              
267             # Alias for Moose/Moo-compatibility
268             sub does {
269 7     7   1192 shift->DOES( @_ );
270             }
271              
272             1;
273             }