File Coverage

blib/lib/Mite/Role.pm.mite.pm
Criterion Covered Total %
statement 178 258 68.9
branch 46 166 27.7
condition 7 36 19.4
subroutine 40 52 76.9
pod 0 16 0.0
total 271 528 51.3


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