File Coverage

blib/lib/Mite/Trait/HasAttributes.pm.mite.pm
Criterion Covered Total %
statement 66 92 71.7
branch 5 22 22.7
condition 1 14 7.1
subroutine 15 22 68.1
pod 0 2 0.0
total 87 152 57.2


line stmt bran cond sub pod time code
1             {
2              
3             use strict;
4 109     109   881 use warnings;
  109         311  
  109         3616  
5 109     109   1068 no warnings qw( once void );
  109         269  
  109         3697  
6 109     109   629  
  109         276  
  109         13203  
7             our $USES_MITE = "Mite::Role";
8             our $MITE_SHIM = "Mite::Shim";
9             our $MITE_VERSION = "0.011000";
10              
11             # Mite keywords
12             BEGIN {
13             my ( $SHIM, $CALLER ) =
14 109     109   584 ( "Mite::Shim", "Mite::Trait::HasAttributes" );
15             (
16             *after, *around, *before,
17             *field, *has, *param,
18             *requires, *signature_for, *with
19             )
20             = do {
21 109         284  
22             no warnings 'redefine';
23             (
24 109     109   1017 sub { $SHIM->HANDLE_after( $CALLER, "role", @_ ) },
  109         292  
  109         25732  
25             sub { $SHIM->HANDLE_around( $CALLER, "role", @_ ) },
26 0     0   0 sub { $SHIM->HANDLE_before( $CALLER, "role", @_ ) },
27 327     327   983 sub { $SHIM->HANDLE_has( $CALLER, field => @_ ) },
28 109     109   8513 sub { $SHIM->HANDLE_has( $CALLER, has => @_ ) },
29 0     0   0 sub { $SHIM->HANDLE_has( $CALLER, param => @_ ) },
30 109     109   305474 sub { },
31 0     0   0 sub { $SHIM->HANDLE_signature_for( $CALLER, "role", @_ ) },
32       109     sub { $SHIM->HANDLE_with( $CALLER, @_ ) },
33 109     109   183329 );
34 0     0   0 }
35 109         21117  
36             # Mite imports
37             BEGIN {
38             require Scalar::Util;
39             *STRICT = \&Mite::Shim::STRICT;
40             *bare = \&Mite::Shim::bare;
41 109     109   848 *blessed = \&Scalar::Util::blessed;
42 109         446 *carp = \&Mite::Shim::carp;
43 109         325 *confess = \&Mite::Shim::confess;
44 109         297 *croak = \&Mite::Shim::croak;
45 109         300 *false = \&Mite::Shim::false;
46 109         281 *guard = \&Mite::Shim::guard;
47 109         302 *lazy = \&Mite::Shim::lazy;
48 109         261 *lock = \&Mite::Shim::lock;
49 109         287 *ro = \&Mite::Shim::ro;
50 109         285 *rw = \&Mite::Shim::rw;
51 109         324 *rwp = \&Mite::Shim::rwp;
52 109         264 *true = \&Mite::Shim::true;
53 109         275 *unlock = \&Mite::Shim::unlock;
54 109         260 }
55 109         270  
56 109         4124 # Gather metadata for constructor and destructor
57             no strict 'refs';
58             my $class = shift;
59             $class = ref($class) || $class;
60             my $linear_isa = mro::get_linear_isa($class);
61 109     109   872 return {
  109         289  
  109         56065  
62 0     0   0 BUILD => [
63 0   0     0 map { ( *{$_}{CODE} ) ? ( *{$_}{CODE} ) : () }
64 0         0 map { "$_\::BUILD" } reverse @$linear_isa
65             ],
66             DEMOLISH => [
67 0 0       0 map { ( *{$_}{CODE} ) ? ( *{$_}{CODE} ) : () }
  0         0  
  0         0  
68 0         0 map { "$_\::DEMOLISH" } @$linear_isa
69             ],
70             HAS_BUILDARGS => $class->can('BUILDARGS'),
71 0 0       0 HAS_FOREIGNBUILDARGS => $class->can('FOREIGNBUILDARGS'),
  0         0  
  0         0  
72 0         0 };
  0         0  
73             }
74              
75             # See UNIVERSAL
76             my ( $self, $role ) = @_;
77             our %DOES;
78             return $DOES{$role} if exists $DOES{$role};
79             return 1 if $role eq __PACKAGE__;
80             if ( $INC{'Moose/Util.pm'}
81 0     0 0 0 and my $meta = Moose::Util::find_meta( ref $self or $self ) )
82 0         0 {
83 0 0       0 $meta->can('does_role') and $meta->does_role($role) and return 1;
84 0 0       0 }
85 0 0 0     0 return $self->SUPER::DOES($role);
      0        
86             }
87              
88 0 0 0     0 # Alias for Moose/Moo-compatibility
89             shift->DOES(@_);
90 0         0 }
91              
92             # Method signatures
93             our %SIGNATURE_FOR;
94              
95 0     0 0 0 $SIGNATURE_FOR{"add_attributes"} = sub {
96             my $__NEXT__ = shift;
97              
98             my ( @out, %tmp, $tmp, $dtmp, @head );
99              
100             @_ >= 1
101             or
102             croak( "Wrong number of parameters in signature for %s: got %d, %s",
103             "add_attributes", scalar(@_), "expected exactly 1 parameters" );
104              
105             @head = splice( @_, 0, 1 );
106              
107             # Parameter invocant (type: Defined)
108             ( defined( $head[0] ) )
109             or croak(
110             "Type check failed in signature for add_attributes: %s should be %s",
111             "\$_[0]", "Defined"
112             );
113              
114             my $SLURPY = [ @_[ 0 .. $#_ ] ];
115              
116             # Parameter $SLURPY (type: Slurpy[ArrayRef[Mite::Attribute]])
117             (
118             do {
119              
120             ( ref($SLURPY) eq 'ARRAY' ) and do {
121             my $ok = 1;
122             for my $i ( @{$SLURPY} ) {
123             ( $ok = 0, last )
124             unless (
125             do {
126             use Scalar::Util ();
127             Scalar::Util::blessed($i)
128             and $i->isa(q[Mite::Attribute]);
129             }
130             );
131             };
132             $ok;
133 109     109   1059 }
  109         317  
  109         22861  
134             )
135             or croak(
136             "Type check failed in signature for add_attributes: %s should be %s",
137             "\$SLURPY", "ArrayRef[Mite::Attribute]"
138             );
139             push( @out, $SLURPY );
140              
141             do { @_ = ( @head, @out ); goto $__NEXT__ };
142             };
143              
144             # Callback which classes consuming this role will call
145             my ( $me, $target, $args ) = @_;
146             our ( %CONSUMERS, @METHOD_MODIFIERS );
147              
148             # Ensure a given target only consumes this role once.
149             if ( exists $CONSUMERS{$target} ) {
150             return;
151             }
152             $CONSUMERS{$target} = 1;
153              
154 124     124   553 my $type = do { no strict 'refs'; ${"$target\::USES_MITE"} };
155 124         268 return if $type ne 'Mite::Class';
156              
157             my @missing_methods;
158 124 50       585 @missing_methods = grep( !$target->can($_),
159 0         0 "_compile_mop_attributes", "_compile_pragmas",
160             "_function_for_croak", "compilation_stages",
161 124         433 "inject_mite_functions" )
162             and croak( "$me requires $target to implement methods: " . join q[, ],
163 109     109   974 @missing_methods );
  109         446  
  109         32879  
  124         311  
  124         270  
  124         742  
164 124 50       642  
165             my @roles = ();
166 124         319 my %nextargs = %{ $args || {} };
167 124 50       2747 ( $nextargs{-indirect} ||= 0 )++;
168             croak("PANIC!") if $nextargs{-indirect} > 100;
169             for my $role (@roles) {
170             $role->__FINALIZE_APPLICATION__( $target, {%nextargs} );
171             }
172              
173             my $shim = "Mite::Shim";
174 124         425 for my $modifier_rule (@METHOD_MODIFIERS) {
175 124 50       313 my ( $modification, $names, $coderef ) = @$modifier_rule;
  124         1151  
176 124   50     1275 my $handler = "HANDLE_$modification";
177 124 50       658 $shim->$handler( $target, "class", $names, $coderef );
178 124         447 }
179 0         0  
180             return;
181             }
182 124         366  
183 124         451 1;