File Coverage

/tmp/5hEthzNLYU.mite.pm
Criterion Covered Total %
statement 141 191 73.8
branch 28 72 38.8
condition 9 44 20.4
subroutine 29 32 90.6
pod n/a
total 207 339 61.0


line stmt bran cond sub pod time code
1             {
2             package MyTest::R;
3 1     1   6 use strict;
  1         3  
  1         37  
4 1     1   6 use warnings;
  1         2  
  1         30  
5 1     1   5 no warnings qw( once void );
  1         2  
  1         148  
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   4 my ( $SHIM, $CALLER ) = ( "Mite::Shim", "MyTest::R" );
13 1         3 ( *after, *around, *before, *has, *requires, *signature_for, *with ) = do {
14             package Mite::Shim;
15 1     1   8 no warnings 'redefine';
  1         2  
  1         212  
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 1         4 sub { $SHIM->HANDLE_has( $CALLER, has => @_ ) },
21             sub {},
22 0         0 sub { $SHIM->HANDLE_signature_for( $CALLER, "role", @_ ) },
23 0         0 sub { $SHIM->HANDLE_with( $CALLER, @_ ) },
24 1         83 );
25             };
26             };
27              
28             # Gather metadata for constructor and destructor
29             sub __META__ {
30 1     1   8 no strict 'refs';
  1         1  
  1         1085  
31 0   0 0   0 my $class = shift; $class = ref($class) || $class;
  0         0  
32 0         0 my $linear_isa = mro::get_linear_isa( $class );
33             return {
34             BUILD => [
35 0 0       0 map { ( *{$_}{CODE} ) ? ( *{$_}{CODE} ) : () }
  0         0  
  0         0  
36 0         0 map { "$_\::BUILD" } reverse @$linear_isa
37             ],
38             DEMOLISH => [
39 0 0       0 map { ( *{$_}{CODE} ) ? ( *{$_}{CODE} ) : () }
  0         0  
  0         0  
40 0         0 map { "$_\::DEMOLISH" } @$linear_isa
  0         0  
41             ],
42             HAS_BUILDARGS => $class->can('BUILDARGS'),
43             HAS_FOREIGNBUILDARGS => $class->can('FOREIGNBUILDARGS'),
44             };
45             }
46              
47             my $__XS = !$ENV{PERL_ONLY} && eval { require Class::XSAccessor; Class::XSAccessor->VERSION("1.19") };
48              
49             # Accessors for foo
50             # has declaration, file ../../../../tmp/5hEthzNLYU, line 4
51             if ( $__XS ) {
52             Class::XSAccessor->import(
53             chained => 1,
54             "getters" => { "foo" => "foo" },
55             "setters" => { "_set_foo" => "foo" },
56             );
57             }
58             else {
59             *foo = sub { @_ == 1 or Mite::Shim::croak( 'Reader "foo" usage: $self->foo()' ); $_[0]{"foo"} };
60             *_set_foo = sub { @_ == 2 or Mite::Shim::croak( 'Writer "_set_foo" usage: $self->_set_foo( $newvalue )' ); $_[0]{"foo"} = $_[1]; $_[0]; };
61             }
62 1 50 33 1   2 sub _assert_blessed_foo { my $object = do { $_[0]{"foo"} }; require Scalar::Util && Scalar::Util::blessed($object) or Mite::Shim::croak( "foo is not a blessed object" ); $object }
  1         7  
  1         24  
  0         0  
63              
64             # Delegated methods for foo
65             # has declaration, file ../../../../tmp/5hEthzNLYU, line 4
66 1     1   3 sub quux { shift->_assert_blessed_foo->quux( @_ ) }
67              
68              
69             # See UNIVERSAL
70             sub DOES {
71 7     7   10 my ( $self, $role ) = @_;
72 7         7 our %DOES;
73 7 50       15 return $DOES{$role} if exists $DOES{$role};
74 7 50       10 return 1 if $role eq __PACKAGE__;
75 7 50 0     14 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 7         44 return $self->SUPER::DOES( $role );
79             }
80              
81             # Alias for Moose/Moo-compatibility
82             sub does {
83 7     7   2115 shift->DOES( @_ );
84             }
85              
86             # Callback which classes consuming this role will call
87             sub __FINALIZE_APPLICATION__ {
88 1     1   2 my ( $me, $target, $args ) = @_;
89 1         2 our ( %CONSUMERS, @METHOD_MODIFIERS );
90              
91             # Ensure a given target only consumes this role once.
92 1 50       3 if ( exists $CONSUMERS{$target} ) {
93 0         0 return;
94             }
95 1         3 $CONSUMERS{$target} = 1;
96              
97 1     1   8 my $type = do { no strict 'refs'; ${"$target\::USES_MITE"} };
  1         1  
  1         334  
  1         8  
  1         2  
  1         4  
98 1 50       3 return if $type ne 'Mite::Class';
99              
100 1         2 my @missing_methods;
101 1 50       3 @missing_methods = ()
102             and Mite::Shim::croak( "$me requires $target to implement methods: " . join q[, ], @missing_methods );
103              
104 1         1 my @roles = ( );
105 1 50       3 my %nextargs = %{ $args || {} };
  1         5  
106 1   50     8 ( $nextargs{-indirect} ||= 0 )++;
107 1 50       2 Mite::Shim::croak( "PANIC!" ) if $nextargs{-indirect} > 100;
108 1         2 for my $role ( @roles ) {
109 0         0 $role->__FINALIZE_APPLICATION__( $target, { %nextargs } );
110             }
111              
112 1         2 my $shim = "Mite::Shim";
113 1         2 for my $modifier_rule ( @METHOD_MODIFIERS ) {
114 0         0 my ( $modification, $names, $coderef ) = @$modifier_rule;
115 0         0 my $handler = "HANDLE_$modification";
116 0         0 $shim->$handler( $target, "class", $names, $coderef );
117             }
118              
119 1         2 return;
120             }
121              
122             {
123             our ( %METHODS ) = (
124             "_assert_blessed_foo" => "_assert_blessed_foo",
125             "_set_foo" => "_set_foo",
126             "foo" => "foo",
127             "foobar" => "foobar",
128             "quux" => "quux"
129             );
130              
131             my %DONE;
132             sub APPLY_TO {
133 2     2   3 my $to = shift;
134 2 100       10 if ( ref $to ) {
135 1         8 my $new_class = CREATE_CLASS( ref $to );
136 1         3 return bless( $to, $new_class );
137             }
138 1 50       3 return if $DONE{$to};
139             {
140 1     1   8 no strict 'refs';
  1         8  
  1         322  
  1         2  
141 1         1 ${"$to\::USES_MITE"} = 'Mite::Class';
  1         5  
142 1         10 for my $method ( keys %METHODS ) {
143 5 50       33 $to->can($method) or *{"$to\::$method"} = \&{ $METHODS{$method} };
  5         18  
  5         15  
144             }
145 1         3 for ( "DOES", "does" ) {
146 2 50   0   10 $to->can( $_ ) or *{"$to\::$_"} = sub { shift->isa( @_ ) };
  0         0  
  0         0  
147             }
148             }
149 1         5 __PACKAGE__->__FINALIZE_APPLICATION__( $to );
150             $MITE_SHIM->HANDLE_around( $to, "class", [ "DOES", "does" ], sub {
151 2     2   5 my ( $next, $self, $role ) = @_;
152 2 50       18 return 1 if $role eq __PACKAGE__;
153 0 0       0 return 1 if $role eq $to;
154 0         0 return $self->$next( $role );
155 1         11 } );
156 1         3 $DONE{$to}++;
157 1         2 return;
158             }
159              
160             sub CREATE_CLASS {
161 1     1   2 my $base = shift;
162 1         3 my $new_class = "$base\::__WITH__::" . __PACKAGE__;
163             {
164 1     1   8 no strict 'refs';
  1         2  
  1         122  
  1         2  
165 1         1 @{"$new_class\::ISA"} = $base;
  1         40  
166             }
167 1         18 APPLY_TO( $new_class );
168 1         2 return $new_class;
169             }
170             }
171              
172             1;
173             }{
174             package MyTest;
175 1     1   7 use strict;
  1         3  
  1         36  
176 1     1   6 use warnings;
  1         1  
  1         40  
177 1     1   6 no warnings qw( once void );
  1         3  
  1         111  
178              
179             our $USES_MITE = "Mite::Class";
180             our $MITE_SHIM = "Mite::Shim";
181             our $MITE_VERSION = "0.012000";
182             # Mite keywords
183             BEGIN {
184 1     1   4 my ( $SHIM, $CALLER ) = ( "Mite::Shim", "MyTest" );
185 1         2 ( *after, *around, *before, *extends, *has, *signature_for, *with ) = do {
186             package Mite::Shim;
187 1     1   6 no warnings 'redefine';
  1         1  
  1         187  
188             (
189 0         0 sub { $SHIM->HANDLE_after( $CALLER, "class", @_ ) },
190 0         0 sub { $SHIM->HANDLE_around( $CALLER, "class", @_ ) },
191 0         0 sub { $SHIM->HANDLE_before( $CALLER, "class", @_ ) },
192             sub {},
193 0         0 sub { $SHIM->HANDLE_has( $CALLER, has => @_ ) },
194 0         0 sub { $SHIM->HANDLE_signature_for( $CALLER, "class", @_ ) },
195 0         0 sub { $SHIM->HANDLE_with( $CALLER, @_ ) },
196 1         51 );
197             };
198             };
199              
200             # Gather metadata for constructor and destructor
201             sub __META__ {
202 1     1   6 no strict 'refs';
  1         1  
  1         673  
203 2   33 2   4 my $class = shift; $class = ref($class) || $class;
  2         13  
204 2         11 my $linear_isa = mro::get_linear_isa( $class );
205             return {
206             BUILD => [
207 3 50       4 map { ( *{$_}{CODE} ) ? ( *{$_}{CODE} ) : () }
  3         16  
  0         0  
208 3         10 map { "$_\::BUILD" } reverse @$linear_isa
209             ],
210             DEMOLISH => [
211 3 50       4 map { ( *{$_}{CODE} ) ? ( *{$_}{CODE} ) : () }
  3         72  
  0         0  
212 2         4 map { "$_\::DEMOLISH" } @$linear_isa
  3         7  
213             ],
214             HAS_BUILDARGS => $class->can('BUILDARGS'),
215             HAS_FOREIGNBUILDARGS => $class->can('FOREIGNBUILDARGS'),
216             };
217             }
218              
219              
220             # Standard Moose/Moo-style constructor
221             sub new {
222 1 50   1   195 my $class = ref($_[0]) ? ref(shift) : shift;
223 1   33     7 my $meta = ( $Mite::META{$class} ||= $class->__META__ );
224 1         3 my $self = bless {}, $class;
225 1 50       6 my $args = $meta->{HAS_BUILDARGS} ? $class->BUILDARGS( @_ ) : { ( @_ == 1 ) ? %{$_[0]} : @_ };
  0 50       0  
226 1         2 my $no_build = delete $args->{__no_BUILD__};
227              
228              
229              
230             # Call BUILD methods
231 1 50 33     4 $self->BUILDALL( $args ) if ( ! $no_build and @{ $meta->{BUILD} || [] } );
  1 50       21  
232              
233             # Unrecognized parameters
234 1 0       3 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 50       0  
  1         3  
  1         4  
235              
236 1         4 return $self;
237             }
238              
239             # Used by constructor to call BUILD methods
240             sub BUILDALL {
241 0     0   0 my $class = ref( $_[0] );
242 0   0     0 my $meta = ( $Mite::META{$class} ||= $class->__META__ );
243 0 0       0 $_->( @_ ) for @{ $meta->{BUILD} || [] };
  0         0  
244             }
245              
246             # Destructor should call DEMOLISH methods
247             sub DESTROY {
248 1     1   1273 my $self = shift;
249 1   33     4 my $class = ref( $self ) || $self;
250 1   33     10 my $meta = ( $Mite::META{$class} ||= $class->__META__ );
251 1 50       5 my $in_global_destruction = defined ${^GLOBAL_PHASE}
252             ? ${^GLOBAL_PHASE} eq 'DESTRUCT'
253             : Devel::GlobalDestruction::in_global_destruction();
254 1 50       2 for my $demolisher ( @{ $meta->{DEMOLISH} || [] } ) {
  1         6  
255 0         0 my $e = do {
256 0         0 local ( $?, $@ );
257 0         0 eval { $demolisher->( $self, $in_global_destruction ) };
  0         0  
258 0         0 $@;
259             };
260 1     1   6 no warnings 'misc'; # avoid (in cleanup) warnings
  1         2  
  1         259  
261 0 0       0 die $e if $e; # rethrow
262             }
263 1         15 return;
264             }
265              
266              
267             # See UNIVERSAL
268             sub DOES {
269 9     9   21 my ( $self, $role ) = @_;
270 9         10 our %DOES;
271 9 50       20 return $DOES{$role} if exists $DOES{$role};
272 9 50       13 return 1 if $role eq __PACKAGE__;
273 9 50 0     18 if ( $INC{'Moose/Util.pm'} and my $meta = Moose::Util::find_meta( ref $self or $self ) ) {
      33        
274 0 0 0     0 $meta->can( 'does_role' ) and $meta->does_role( $role ) and return 1;
275             }
276 9         58 return $self->SUPER::DOES( $role );
277             }
278              
279             # Alias for Moose/Moo-compatibility
280             sub does {
281 8     8   2098 shift->DOES( @_ );
282             }
283              
284             1;
285             }