Filename | /opt/perl-5.18.1/lib/site_perl/5.18.1/darwin-thread-multi-2level/Mouse/Meta/Class.pm |
Statements | Executed 72 statements in 3.40ms |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
1 | 1 | 1 | 61µs | 300µs | add_attribute | Mouse::Meta::Class::
1 | 1 | 1 | 58µs | 106µs | make_immutable | Mouse::Meta::Class::
1 | 1 | 1 | 39µs | 46µs | _calculate_all_attributes | Mouse::Meta::Class::
2 | 1 | 1 | 32µs | 74µs | superclasses | Mouse::Meta::Class::
1 | 1 | 1 | 20µs | 67µs | BEGIN@2 | Mouse::Meta::Class::
1 | 1 | 1 | 16µs | 17µs | verify_superclass | Mouse::Meta::Class::
1 | 1 | 1 | 12µs | 12µs | _construct_meta | Mouse::Meta::Class::
1 | 1 | 1 | 9µs | 23µs | BEGIN@26 | Mouse::Meta::Class::
1 | 1 | 1 | 4µs | 4µs | _invalidate_metaclass_cache (xsub) | Mouse::Meta::Class::
1 | 1 | 1 | 4µs | 4µs | BEGIN@6 | Mouse::Meta::Class::
1 | 1 | 1 | 4µs | 4µs | BEGIN@4 | Mouse::Meta::Class::
1 | 1 | 1 | 4µs | 4µs | immutable_options | Mouse::Meta::Class::
1 | 1 | 1 | 2µs | 2µs | strict_constructor (xsub) | Mouse::Meta::Class::
1 | 1 | 1 | 1µs | 1µs | attribute_metaclass (xsub) | Mouse::Meta::Class::
1 | 1 | 1 | 1µs | 1µs | CORE:sort (opcode) | Mouse::Meta::Class::
1 | 1 | 1 | 1µs | 1µs | linearized_isa (xsub) | Mouse::Meta::Class::
1 | 1 | 1 | 1µs | 1µs | constructor_class (xsub) | Mouse::Meta::Class::
1 | 1 | 1 | 900ns | 900ns | CORE:subst (opcode) | Mouse::Meta::Class::
1 | 1 | 1 | 800ns | 800ns | destructor_class (xsub) | Mouse::Meta::Class::
1 | 1 | 1 | 800ns | 800ns | is_immutable (xsub) | Mouse::Meta::Class::
1 | 1 | 1 | 600ns | 600ns | is_anon_class (xsub) | Mouse::Meta::Class::
0 | 0 | 0 | 0s | 0s | __ANON__[:356] | Mouse::Meta::Class::
0 | 0 | 0 | 0s | 0s | __ANON__[:381] | Mouse::Meta::Class::
0 | 0 | 0 | 0s | 0s | __ANON__[:419] | Mouse::Meta::Class::
0 | 0 | 0 | 0s | 0s | __ANON__[:439] | Mouse::Meta::Class::
0 | 0 | 0 | 0s | 0s | _collect_roles | Mouse::Meta::Class::
0 | 0 | 0 | 0s | 0s | _install_modifier | Mouse::Meta::Class::
0 | 0 | 0 | 0s | 0s | _reconcile_with_superclass_meta | Mouse::Meta::Class::
0 | 0 | 0 | 0s | 0s | add_after_method_modifier | Mouse::Meta::Class::
0 | 0 | 0 | 0s | 0s | add_around_method_modifier | Mouse::Meta::Class::
0 | 0 | 0 | 0s | 0s | add_augment_method_modifier | Mouse::Meta::Class::
0 | 0 | 0 | 0s | 0s | add_before_method_modifier | Mouse::Meta::Class::
0 | 0 | 0 | 0s | 0s | add_override_method_modifier | Mouse::Meta::Class::
0 | 0 | 0 | 0s | 0s | calculate_all_roles | Mouse::Meta::Class::
0 | 0 | 0 | 0s | 0s | create_anon_class | Mouse::Meta::Class::
0 | 0 | 0 | 0s | 0s | does_role | Mouse::Meta::Class::
0 | 0 | 0 | 0s | 0s | find_attribute_by_name | Mouse::Meta::Class::
0 | 0 | 0 | 0s | 0s | find_method_by_name | Mouse::Meta::Class::
0 | 0 | 0 | 0s | 0s | get_all_method_names | Mouse::Meta::Class::
0 | 0 | 0 | 0s | 0s | get_all_methods | Mouse::Meta::Class::
0 | 0 | 0 | 0s | 0s | inherit_from_foreign_class | Mouse::Meta::Class::
0 | 0 | 0 | 0s | 0s | is_mutable | Mouse::Meta::Class::
0 | 0 | 0 | 0s | 0s | make_mutable | Mouse::Meta::Class::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | package Mouse::Meta::Class; | ||||
2 | 2 | 34µs | 2 | 114µs | # spent 67µs (20+47) within Mouse::Meta::Class::BEGIN@2 which was called:
# once (20µs+47µs) by Mouse::BEGIN@14 at line 2 # spent 67µs making 1 call to Mouse::Meta::Class::BEGIN@2
# spent 47µs making 1 call to Mouse::Exporter::do_import |
3 | |||||
4 | 2 | 28µs | 1 | 4µs | # spent 4µs within Mouse::Meta::Class::BEGIN@4 which was called:
# once (4µs+0s) by Mouse::BEGIN@14 at line 4 # spent 4µs making 1 call to Mouse::Meta::Class::BEGIN@4 |
5 | |||||
6 | 2 | 119µs | 1 | 4µs | # spent 4µs within Mouse::Meta::Class::BEGIN@6 which was called:
# once (4µs+0s) by Mouse::BEGIN@14 at line 6 # spent 4µs making 1 call to Mouse::Meta::Class::BEGIN@6 |
7 | 1 | 8µs | our @ISA = qw(Mouse::Meta::Module); | ||
8 | |||||
9 | 1 | 700ns | our @CARP_NOT = qw(Mouse); # trust Mouse | ||
10 | |||||
11 | sub attribute_metaclass; | ||||
12 | sub method_metaclass; | ||||
13 | |||||
14 | sub constructor_class; | ||||
15 | sub destructor_class; | ||||
16 | |||||
17 | |||||
18 | # spent 12µs within Mouse::Meta::Class::_construct_meta which was called:
# once (12µs+0s) by Mouse::Meta::Module::initialize at line 23 of Mouse/Meta/Module.pm | ||||
19 | 1 | 900ns | my($class, %args) = @_; | ||
20 | |||||
21 | 1 | 1µs | $args{attributes} = {}; | ||
22 | 1 | 400ns | $args{methods} = {}; | ||
23 | 1 | 800ns | $args{roles} = []; | ||
24 | |||||
25 | 1 | 500ns | $args{superclasses} = do { | ||
26 | 2 | 2.97ms | 2 | 37µs | # spent 23µs (9+14) within Mouse::Meta::Class::BEGIN@26 which was called:
# once (9µs+14µs) by Mouse::BEGIN@14 at line 26 # spent 23µs making 1 call to Mouse::Meta::Class::BEGIN@26
# spent 14µs making 1 call to strict::unimport |
27 | 1 | 4µs | \@{ $args{package} . '::ISA' }; | ||
28 | }; | ||||
29 | |||||
30 | 1 | 1µs | my $self = bless \%args, ref($class) || $class; | ||
31 | 1 | 600ns | if(ref($self) ne __PACKAGE__){ | ||
32 | $self->meta->_initialize_object($self, \%args); | ||||
33 | } | ||||
34 | 1 | 5µs | return $self; | ||
35 | } | ||||
36 | |||||
37 | sub create_anon_class{ | ||||
38 | my $self = shift; | ||||
39 | return $self->create(undef, @_); | ||||
40 | } | ||||
41 | |||||
42 | sub is_anon_class; | ||||
43 | |||||
44 | sub roles; | ||||
45 | |||||
46 | sub calculate_all_roles { | ||||
47 | my $self = shift; | ||||
48 | my %seen; | ||||
49 | return grep { !$seen{ $_->name }++ } | ||||
50 | map { $_->calculate_all_roles } @{ $self->roles }; | ||||
51 | } | ||||
52 | |||||
53 | # spent 74µs (32+43) within Mouse::Meta::Class::superclasses which was called 2 times, avg 37µs/call:
# 2 times (32µs+43µs) by Mouse::init_meta at line 139 of Mouse.pm, avg 37µs/call | ||||
54 | 2 | 500ns | my $self = shift; | ||
55 | |||||
56 | 2 | 500ns | if (@_) { | ||
57 | 1 | 2µs | foreach my $super(@_){ | ||
58 | 1 | 1µs | 1 | 24µs | Mouse::Util::load_class($super); # spent 24µs making 1 call to Mouse::Util::load_class |
59 | 1 | 2µs | 1 | 2µs | my $meta = Mouse::Util::get_metaclass_by_name($super); # spent 2µs making 1 call to Mouse::Meta::Module::_get_metaclass_by_name |
60 | 1 | 5µs | 1 | 17µs | next if $self->verify_superclass($super, $meta); # spent 17µs making 1 call to Mouse::Meta::Class::verify_superclass |
61 | $self->_reconcile_with_superclass_meta($meta); | ||||
62 | } | ||||
63 | 1 | 9µs | return @{ $self->{superclasses} } = @_; | ||
64 | } | ||||
65 | |||||
66 | 1 | 8µs | return @{ $self->{superclasses} }; | ||
67 | } | ||||
68 | |||||
69 | # spent 17µs (16+1) within Mouse::Meta::Class::verify_superclass which was called:
# once (16µs+1µs) by Mouse::Meta::Class::superclasses at line 60 | ||||
70 | 1 | 700ns | my($self, $super, $super_meta) = @_; | ||
71 | |||||
72 | 1 | 300ns | if(defined $super_meta) { | ||
73 | if(Mouse::Util::is_a_metarole($super_meta)){ | ||||
74 | $self->throw_error("You cannot inherit from a Mouse Role ($super)"); | ||||
75 | } | ||||
76 | } | ||||
77 | else { | ||||
78 | # The metaclass of $super is not initialized. | ||||
79 | # i.e. it might be Mouse::Object, a mixin package (e.g. Exporter), | ||||
80 | # or a foreign class including Moose classes. | ||||
81 | # See also Mouse::Foreign::Meta::Role::Class. | ||||
82 | 1 | 13µs | 1 | 1µs | my $mm = $super->can('meta'); # spent 1µs making 1 call to UNIVERSAL::can |
83 | 1 | 1µs | if(!($mm && $mm == \&Mouse::Util::meta)) { | ||
84 | if($super->can('new') or $super->can('DESTROY')) { | ||||
85 | $self->inherit_from_foreign_class($super); | ||||
86 | } | ||||
87 | } | ||||
88 | 1 | 4µs | return 1; # always ok | ||
89 | } | ||||
90 | |||||
91 | return $self->isa(ref $super_meta); # checks metaclass compatibility | ||||
92 | } | ||||
93 | |||||
94 | sub inherit_from_foreign_class { | ||||
95 | my($class, $super) = @_; | ||||
96 | if($ENV{PERL_MOUSE_STRICT}) { | ||||
97 | Carp::carp("You inherit from non-Mouse class ($super)," | ||||
98 | . " but it is unlikely to work correctly." | ||||
99 | . " Please consider using MouseX::Foreign"); | ||||
100 | } | ||||
101 | return; | ||||
102 | } | ||||
103 | |||||
104 | 1 | 1µs | my @MetaClassTypes = ( | ||
105 | 'attribute', # Mouse::Meta::Attribute | ||||
106 | 'method', # Mouse::Meta::Method | ||||
107 | 'constructor', # Mouse::Meta::Method::Constructor | ||||
108 | 'destructor', # Mouse::Meta::Method::Destructor | ||||
109 | ); | ||||
110 | |||||
111 | sub _reconcile_with_superclass_meta { | ||||
112 | my($self, $other) = @_; | ||||
113 | |||||
114 | # find incompatible traits | ||||
115 | my %metaroles; | ||||
116 | foreach my $metaclass_type(@MetaClassTypes){ | ||||
117 | my $accessor = $self->can($metaclass_type . '_metaclass') | ||||
118 | || $self->can($metaclass_type . '_class'); | ||||
119 | |||||
120 | my $other_c = $other->$accessor(); | ||||
121 | my $self_c = $self->$accessor(); | ||||
122 | |||||
123 | if(!$self_c->isa($other_c)){ | ||||
124 | $metaroles{$metaclass_type} | ||||
125 | = [ $self_c->meta->_collect_roles($other_c->meta) ]; | ||||
126 | } | ||||
127 | } | ||||
128 | |||||
129 | $metaroles{class} = [$self->meta->_collect_roles($other->meta)]; | ||||
130 | |||||
131 | #use Data::Dumper; print Data::Dumper->new([\%metaroles], ['*metaroles'])->Indent(1)->Dump; | ||||
132 | |||||
133 | require Mouse::Util::MetaRole; | ||||
134 | $_[0] = Mouse::Util::MetaRole::apply_metaroles( | ||||
135 | for => $self, | ||||
136 | class_metaroles => \%metaroles, | ||||
137 | ); | ||||
138 | return; | ||||
139 | } | ||||
140 | |||||
141 | sub _collect_roles { | ||||
142 | my ($self, $other) = @_; | ||||
143 | |||||
144 | # find common ancestor | ||||
145 | my @self_lin_isa = $self->linearized_isa; | ||||
146 | my @other_lin_isa = $other->linearized_isa; | ||||
147 | |||||
148 | my(@self_anon_supers, @other_anon_supers); | ||||
149 | push @self_anon_supers, shift @self_lin_isa while $self_lin_isa[0]->meta->is_anon_class; | ||||
150 | push @other_anon_supers, shift @other_lin_isa while $other_lin_isa[0]->meta->is_anon_class; | ||||
151 | |||||
152 | my $common_ancestor = $self_lin_isa[0] eq $other_lin_isa[0] && $self_lin_isa[0]; | ||||
153 | |||||
154 | if(!$common_ancestor){ | ||||
155 | $self->throw_error(sprintf '%s cannot have %s as a super class because of their metaclass incompatibility', | ||||
156 | $self->name, $other->name); | ||||
157 | } | ||||
158 | |||||
159 | my %seen; | ||||
160 | return sort grep { !$seen{$_}++ } ## no critic | ||||
161 | (map{ $_->name } map{ $_->meta->calculate_all_roles } @self_anon_supers), | ||||
162 | (map{ $_->name } map{ $_->meta->calculate_all_roles } @other_anon_supers), | ||||
163 | ; | ||||
164 | } | ||||
165 | |||||
166 | |||||
167 | sub find_method_by_name { | ||||
168 | my($self, $method_name) = @_; | ||||
169 | defined($method_name) | ||||
170 | or $self->throw_error('You must define a method name to find'); | ||||
171 | |||||
172 | foreach my $class( $self->linearized_isa ){ | ||||
173 | my $method = $self->initialize($class)->get_method($method_name); | ||||
174 | return $method if defined $method; | ||||
175 | } | ||||
176 | return undef; | ||||
177 | } | ||||
178 | |||||
179 | sub get_all_methods { | ||||
180 | my($self) = @_; | ||||
181 | return map{ $self->find_method_by_name($_) } $self->get_all_method_names; | ||||
182 | } | ||||
183 | |||||
184 | sub get_all_method_names { | ||||
185 | my $self = shift; | ||||
186 | my %uniq; | ||||
187 | return grep { $uniq{$_}++ == 0 } | ||||
188 | map { Mouse::Meta::Class->initialize($_)->get_method_list() } | ||||
189 | $self->linearized_isa; | ||||
190 | } | ||||
191 | |||||
192 | sub find_attribute_by_name { | ||||
193 | my($self, $name) = @_; | ||||
194 | defined($name) | ||||
195 | or $self->throw_error('You must define an attribute name to find'); | ||||
196 | foreach my $attr($self->get_all_attributes) { | ||||
197 | return $attr if $attr->name eq $name; | ||||
198 | } | ||||
199 | return undef; | ||||
200 | } | ||||
201 | |||||
202 | # spent 300µs (61+239) within Mouse::Meta::Class::add_attribute which was called:
# once (61µs+239µs) by Mouse::has at line 52 of Mouse.pm | ||||
203 | 1 | 300ns | my $self = shift; | ||
204 | |||||
205 | 1 | 200ns | my($attr, $name); | ||
206 | |||||
207 | 1 | 6µs | 1 | 800ns | if(Scalar::Util::blessed($_[0])){ # spent 800ns making 1 call to Scalar::Util::blessed |
208 | $attr = $_[0]; | ||||
209 | |||||
210 | $attr->isa('Mouse::Meta::Attribute') | ||||
211 | || $self->throw_error("Your attribute must be an instance of Mouse::Meta::Attribute (or a subclass)"); | ||||
212 | |||||
213 | $name = $attr->name; | ||||
214 | } | ||||
215 | else{ | ||||
216 | # _process_attribute | ||||
217 | 1 | 600ns | $name = shift; | ||
218 | |||||
219 | 1 | 3µs | my %args = (@_ == 1) ? %{$_[0]} : @_; | ||
220 | |||||
221 | 1 | 400ns | defined($name) | ||
222 | or $self->throw_error('You must provide a name for the attribute'); | ||||
223 | |||||
224 | 1 | 7µs | 1 | 900ns | if ($name =~ s/^\+//) { # inherited attributes # spent 900ns making 1 call to Mouse::Meta::Class::CORE:subst |
225 | my $inherited_attr = $self->find_attribute_by_name($name) | ||||
226 | or $self->throw_error("Could not find an attribute by the name of '$name' to inherit from in ".$self->name); | ||||
227 | |||||
228 | $attr = $inherited_attr->clone_and_inherit_options(%args); | ||||
229 | } | ||||
230 | else{ | ||||
231 | 1 | 11µs | 2 | 7µs | my($attribute_class, @traits) = $self->attribute_metaclass->interpolate_class(\%args); # spent 6µs making 1 call to Mouse::Meta::Attribute::interpolate_class
# spent 1µs making 1 call to Mouse::Meta::Class::attribute_metaclass |
232 | 1 | 300ns | $args{traits} = \@traits if @traits; | ||
233 | |||||
234 | 1 | 4µs | 1 | 69µs | $attr = $attribute_class->new($name, %args); # spent 69µs making 1 call to Mouse::Meta::Attribute::new |
235 | } | ||||
236 | } | ||||
237 | |||||
238 | 1 | 9µs | 1 | 2µs | Scalar::Util::weaken( $attr->{associated_class} = $self ); # spent 2µs making 1 call to Scalar::Util::weaken |
239 | |||||
240 | # install accessors first | ||||
241 | 1 | 2µs | 1 | 155µs | $attr->install_accessors(); # spent 155µs making 1 call to Mouse::Meta::Attribute::install_accessors |
242 | |||||
243 | # then register the attribute to the metaclass | ||||
244 | 1 | 2µs | $attr->{insertion_order} = keys %{ $self->{attributes} }; | ||
245 | 1 | 800ns | $self->{attributes}{$name} = $attr; | ||
246 | 1 | 11µs | 1 | 4µs | $self->_invalidate_metaclass_cache(); # spent 4µs making 1 call to Mouse::Meta::Class::_invalidate_metaclass_cache |
247 | |||||
248 | 1 | 700ns | if(!$attr->{associated_methods} && ($attr->{is} || '') ne 'bare'){ | ||
249 | Carp::carp(qq{Attribute ($name) of class }.$self->name | ||||
250 | .qq{ has no associated methods (did you mean to provide an "is" argument?)}); | ||||
251 | } | ||||
252 | 1 | 4µs | return $attr; | ||
253 | } | ||||
254 | |||||
255 | # spent 46µs (39+7) within Mouse::Meta::Class::_calculate_all_attributes which was called:
# once (39µs+7µs) by Mouse::Object::new at line 81 of fastest.pl | ||||
256 | 1 | 500ns | my($self) = @_; | ||
257 | 1 | 200ns | my %seen; | ||
258 | 1 | 200ns | my @all_attrs; | ||
259 | 1 | 8µs | 1 | 1µs | foreach my $class($self->linearized_isa) { # spent 1µs making 1 call to Mouse::Meta::Class::linearized_isa |
260 | 2 | 4µs | 2 | 4µs | my $meta = Mouse::Util::get_metaclass_by_name($class) or next; # spent 4µs making 2 calls to Mouse::Meta::Module::_get_metaclass_by_name, avg 2µs/call |
261 | 2 | 14µs | 1 | 800ns | my @attrs = grep { !$seen{$_->name}++ } values %{$meta->{attributes}}; # spent 800ns making 1 call to Mouse::Meta::Attribute::name |
262 | @attrs = sort { | ||||
263 | 1 | 6µs | 1 | 1µs | $b->{insertion_order} <=> $a->{insertion_order} # spent 1µs making 1 call to Mouse::Meta::Class::CORE:sort |
264 | } @attrs; | ||||
265 | 1 | 1µs | push @all_attrs, @attrs; | ||
266 | } | ||||
267 | 1 | 6µs | return [reverse @all_attrs]; | ||
268 | } | ||||
269 | |||||
270 | sub linearized_isa; | ||||
271 | |||||
272 | sub new_object; | ||||
273 | sub clone_object; | ||||
274 | |||||
275 | # spent 4µs within Mouse::Meta::Class::immutable_options which was called:
# once (4µs+0s) by Mouse::Meta::Class::make_immutable at line 288 | ||||
276 | 1 | 500ns | my ( $self, @args ) = @_; | ||
277 | |||||
278 | return ( | ||||
279 | 1 | 5µs | inline_constructor => 1, | ||
280 | inline_destructor => 1, | ||||
281 | constructor_name => 'new', | ||||
282 | @args, | ||||
283 | ); | ||||
284 | } | ||||
285 | |||||
286 | # spent 106µs (58+48) within Mouse::Meta::Class::make_immutable which was called:
# once (58µs+48µs) by main::RUNTIME at line 79 of fastest.pl | ||||
287 | 1 | 500ns | my $self = shift; | ||
288 | 1 | 9µs | 1 | 4µs | my %args = $self->immutable_options(@_); # spent 4µs making 1 call to Mouse::Meta::Class::immutable_options |
289 | |||||
290 | 1 | 1µs | $self->{is_immutable}++; | ||
291 | |||||
292 | 1 | 31µs | 4 | 28µs | if ($args{inline_constructor}) { # spent 17µs making 1 call to Mouse::Util::load_class
# spent 9µs making 1 call to Mouse::Meta::Module::add_method
# spent 1µs making 1 call to Mouse::Meta::Class::constructor_class
# spent 800ns making 1 call to Mouse::Meta::Method::Constructor::XS::_generate_constructor |
293 | $self->add_method($args{constructor_name} => | ||||
294 | Mouse::Util::load_class($self->constructor_class) | ||||
295 | ->_generate_constructor($self, \%args)); | ||||
296 | } | ||||
297 | |||||
298 | 1 | 22µs | 4 | 17µs | if ($args{inline_destructor}) { # spent 12µs making 1 call to Mouse::Util::load_class
# spent 4µs making 1 call to Mouse::Meta::Module::add_method
# spent 800ns making 1 call to Mouse::Meta::Class::destructor_class
# spent 600ns making 1 call to Mouse::Meta::Method::Destructor::XS::_generate_destructor |
299 | $self->add_method(DESTROY => | ||||
300 | Mouse::Util::load_class($self->destructor_class) | ||||
301 | ->_generate_destructor($self, \%args)); | ||||
302 | } | ||||
303 | |||||
304 | # Moose's make_immutable returns true allowing calling code to skip | ||||
305 | # setting an explicit true value at the end of a source file. | ||||
306 | 1 | 5µs | return 1; | ||
307 | } | ||||
308 | |||||
309 | sub make_mutable { | ||||
310 | my($self) = @_; | ||||
311 | $self->{is_immutable} = 0; | ||||
312 | return; | ||||
313 | } | ||||
314 | |||||
315 | sub is_immutable; | ||||
316 | sub is_mutable { !$_[0]->is_immutable } | ||||
317 | |||||
318 | sub _install_modifier { | ||||
319 | my( $self, $type, $name, $code ) = @_; | ||||
320 | my $into = $self->name; | ||||
321 | |||||
322 | my $original = $into->can($name) | ||||
323 | or $self->throw_error("The method '$name' was not found in the inheritance hierarchy for $into"); | ||||
324 | |||||
325 | my $modifier_table = $self->{modifiers}{$name}; | ||||
326 | |||||
327 | if(!$modifier_table){ | ||||
328 | my(@before, @after, @around); | ||||
329 | my $cache = $original; | ||||
330 | my $modified = sub { | ||||
331 | if(@before) { | ||||
332 | for my $c (@before) { $c->(@_) } | ||||
333 | } | ||||
334 | unless(@after) { | ||||
335 | return $cache->(@_); | ||||
336 | } | ||||
337 | |||||
338 | if(wantarray){ # list context | ||||
339 | my @rval = $cache->(@_); | ||||
340 | |||||
341 | for my $c(@after){ $c->(@_) } | ||||
342 | return @rval; | ||||
343 | } | ||||
344 | elsif(defined wantarray){ # scalar context | ||||
345 | my $rval = $cache->(@_); | ||||
346 | |||||
347 | for my $c(@after){ $c->(@_) } | ||||
348 | return $rval; | ||||
349 | } | ||||
350 | else{ # void context | ||||
351 | $cache->(@_); | ||||
352 | |||||
353 | for my $c(@after){ $c->(@_) } | ||||
354 | return; | ||||
355 | } | ||||
356 | }; | ||||
357 | |||||
358 | $self->{modifiers}{$name} = $modifier_table = { | ||||
359 | original => $original, | ||||
360 | |||||
361 | before => \@before, | ||||
362 | after => \@after, | ||||
363 | around => \@around, | ||||
364 | |||||
365 | cache => \$cache, # cache for around modifiers | ||||
366 | }; | ||||
367 | |||||
368 | $self->add_method($name => $modified); | ||||
369 | } | ||||
370 | |||||
371 | if($type eq 'before'){ | ||||
372 | unshift @{$modifier_table->{before}}, $code; | ||||
373 | } | ||||
374 | elsif($type eq 'after'){ | ||||
375 | push @{$modifier_table->{after}}, $code; | ||||
376 | } | ||||
377 | else{ # around | ||||
378 | push @{$modifier_table->{around}}, $code; | ||||
379 | |||||
380 | my $next = ${ $modifier_table->{cache} }; | ||||
381 | ${ $modifier_table->{cache} } = sub{ $code->($next, @_) }; | ||||
382 | } | ||||
383 | |||||
384 | return; | ||||
385 | } | ||||
386 | |||||
387 | sub add_before_method_modifier { | ||||
388 | my ( $self, $name, $code ) = @_; | ||||
389 | $self->_install_modifier( 'before', $name, $code ); | ||||
390 | } | ||||
391 | |||||
392 | sub add_around_method_modifier { | ||||
393 | my ( $self, $name, $code ) = @_; | ||||
394 | $self->_install_modifier( 'around', $name, $code ); | ||||
395 | } | ||||
396 | |||||
397 | sub add_after_method_modifier { | ||||
398 | my ( $self, $name, $code ) = @_; | ||||
399 | $self->_install_modifier( 'after', $name, $code ); | ||||
400 | } | ||||
401 | |||||
402 | sub add_override_method_modifier { | ||||
403 | my ($self, $name, $code) = @_; | ||||
404 | |||||
405 | if($self->has_method($name)){ | ||||
406 | $self->throw_error("Cannot add an override method if a local method is already present"); | ||||
407 | } | ||||
408 | |||||
409 | my $package = $self->name; | ||||
410 | |||||
411 | my $super_body = $package->can($name) | ||||
412 | or $self->throw_error("You cannot override '$name' because it has no super method"); | ||||
413 | |||||
414 | $self->add_method($name => sub { | ||||
415 | local $Mouse::SUPER_PACKAGE = $package; | ||||
416 | local $Mouse::SUPER_BODY = $super_body; | ||||
417 | local @Mouse::SUPER_ARGS = @_; | ||||
418 | &{$code}; | ||||
419 | }); | ||||
420 | return; | ||||
421 | } | ||||
422 | |||||
423 | sub add_augment_method_modifier { | ||||
424 | my ($self, $name, $code) = @_; | ||||
425 | if($self->has_method($name)){ | ||||
426 | $self->throw_error("Cannot add an augment method if a local method is already present"); | ||||
427 | } | ||||
428 | |||||
429 | my $super = $self->find_method_by_name($name) | ||||
430 | or $self->throw_error("You cannot augment '$name' because it has no super method"); | ||||
431 | |||||
432 | my $super_package = $super->package_name; | ||||
433 | my $super_body = $super->body; | ||||
434 | |||||
435 | $self->add_method($name => sub { | ||||
436 | local $Mouse::INNER_BODY{$super_package} = $code; | ||||
437 | local $Mouse::INNER_ARGS{$super_package} = [@_]; | ||||
438 | &{$super_body}; | ||||
439 | }); | ||||
440 | return; | ||||
441 | } | ||||
442 | |||||
443 | sub does_role { | ||||
444 | my ($self, $role_name) = @_; | ||||
445 | |||||
446 | (defined $role_name) | ||||
447 | || $self->throw_error("You must supply a role name to look for"); | ||||
448 | |||||
449 | $role_name = $role_name->name if ref $role_name; | ||||
450 | |||||
451 | for my $class ($self->linearized_isa) { | ||||
452 | my $meta = Mouse::Util::get_metaclass_by_name($class) | ||||
453 | or next; | ||||
454 | |||||
455 | for my $role (@{ $meta->roles }) { | ||||
456 | |||||
457 | return 1 if $role->does_role($role_name); | ||||
458 | } | ||||
459 | } | ||||
460 | |||||
461 | return 0; | ||||
462 | } | ||||
463 | |||||
464 | 1 | 6µs | 1; | ||
465 | __END__ | ||||
# spent 1µs within Mouse::Meta::Class::CORE:sort which was called:
# once (1µs+0s) by Mouse::Meta::Class::_calculate_all_attributes at line 263 | |||||
# spent 900ns within Mouse::Meta::Class::CORE:subst which was called:
# once (900ns+0s) by Mouse::Meta::Class::add_attribute at line 224 | |||||
# spent 4µs within Mouse::Meta::Class::_invalidate_metaclass_cache which was called:
# once (4µs+0s) by Mouse::Meta::Class::add_attribute at line 246 | |||||
# spent 1µs within Mouse::Meta::Class::attribute_metaclass which was called:
# once (1µs+0s) by Mouse::Meta::Class::add_attribute at line 231 | |||||
# spent 1µs within Mouse::Meta::Class::constructor_class which was called:
# once (1µs+0s) by Mouse::Meta::Class::make_immutable at line 292 | |||||
# spent 800ns within Mouse::Meta::Class::destructor_class which was called:
# once (800ns+0s) by Mouse::Meta::Class::make_immutable at line 298 | |||||
# spent 600ns within Mouse::Meta::Class::is_anon_class which was called:
# once (600ns+0s) by Mouse::Object::new at line 81 of fastest.pl | |||||
# spent 800ns within Mouse::Meta::Class::is_immutable which was called:
# once (800ns+0s) by Mouse::Object::new at line 81 of fastest.pl | |||||
# spent 1µs within Mouse::Meta::Class::linearized_isa which was called:
# once (1µs+0s) by Mouse::Meta::Class::_calculate_all_attributes at line 259 | |||||
# spent 2µs within Mouse::Meta::Class::strict_constructor which was called:
# once (2µs+0s) by Mouse::Object::new at line 81 of fastest.pl |