File Coverage

blib/lib/Mite/Role.pm.mite.pm
Criterion Covered Total %
statement 180 262 68.7
branch 46 170 27.0
condition 7 45 15.5
subroutine 40 52 76.9
pod 0 16 0.0
total 273 545 50.0


line stmt bran cond sub pod time code
1             {
2              
3             use strict;
4 15     15   123 use warnings;
  15         59  
  15         532  
5 15     15   91 no warnings qw( once void );
  15         40  
  15         508  
6 15     15   95  
  15         42  
  15         1980  
7             our $USES_MITE = "Mite::Class";
8             our $MITE_SHIM = "Mite::Shim";
9             our $MITE_VERSION = "0.011000";
10              
11             # Mite keywords
12             BEGIN {
13             my ( $SHIM, $CALLER ) = ( "Mite::Shim", "Mite::Role" );
14 15     15   88 (
15             *after, *around, *before, *extends, *field,
16             *has, *param, *signature_for, *with
17             )
18             = do {
19 15         48  
20             no warnings 'redefine';
21             (
22 15     15   112 sub { $SHIM->HANDLE_after( $CALLER, "class", @_ ) },
  15         42  
  15         3566  
23             sub { $SHIM->HANDLE_around( $CALLER, "class", @_ ) },
24 0     0   0 sub { $SHIM->HANDLE_before( $CALLER, "class", @_ ) },
25 15     15   82 sub { },
26 0     0   0 sub { $SHIM->HANDLE_has( $CALLER, field => @_ ) },
27       15     sub { $SHIM->HANDLE_has( $CALLER, has => @_ ) },
28 0     0   0 sub { $SHIM->HANDLE_has( $CALLER, param => @_ ) },
29 0     0   0 sub { $SHIM->HANDLE_signature_for( $CALLER, "class", @_ ) },
30 0     0   0 sub { $SHIM->HANDLE_with( $CALLER, @_ ) },
31 0     0   0 );
32 15     15   124 }
33 15         2987  
34             # Mite imports
35             BEGIN {
36             require Scalar::Util;
37             *STRICT = \&Mite::Shim::STRICT;
38             *bare = \&Mite::Shim::bare;
39 15     15   122 *blessed = \&Scalar::Util::blessed;
40 15         90 *carp = \&Mite::Shim::carp;
41 15         40 *confess = \&Mite::Shim::confess;
42 15         40 *croak = \&Mite::Shim::croak;
43 15         54 *false = \&Mite::Shim::false;
44 15         36 *guard = \&Mite::Shim::guard;
45 15         35 *lazy = \&Mite::Shim::lazy;
46 15         35 *lock = \&Mite::Shim::lock;
47 15         41 *ro = \&Mite::Shim::ro;
48 15         35 *rw = \&Mite::Shim::rw;
49 15         55 *rwp = \&Mite::Shim::rwp;
50 15         32 *true = \&Mite::Shim::true;
51 15         30 *unlock = \&Mite::Shim::unlock;
52 15         37 }
53 15         44  
54 15         784 BEGIN {
55             require Mite::Package;
56              
57             use mro 'c3';
58 15     15   722 our @ISA;
59             push @ISA, "Mite::Package";
60 15     15   116 }
  15         44  
  15         137  
61 15         58  
62 15         16843 # Standard Moose/Moo-style constructor
63             my $class = ref( $_[0] ) ? ref(shift) : shift;
64             my $meta = ( $Mite::META{$class} ||= $class->__META__ );
65             my $self = bless {}, $class;
66             my $args =
67 12 50   12 0 63 $meta->{HAS_BUILDARGS}
68 12   66     146 ? $class->BUILDARGS(@_)
69 12         45 : { ( @_ == 1 ) ? %{ $_[0] } : @_ };
70             my $no_build = delete $args->{__no_BUILD__};
71              
72             # Attribute name (type: ValidClassName)
73 12 50       104 # has declaration, file lib/Mite/Package.pm, line 11
  0 50       0  
74 12         35 croak "Missing key in constructor: name" unless exists $args->{"name"};
75             (
76             (
77             do {
78 12 50       56  
79             defined( $args->{"name"} ) and do {
80             ref( \$args->{"name"} ) eq 'SCALAR'
81             or ref( \( my $val = $args->{"name"} ) ) eq 'SCALAR';
82             }
83             )
84 12 50       73 && (
85             do {
86 12 50       106 local $_ = $args->{"name"};
87             /\A[^\W0-9]\w*(?:::[^\W0-9]\w*)*\z/;
88             }
89             )
90             )
91 12 50 33     27 or croak "Type check failed in constructor: %s should be %s", "name",
92 12         47 "ValidClassName";
93 12         147 $self->{"name"} = $args->{"name"};
94              
95             # Attribute shim_name (type: ValidClassName)
96             # has declaration, file lib/Mite/Package.pm, line 23
97             if ( exists $args->{"shim_name"} ) {
98             (
99 12         91 (
100             do {
101              
102             defined( $args->{"shim_name"} ) and do {
103 12 50       50 ref( \$args->{"shim_name"} ) eq 'SCALAR'
104             or ref( \( my $val = $args->{"shim_name"} ) ) eq
105             'SCALAR';
106             }
107             )
108             && (
109 0 0       0 do {
110             local $_ = $args->{"shim_name"};
111 0 0       0 /\A[^\W0-9]\w*(?:::[^\W0-9]\w*)*\z/;
112             }
113             )
114             )
115             or croak "Type check failed in constructor: %s should be %s",
116             "shim_name", "ValidClassName";
117 0 0 0     0 $self->{"shim_name"} = $args->{"shim_name"};
118 0         0 }
119 0         0  
120             # Attribute source (type: Mite::Source)
121             # has declaration, file lib/Mite/Package.pm, line 25
122             if ( exists $args->{"source"} ) {
123             blessed( $args->{"source"} )
124             && $args->{"source"}->isa("Mite::Source")
125 0         0 or croak "Type check failed in constructor: %s should be %s",
126             "source", "Mite::Source";
127             $self->{"source"} = $args->{"source"};
128             }
129             require Scalar::Util && Scalar::Util::weaken( $self->{"source"} )
130 12 100       47 if ref $self->{"source"};
131              
132 10 50 33     241 # Attribute imported_functions (type: Map[MethodName,Str])
133             # has declaration, file lib/Mite/Package.pm, line 34
134             do {
135 10         36 my $value =
136             exists( $args->{"imported_functions"} )
137             ? $args->{"imported_functions"}
138 12 100 33     155 : $self->_build_imported_functions;
139             do {
140              
141             ( ref($value) eq 'HASH' ) and do {
142 12         24 my $ok = 1;
143             for my $v ( values %{$value} ) {
144             ( $ok = 0, last ) unless do {
145 12 50       175  
146             defined($v) and do {
147 12 50       25 ref( \$v ) eq 'SCALAR'
148             or ref( \( my $val = $v ) ) eq 'SCALAR';
149             }
150 12 50       73 }
151 12         37 };
152 12         22 for my $k ( keys %{$value} ) {
  12         56  
153 0 0       0 ( $ok = 0, last )
154             unless (
155             (
156 0 0       0 do {
157 0 0       0  
158             defined($k) and do {
159             ref( \$k ) eq 'SCALAR'
160             or ref( \( my $val = $k ) ) eq
161             'SCALAR';
162 12         30 }
  12         32  
163             }
164             )
165             && ( do { local $_ = $k; /\A[^\W0-9]\w*\z/ } )
166             );
167             };
168             $ok;
169 0 0       0 }
170 0 0       0 or croak "Type check failed in constructor: %s should be %s",
171             "imported_functions", "Map[MethodName,Str]";
172             $self->{"imported_functions"} = $value;
173             };
174              
175             # Attribute imported_keywords (type: Map[MethodName,Str])
176 0 0 0     0 # has declaration, file lib/Mite/Package.pm, line 39
  0         0  
  0         0  
177             do {
178             my $value =
179 12         83 exists( $args->{"imported_keywords"} )
180             ? $args->{"imported_keywords"}
181             : $self->_build_imported_keywords;
182             do {
183              
184 12         43 ( ref($value) eq 'HASH' ) and do {
185             my $ok = 1;
186             for my $v ( values %{$value} ) {
187             ( $ok = 0, last ) unless do {
188              
189 12         24 defined($v) and do {
190             ref( \$v ) eq 'SCALAR'
191             or ref( \( my $val = $v ) ) eq 'SCALAR';
192 12 50       101 }
193             }
194 12 50       24 };
195             for my $k ( keys %{$value} ) {
196             ( $ok = 0, last )
197 12 50       71 unless (
198 12         47 (
199 12         27 do {
  12         48  
200 0 0       0  
201             defined($k) and do {
202             ref( \$k ) eq 'SCALAR'
203 0 0       0 or ref( \( my $val = $k ) ) eq
204 0 0       0 'SCALAR';
205             }
206             }
207             )
208             && ( do { local $_ = $k; /\A[^\W0-9]\w*\z/ } )
209 12         27 );
  12         48  
210             };
211             $ok;
212             }
213             or croak "Type check failed in constructor: %s should be %s",
214             "imported_keywords", "Map[MethodName,Str]";
215             $self->{"imported_keywords"} = $value;
216 0 0       0 };
217 0 0       0  
218             # Attribute arg
219             # has declaration, file lib/Mite/Package.pm, line 41
220             $self->{"arg"} = ( exists( $args->{"arg"} ) ? $args->{"arg"} : {} );
221              
222             # Attribute attributes (type: HashRef[Mite::Attribute])
223 0 0 0     0 # has declaration, file lib/Mite/Trait/HasAttributes.pm, line 16
  0         0  
  0         0  
224             do {
225             my $value =
226 12         58 exists( $args->{"attributes"} )
227             ? $args->{"attributes"}
228             : $Mite::Trait::HasAttributes::__attributes_DEFAULT__
229             ->($self);
230             do {
231 12         40  
232             ( ref($value) eq 'HASH' ) and do {
233             my $ok = 1;
234             for my $i ( values %{$value} ) {
235             ( $ok = 0, last )
236 12 50       102 unless (
237             do {
238             use Scalar::Util ();
239             Scalar::Util::blessed($i)
240 12         35 and $i->isa(q[Mite::Attribute]);
241             }
242             );
243 12 100       86 };
244             $ok;
245             }
246 12 50       24 or croak "Type check failed in constructor: %s should be %s",
247             "attributes", "HashRef[Mite::Attribute]";
248             $self->{"attributes"} = $value;
249 12 50       60 };
250 12         27  
251 12         22 # Attribute roles (type: ArrayRef[Mite::Role])
  12         58  
252             # has declaration, file lib/Mite/Trait/HasRoles.pm, line 19
253             do {
254 0 0       0 my $value =
255 15     15   150 exists( $args->{"roles"} )
  15         38  
  15         1673  
256 0 0       0 ? $args->{"roles"}
257             : $self->_build_roles;
258             do {
259              
260             ( ref($value) eq 'ARRAY' ) and do {
261 12         62 my $ok = 1;
262             for my $i ( @{$value} ) {
263             ( $ok = 0, last )
264             unless (
265             do {
266 12         34 use Scalar::Util ();
267             Scalar::Util::blessed($i)
268             and $i->isa(q[Mite::Role]);
269             }
270             );
271 12         21 };
272             $ok;
273             }
274 12 100       71 or croak "Type check failed in constructor: %s should be %s",
275             "roles", "ArrayRef[Mite::Role]";
276 12 50       30 $self->{"roles"} = $value;
277             };
278              
279 12 50       62 # Attribute role_args (type: Map[NonEmptyStr,HashRef|Undef])
280 12         29 # has declaration, file lib/Mite/Trait/HasRoles.pm, line 24
281 12         30 do {
  12         35  
282             my $value =
283             exists( $args->{"role_args"} )
284 0 0       0 ? $args->{"role_args"}
285 15     15   110 : $self->_build_role_args;
  15         43  
  15         4346  
286 0 0       0 do {
287              
288             ( ref($value) eq 'HASH' ) and do {
289             my $ok = 1;
290             for my $v ( values %{$value} ) {
291 12         86 ( $ok = 0, last ) unless do {
292              
293             ( ( ref($v) eq 'HASH' ) or ( !defined($v) ) );
294             }
295             };
296 12         59 for my $k ( keys %{$value} ) {
297             ( $ok = 0, last )
298             unless (
299             (
300             do {
301 12         32  
302             defined($k) and do {
303             ref( \$k ) eq 'SCALAR'
304 12 50       102 or ref( \( my $val = $k ) ) eq
305             'SCALAR';
306 12 50       28 }
307             }
308             )
309 12 50       61 && ( length($k) > 0 )
310 12         30 );
311 12         25 };
  12         51  
312 0 0       0 $ok;
313             }
314             or croak "Type check failed in constructor: %s should be %s",
315 0 0       0 "role_args", "Map[NonEmptyStr,HashRef|Undef]";
316             $self->{"role_args"} = $value;
317             };
318 12         25  
  12         35  
319             # Attribute method_signatures (type: Map[MethodName,Mite::Signature])
320             # has declaration, file lib/Mite/Trait/HasMethods.pm, line 20
321             do {
322 0 0 0     0 my $value =
323             exists( $args->{"method_signatures"} )
324             ? $args->{"method_signatures"}
325 0 0       0 : $self->_build_method_signatures;
326 0 0       0 do {
327              
328             ( ref($value) eq 'HASH' ) and do {
329             my $ok = 1;
330             for my $v ( values %{$value} ) {
331             ( $ok = 0, last )
332             unless (
333             do {
334             use Scalar::Util ();
335 12         63 Scalar::Util::blessed($v)
336             and $v->isa(q[Mite::Signature]);
337             }
338             );
339             };
340 12         53 for my $k ( keys %{$value} ) {
341             ( $ok = 0, last )
342             unless (
343             (
344             do {
345 12         25  
346             defined($k) and do {
347             ref( \$k ) eq 'SCALAR'
348 12 50       77 or ref( \( my $val = $k ) ) eq
349             'SCALAR';
350 12 50       29 }
351             }
352             )
353 12 50       78 && ( do { local $_ = $k; /\A[^\W0-9]\w*\z/ } )
354 12         28 );
355 12         29 };
  12         51  
356             $ok;
357             }
358 0 0       0 or croak "Type check failed in constructor: %s should be %s",
359 15     15   117 "method_signatures", "Map[MethodName,Mite::Signature]";
  15         35  
  15         18492  
360 0 0       0 $self->{"method_signatures"} = $value;
361             };
362              
363             # Attribute required_methods (type: ArrayRef[MethodName])
364             # has declaration, file lib/Mite/Trait/HasRequiredMethods.pm, line 14
365 12         25 do {
  12         40  
366             my $value =
367             exists( $args->{"required_methods"} )
368             ? $args->{"required_methods"}
369             : $self->_build_required_methods;
370             do {
371              
372 0 0       0 ( ref($value) eq 'ARRAY' ) and do {
373 0 0       0 my $ok = 1;
374             for my $i ( @{$value} ) {
375             ( $ok = 0, last )
376             unless (
377             (
378             do {
379 0 0 0     0  
  0         0  
  0         0  
380             defined($i) and do {
381             ref( \$i ) eq 'SCALAR'
382 12         60 or ref( \( my $val = $i ) ) eq
383             'SCALAR';
384             }
385             }
386             )
387 12         38 && ( do { local $_ = $i; /\A[^\W0-9]\w*\z/ } )
388             );
389             };
390             $ok;
391             }
392 12         22 or croak "Type check failed in constructor: %s should be %s",
393             "required_methods", "ArrayRef[MethodName]";
394             $self->{"required_methods"} = $value;
395 12 100       56 };
396              
397 12 50       29 # Call BUILD methods
398             $self->BUILDALL($args) if ( !$no_build and @{ $meta->{BUILD} || [] } );
399              
400 12 50       54 # Unrecognized parameters
401 12         30 my @unknown = grep not(
402 12         27 /\A(?:a(?:rg|ttributes)|imported_(?:functions|keywords)|method_signatures|name|r(?:equired_methods|ole(?:_args|s))|s(?:him_name|ource))\z/
  12         41  
403             ), keys %{$args};
404             @unknown
405             and croak(
406             "Unexpected keys in constructor: " . join( q[, ], sort @unknown ) );
407              
408             return $self;
409 1 50       5 }
410 1 50       7  
411             my $__XS = !$ENV{PERL_ONLY}
412             && eval { require Class::XSAccessor; Class::XSAccessor->VERSION("1.19") };
413              
414             # Accessors for attributes
415             # has declaration, file lib/Mite/Trait/HasAttributes.pm, line 16
416 1 50 33     2 if ($__XS) {
  1         3  
  1         10  
417             Class::XSAccessor->import(
418             chained => 1,
419 12         50 "getters" => { "attributes" => "attributes" },
420             );
421             }
422             else {
423             *attributes = sub {
424 12         41 @_ == 1 or croak('Reader "attributes" usage: $self->attributes()');
425             $_[0]{"attributes"};
426             };
427             }
428 12 50 33     66  
  12 50       240  
429             # Accessors for method_signatures
430             # has declaration, file lib/Mite/Trait/HasMethods.pm, line 20
431             if ($__XS) {
432             Class::XSAccessor->import(
433 12         36 chained => 1,
  12         156  
434             "getters" => { "method_signatures" => "method_signatures" },
435 12 50       61 );
436             }
437             else {
438 12         127 *method_signatures = sub {
439             @_ == 1
440             or croak(
441             'Reader "method_signatures" usage: $self->method_signatures()');
442             $_[0]{"method_signatures"};
443             };
444             }
445              
446             # Accessors for required_methods
447             # has declaration, file lib/Mite/Trait/HasRequiredMethods.pm, line 14
448             if ($__XS) {
449             Class::XSAccessor->import(
450             chained => 1,
451             "getters" => { "required_methods" => "required_methods" },
452             );
453             }
454             else {
455             *required_methods = sub {
456             @_ == 1
457             or croak(
458             'Reader "required_methods" usage: $self->required_methods()');
459             $_[0]{"required_methods"};
460             };
461             }
462              
463             # Accessors for role_args
464             # has declaration, file lib/Mite/Trait/HasRoles.pm, line 24
465             @_ > 1
466             ? do {
467             do {
468              
469             ( ref( $_[1] ) eq 'HASH' ) and do {
470             my $ok = 1;
471             for my $v ( values %{ $_[1] } ) {
472             ( $ok = 0, last ) unless do {
473              
474             ( ( ref($v) eq 'HASH' ) or ( !defined($v) ) );
475             }
476             };
477             for my $k ( keys %{ $_[1] } ) {
478             ( $ok = 0, last )
479             unless (
480             (
481             do {
482              
483             defined($k) and do {
484             ref( \$k ) eq 'SCALAR'
485             or ref( \( my $val = $k ) ) eq
486             'SCALAR';
487             }
488             }
489             )
490             && ( length($k) > 0 )
491             );
492             };
493             $ok;
494             }
495             or croak( "Type check failed in %s: value should be %s",
496             "accessor", "Map[NonEmptyStr,HashRef|Undef]" );
497             $_[0]{"role_args"} = $_[1];
498 0 0       0 $_[0];
499             }
500             : ( $_[0]{"role_args"} );
501 0 0       0 }
502 0         0  
503 0         0 # Accessors for roles
  0         0  
504 0 0       0 # has declaration, file lib/Mite/Trait/HasRoles.pm, line 19
505             @_ > 1
506             ? do {
507 0 0       0 do {
508              
509             ( ref( $_[1] ) eq 'ARRAY' ) and do {
510 0         0 my $ok = 1;
  0         0  
511             for my $i ( @{ $_[1] } ) {
512             ( $ok = 0, last )
513             unless (
514 0 0 0     0 do {
515             use Scalar::Util ();
516             Scalar::Util::blessed($i)
517 0 0       0 and $i->isa(q[Mite::Role]);
518 0 0       0 }
519             );
520             };
521             $ok;
522             }
523             or croak( "Type check failed in %s: value should be %s",
524             "accessor", "ArrayRef[Mite::Role]" );
525             $_[0]{"roles"} = $_[1];
526             $_[0];
527 0         0 }
528             : ( $_[0]{"roles"} );
529             }
530              
531             BEGIN {
532 0         0 require Mite::Trait::HasRequiredMethods;
533 0         0 require Mite::Trait::HasAttributes;
534             require Mite::Trait::HasRoles;
535 8 50   8 0 56 require Mite::Trait::HasMethods;
536             require Mite::Trait::HasMOP;
537              
538             our %DOES = (
539             "Mite::Role" => 1,
540             "Mite::Trait::HasRequiredMethods" => 1,
541             "Mite::Trait::HasAttributes" => 1,
542             "Mite::Trait::HasRoles" => 1,
543 0 0       0 "Mite::Trait::HasMethods" => 1,
544             "Mite::Trait::HasMOP" => 1
545             );
546 0 0       0 }
547 0         0  
548 0         0 # See UNIVERSAL
  0         0  
549             my ( $self, $role ) = @_;
550             our %DOES;
551 0 0       0 return $DOES{$role} if exists $DOES{$role};
552 15     15   146 return 1 if $role eq __PACKAGE__;
  15         57  
  15         3090  
553 0 0       0 if ( $INC{'Moose/Util.pm'}
554             and my $meta = Moose::Util::find_meta( ref $self or $self ) )
555             {
556             $meta->can('does_role') and $meta->does_role($role) and return 1;
557             }
558 0         0 return $self->SUPER::DOES($role);
559             }
560              
561             # Alias for Moose/Moo-compatibility
562             shift->DOES(@_);
563 0         0 }
564 0         0  
565             # Methods from roles
566 59 50   59 0 447  
567             goto \&Mite::Trait::HasMethods::_build_method_signatures;
568             }
569              
570 15     15   6461 goto
571 15         121 \&Mite::Trait::HasRequiredMethods::_build_required_methods;
572 15         77 }
573 15         65  
574 15         70 goto \&Mite::Trait::HasRoles::_build_role_args;
575             }
576 15         12869  
577             goto
578             \&Mite::Trait::HasAttributes::_compile_attribute_accessors;
579             }
580              
581             goto \&Mite::Trait::HasRoles::_compile_composed_methods;
582             }
583              
584             goto \&Mite::Trait::HasAttributes::_compile_init_attributes;
585             }
586              
587             goto \&Mite::Trait::HasMethods::_compile_method_signatures;
588 0     0 0 0 }
589 0         0  
590 0 0       0 goto \&Mite::Trait::HasMOP::_compile_mop_attributes;
591 0 0       0 }
592 0 0 0     0  
      0        
593             goto \&Mite::Trait::HasMOP::_compile_mop_methods;
594             }
595 0 0 0     0  
596             goto \&Mite::Trait::HasMOP::_compile_mop_postamble;
597 0         0 }
598              
599             goto \&Mite::Trait::HasMOP::_compile_mop_required_methods;
600             }
601              
602 0     0 0 0 goto \&Mite::Trait::HasAttributes::add_attribute;
603             }
604              
605             goto \&Mite::Trait::HasAttributes::add_attributes;
606 34     34   101 }
607              
608             goto \&Mite::Trait::HasMethods::add_method_signature;
609 12     12   68 }
610              
611             goto \&Mite::Trait::HasRequiredMethods::add_required_methods;
612             }
613              
614 10     10   40 goto \&Mite::Trait::HasRoles::add_roles_by_name;
615             }
616              
617             goto \&Mite::Trait::HasAttributes::all_attributes;
618 12     12   76 }
619              
620 10     10   58 goto \&Mite::Trait::HasAttributes::extend_attribute;
621             }
622              
623             goto \&Mite::Trait::HasRoles::handle_with_keyword;
624 1     1   6 }
625              
626             goto \&Mite::Trait::HasRoles::methods_to_import_from_roles;
627             }
628 10     10   41  
629             goto \&Mite::Trait::HasMethods::native_methods;
630 10     10   42 }
631              
632             1;