← Index
Performance Profile   « block view • line view • sub view »
For t/test-parsing
  Run on Sun Nov 14 09:49:57 2010
Reported on Sun Nov 14 09:50:11 2010

File /usr/local/lib/perl/5.10.0/Moose/Meta/Role.pm
Statements Executed 106
Total Time 0.0046835 seconds
Subroutines — ordered by exclusive time
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
0000s0sMoose::Meta::Role::::BEGINMoose::Meta::Role::BEGIN
0000s0sMoose::Meta::Role::::DESTROYMoose::Meta::Role::DESTROY
0000s0sMoose::Meta::Role::::__ANON__[:101]Moose::Meta::Role::__ANON__[:101]
0000s0sMoose::Meta::Role::::__ANON__[:106]Moose::Meta::Role::__ANON__[:106]
0000s0sMoose::Meta::Role::::__ANON__[:111]Moose::Meta::Role::__ANON__[:111]
0000s0sMoose::Meta::Role::::__ANON__[:116]Moose::Meta::Role::__ANON__[:116]
0000s0sMoose::Meta::Role::::__ANON__[:121]Moose::Meta::Role::__ANON__[:121]
0000s0sMoose::Meta::Role::::__ANON__[:279]Moose::Meta::Role::__ANON__[:279]
0000s0sMoose::Meta::Role::::__ANON__[:288]Moose::Meta::Role::__ANON__[:288]
0000s0sMoose::Meta::Role::::__ANON__[:296]Moose::Meta::Role::__ANON__[:296]
0000s0sMoose::Meta::Role::::__ANON__[:315]Moose::Meta::Role::__ANON__[:315]
0000s0sMoose::Meta::Role::::__ANON__[:324]Moose::Meta::Role::__ANON__[:324]
0000s0sMoose::Meta::Role::::__ANON__[:376]Moose::Meta::Role::__ANON__[:376]
0000s0sMoose::Meta::Role::::__ANON__[:89]Moose::Meta::Role::__ANON__[:89]
0000s0sMoose::Meta::Role::::__ANON__[:96]Moose::Meta::Role::__ANON__[:96]
0000s0sMoose::Meta::Role::::_attach_attributeMoose::Meta::Role::_attach_attribute
0000s0sMoose::Meta::Role::::_meta_method_classMoose::Meta::Role::_meta_method_class
0000s0sMoose::Meta::Role::::_restore_metaobjects_fromMoose::Meta::Role::_restore_metaobjects_from
0000s0sMoose::Meta::Role::::_role_for_combinationMoose::Meta::Role::_role_for_combination
0000s0sMoose::Meta::Role::::add_attributeMoose::Meta::Role::add_attribute
0000s0sMoose::Meta::Role::::add_conflicting_methodMoose::Meta::Role::add_conflicting_method
0000s0sMoose::Meta::Role::::add_override_method_modifierMoose::Meta::Role::add_override_method_modifier
0000s0sMoose::Meta::Role::::add_required_methodsMoose::Meta::Role::add_required_methods
0000s0sMoose::Meta::Role::::add_roleMoose::Meta::Role::add_role
0000s0sMoose::Meta::Role::::applyMoose::Meta::Role::apply
0000s0sMoose::Meta::Role::::calculate_all_rolesMoose::Meta::Role::calculate_all_roles
0000s0sMoose::Meta::Role::::combineMoose::Meta::Role::combine
0000s0sMoose::Meta::Role::::composition_class_rolesMoose::Meta::Role::composition_class_roles
0000s0sMoose::Meta::Role::::consumersMoose::Meta::Role::consumers
0000s0sMoose::Meta::Role::::createMoose::Meta::Role::create
0000s0sMoose::Meta::Role::::create_anon_roleMoose::Meta::Role::create_anon_role
0000s0sMoose::Meta::Role::::does_roleMoose::Meta::Role::does_role
0000s0sMoose::Meta::Role::::find_method_by_nameMoose::Meta::Role::find_method_by_name
0000s0sMoose::Meta::Role::::get_method_modifier_listMoose::Meta::Role::get_method_modifier_list
0000s0sMoose::Meta::Role::::get_override_method_modifierMoose::Meta::Role::get_override_method_modifier
0000s0sMoose::Meta::Role::::has_override_method_modifierMoose::Meta::Role::has_override_method_modifier
0000s0sMoose::Meta::Role::::initializeMoose::Meta::Role::initialize
0000s0sMoose::Meta::Role::::is_anon_roleMoose::Meta::Role::is_anon_role
0000s0sMoose::Meta::Role::::reinitializeMoose::Meta::Role::reinitialize
0000s0sMoose::Meta::Role::::reset_package_cache_flagMoose::Meta::Role::reset_package_cache_flag
0000s0sMoose::Meta::Role::::update_package_cache_flagMoose::Meta::Role::update_package_cache_flag
LineStmts.Exclusive
Time
Avg.Code
1
2package Moose::Meta::Role;
3
4327µs9µsuse strict;
# spent 9µs making 1 call to strict::import
5327µs9µsuse warnings;
# spent 19µs making 1 call to warnings::import
6350µs16µsuse metaclass;
# spent 843µs making 1 call to metaclass::import
7
8329µs10µsuse Scalar::Util 'blessed';
# spent 48µs making 1 call to Exporter::import
9341µs14µsuse Carp 'confess';
# spent 46µs making 1 call to Exporter::import
10376µs26µsuse Devel::GlobalDestruction 'in_global_destruction';
11
1211µs1µsour $VERSION = '1.15';
13132µs32µs$VERSION = eval $VERSION;
141900ns900nsour $AUTHORITY = 'cpan:STEVAN';
15
16324µs8µsuse Moose::Meta::Class;
# spent 4µs making 1 call to import
173148µs49µsuse Moose::Meta::Role::Attribute;
# spent 4µs making 1 call to import
183123µs41µsuse Moose::Meta::Role::Method;
# spent 3µs making 1 call to import
193126µs42µsuse Moose::Meta::Role::Method::Required;
# spent 8µs making 1 call to import
203147µs49µsuse Moose::Meta::Role::Method::Conflicting;
# spent 4µs making 1 call to import
21334µs12µsuse Moose::Meta::Method::Meta;
# spent 3µs making 1 call to import
22333µs11µsuse Moose::Util qw( ensure_all_roles );
23333µs11µsuse Class::MOP::MiniTrait;
# spent 3µs making 1 call to import
24
25111µs11µsuse base 'Class::MOP::Module',
# spent 195µs making 1 call to base::import
26 'Class::MOP::Mixin::HasAttributes',
2722.87ms1.44ms 'Class::MOP::Mixin::HasMethods';
28
2918µs8µsClass::MOP::MiniTrait::apply(__PACKAGE__, 'Moose::Meta::Object::Trait');
# spent 2.47ms making 1 call to Class::MOP::MiniTrait::apply
30
31## ------------------------------------------------------------------
32## NOTE:
33## I normally don't do this, but I am doing
34## a whole bunch of meta-programmin in this
35## module, so it just makes sense. For a clearer
36## picture of what is going on in the next
37## several lines of code, look at the really
38## big comment at the end of this file (right
39## before the POD).
40## - SL
41## ------------------------------------------------------------------
42
4317µs7µsmy $META = __PACKAGE__->meta;
# spent 26µs making 1 call to Moose::Meta::Role::meta
44
45## ------------------------------------------------------------------
46## attributes ...
47
48# NOTE:
49# since roles are lazy, we hold all the attributes
50# of the individual role in 'statis' until which
51# time when it is applied to a class. This means
52# keeping a lot of things in hash maps, so we are
53# using a little of that meta-programmin' magic
54# here an saving lots of extra typin. And since
55# many of these attributes above require similar
56# functionality to support them, so we again use
57# the wonders of meta-programmin' to deliver a
58# very compact solution to this normally verbose
59# problem.
60# - SL
61
62114µs14µsforeach my $action (
63 {
64 name => 'excluded_roles_map',
65 attr_reader => 'get_excluded_roles_map' ,
66 methods => {
67 add => 'add_excluded_roles',
68 get_keys => 'get_excluded_roles_list',
69 existence => 'excludes_role',
70 }
71 },
72 {
73 name => 'required_methods',
74 attr_reader => 'get_required_methods_map',
75 methods => {
76 remove => 'remove_required_methods',
77 get_values => 'get_required_method_list',
78 existence => 'requires_method',
79 }
80 },
81) {
82
8322µs1µs my $attr_reader = $action->{attr_reader};
8421µs650ns my $methods = $action->{methods};
85
86 # create the attribute
87 $META->add_attribute($action->{name} => (
88 reader => $attr_reader,
89 default => sub { {} }
90219µs10µs ));
# spent 1.13ms making 2 calls to Class::MOP::Mixin::HasAttributes::add_attribute, avg 563µs/call
91
92 # create some helper methods
93 $META->add_method($methods->{add} => sub {
94 my ($self, @values) = @_;
95 $self->$attr_reader->{$_} = undef foreach @values;
96212µs6µs }) if exists $methods->{add};
# spent 95µs making 1 call to Class::MOP::Mixin::HasMethods::add_method
97
98 $META->add_method($methods->{get_keys} => sub {
99 my ($self) = @_;
100 keys %{$self->$attr_reader};
101215µs7µs }) if exists $methods->{get_keys};
# spent 103µs making 1 call to Class::MOP::Mixin::HasMethods::add_method
102
103 $META->add_method($methods->{get_values} => sub {
104 my ($self) = @_;
105 values %{$self->$attr_reader};
106214µs7µs }) if exists $methods->{get_values};
# spent 98µs making 1 call to Class::MOP::Mixin::HasMethods::add_method
107
108 $META->add_method($methods->{get} => sub {
109 my ($self, $name) = @_;
110 $self->$attr_reader->{$name}
11121µs550ns }) if exists $methods->{get};
112
113 $META->add_method($methods->{existence} => sub {
114 my ($self, $name) = @_;
115 exists $self->$attr_reader->{$name} ? 1 : 0;
116222µs11µs }) if exists $methods->{existence};
# spent 199µs making 2 calls to Class::MOP::Mixin::HasMethods::add_method, avg 100µs/call
117
118 $META->add_method($methods->{remove} => sub {
119 my ($self, @values) = @_;
120 delete $self->$attr_reader->{$_} foreach @values;
121218µs9µs }) if exists $methods->{remove};
# spent 95µs making 1 call to Class::MOP::Mixin::HasMethods::add_method
122}
123
124$META->add_attribute(
125112µs12µs 'method_metaclass',
# spent 587µs making 1 call to Class::MOP::Mixin::HasAttributes::add_attribute
126 reader => 'method_metaclass',
127 default => 'Moose::Meta::Role::Method',
128);
129
130112µs12µs$META->add_attribute(
# spent 534µs making 1 call to Class::MOP::Mixin::HasAttributes::add_attribute
131 'required_method_metaclass',
132 reader => 'required_method_metaclass',
133 default => 'Moose::Meta::Role::Method::Required',
134);
135
13618µs8µs$META->add_attribute(
# spent 492µs making 1 call to Class::MOP::Mixin::HasAttributes::add_attribute
137 'conflicting_method_metaclass',
138 reader => 'conflicting_method_metaclass',
139 default => 'Moose::Meta::Role::Method::Conflicting',
140);
141
142111µs11µs$META->add_attribute(
# spent 462µs making 1 call to Class::MOP::Mixin::HasAttributes::add_attribute
143 'application_to_class_class',
144 reader => 'application_to_class_class',
145 default => 'Moose::Meta::Role::Application::ToClass',
146);
147
148111µs11µs$META->add_attribute(
# spent 467µs making 1 call to Class::MOP::Mixin::HasAttributes::add_attribute
149 'application_to_role_class',
150 reader => 'application_to_role_class',
151 default => 'Moose::Meta::Role::Application::ToRole',
152);
153
154116µs16µs$META->add_attribute(
# spent 465µs making 1 call to Class::MOP::Mixin::HasAttributes::add_attribute
155 'application_to_instance_class',
156 reader => 'application_to_instance_class',
157 default => 'Moose::Meta::Role::Application::ToInstance',
158);
159
160# More or less copied from Moose::Meta::Class
161sub initialize {
162 my $class = shift;
163 my $pkg = shift;
164 return Class::MOP::get_metaclass_by_name($pkg)
165 || $class->SUPER::initialize(
166 $pkg,
167 'attribute_metaclass' => 'Moose::Meta::Role::Attribute',
168 @_
169 );
170}
171
172sub reinitialize {
173 my $self = shift;
174 my $pkg = shift;
175
176 my $meta = blessed $pkg ? $pkg : Class::MOP::class_of($pkg);
177
178 my %existing_classes;
179 if ($meta) {
180 %existing_classes = map { $_ => $meta->$_() } qw(
181 attribute_metaclass
182 method_metaclass
183 wrapped_method_metaclass
184 required_method_metaclass
185 conflicting_method_metaclass
186 application_to_class_class
187 application_to_role_class
188 application_to_instance_class
189 );
190 }
191
192 # don't need to remove generated metaobjects here yet, since we don't
193 # yet generate anything in roles. this may change in the future though...
194 # keep an eye on that
195 my $new_meta = $self->SUPER::reinitialize(
196 $pkg,
197 %existing_classes,
198 @_,
199 );
200 $new_meta->_restore_metaobjects_from($meta)
201 if $meta && $meta->isa('Moose::Meta::Role');
202 return $new_meta;
203}
204
205sub _restore_metaobjects_from {
206 my $self = shift;
207 my ($old_meta) = @_;
208
209 $self->_restore_metamethods_from($old_meta);
210 $self->_restore_metaattributes_from($old_meta);
211}
212
213sub add_attribute {
214 my $self = shift;
215
216 if (blessed $_[0] && ! $_[0]->isa('Moose::Meta::Role::Attribute') ) {
217 my $class = ref $_[0];
218 Moose->throw_error( "Cannot add a $class as an attribute to a role" );
219 }
220 elsif (!blessed($_[0]) && defined($_[0]) && $_[0] =~ /^\+(.*)/) {
221 Moose->throw_error( "has '+attr' is not supported in roles" );
222 }
223
224 return $self->SUPER::add_attribute(@_);
225}
226
227sub _attach_attribute {
228 my ( $self, $attribute ) = @_;
229
230 $attribute->attach_to_role($self);
231}
232
233sub add_required_methods {
234 my $self = shift;
235
236 for (@_) {
237 my $method = $_;
238 if (!blessed($method)) {
239 $method = $self->required_method_metaclass->new(
240 name => $method,
241 );
242 }
243 $self->get_required_methods_map->{$method->name} = $method;
244 }
245}
246
247sub add_conflicting_method {
248 my $self = shift;
249
250 my $method;
251 if (@_ == 1 && blessed($_[0])) {
252 $method = shift;
253 }
254 else {
255 $method = $self->conflicting_method_metaclass->new(@_);
256 }
257
258 $self->add_required_methods($method);
259}
260
261## ------------------------------------------------------------------
262## method modifiers
263
264# NOTE:
265# the before/around/after method modifiers are
266# stored by name, but there can be many methods
267# then associated with that name. So again we have
268# lots of similar functionality, so we can do some
269# meta-programmin' and save some time.
270# - SL
271
27211µs1µsforeach my $modifier_type (qw[ before around after ]) {
273
27434µs1µs my $attr_reader = "get_${modifier_type}_method_modifiers_map";
275
276 # create the attribute ...
277 $META->add_attribute("${modifier_type}_method_modifiers" => (
278 reader => $attr_reader,
279 default => sub { {} }
280332µs11µs ));
# spent 1.63ms making 3 calls to Class::MOP::Mixin::HasAttributes::add_attribute, avg 544µs/call
281
282 # and some helper methods ...
283 $META->add_method("get_${modifier_type}_method_modifiers" => sub {
284 my ($self, $method_name) = @_;
285 #return () unless exists $self->$attr_reader->{$method_name};
286 my $mm = $self->$attr_reader->{$method_name};
287 $mm ? @$mm : ();
288330µs10µs });
# spent 270µs making 3 calls to Class::MOP::Mixin::HasMethods::add_method, avg 90µs/call
289
290 $META->add_method("has_${modifier_type}_method_modifiers" => sub {
291 my ($self, $method_name) = @_;
292 # NOTE:
293 # for now we assume that if it exists,..
294 # it has at least one modifier in it
295 (exists $self->$attr_reader->{$method_name}) ? 1 : 0;
296334µs11µs });
# spent 257µs making 3 calls to Class::MOP::Mixin::HasMethods::add_method, avg 86µs/call
297
298 $META->add_method("add_${modifier_type}_method_modifier" => sub {
299 my ($self, $method_name, $method) = @_;
300
301 $self->$attr_reader->{$method_name} = []
302 unless exists $self->$attr_reader->{$method_name};
303
304 my $modifiers = $self->$attr_reader->{$method_name};
305
306 # NOTE:
307 # check to see that we aren't adding the
308 # same code twice. We err in favor of the
309 # first on here, this may not be as expected
310 foreach my $modifier (@{$modifiers}) {
311 return if $modifier == $method;
312 }
313
314 push @{$modifiers} => $method;
315340µs13µs });
# spent 261µs making 3 calls to Class::MOP::Mixin::HasMethods::add_method, avg 87µs/call
316
317}
318
319## ------------------------------------------------------------------
320## override method mofidiers
321
322$META->add_attribute('override_method_modifiers' => (
323 reader => 'get_override_method_modifiers_map',
324 default => sub { {} }
32519µs9µs));
# spent 560µs making 1 call to Class::MOP::Mixin::HasAttributes::add_attribute
326
327# NOTE:
328# these are a little different because there
329# can only be one per name, whereas the other
330# method modifiers can have multiples.
331# - SL
332
333sub add_override_method_modifier {
334 my ($self, $method_name, $method) = @_;
335 (!$self->has_method($method_name))
336 || Moose->throw_error("Cannot add an override of method '$method_name' " .
337 "because there is a local version of '$method_name'");
338 $self->get_override_method_modifiers_map->{$method_name} = $method;
339}
340
341sub has_override_method_modifier {
342 my ($self, $method_name) = @_;
343 # NOTE:
344 # for now we assume that if it exists,..
345 # it has at least one modifier in it
346 (exists $self->get_override_method_modifiers_map->{$method_name}) ? 1 : 0;
347}
348
349sub get_override_method_modifier {
350 my ($self, $method_name) = @_;
351 $self->get_override_method_modifiers_map->{$method_name};
352}
353
354## general list accessor ...
355
356sub get_method_modifier_list {
357 my ($self, $modifier_type) = @_;
358 my $accessor = "get_${modifier_type}_method_modifiers_map";
359 keys %{$self->$accessor};
360}
361
362sub reset_package_cache_flag { (shift)->{'_package_cache_flag'} = undef }
363sub update_package_cache_flag {
364 my $self = shift;
365 $self->{'_package_cache_flag'} = Class::MOP::check_package_cache_flag($self->name);
366}
367
368
369sub _meta_method_class { 'Moose::Meta::Method::Meta' }
370
371## ------------------------------------------------------------------
372## subroles
373
374$META->add_attribute('roles' => (
375 reader => 'get_roles',
376 default => sub { [] }
377113µs13µs));
# spent 499µs making 1 call to Class::MOP::Mixin::HasAttributes::add_attribute
378
379sub add_role {
380 my ($self, $role) = @_;
381 (blessed($role) && $role->isa('Moose::Meta::Role'))
382 || Moose->throw_error("Roles must be instances of Moose::Meta::Role");
383 push @{$self->get_roles} => $role;
384 $self->reset_package_cache_flag;
385}
386
387sub calculate_all_roles {
388 my $self = shift;
389 my %seen;
390 grep {
391 !$seen{$_->name}++
392 } ($self, map {
393 $_->calculate_all_roles
394 } @{ $self->get_roles });
395}
396
397sub does_role {
398 my ($self, $role) = @_;
399 (defined $role)
400 || Moose->throw_error("You must supply a role name to look for");
401 my $role_name = blessed $role ? $role->name : $role;
402 # if we are it,.. then return true
403 return 1 if $role_name eq $self->name;
404 # otherwise.. check our children
405 foreach my $role (@{$self->get_roles}) {
406 return 1 if $role->does_role($role_name);
407 }
408 return 0;
409}
410
411sub find_method_by_name { (shift)->get_method(@_) }
412
413## ------------------------------------------------------------------
414## role construction
415## ------------------------------------------------------------------
416
417sub apply {
418 my ($self, $other, %args) = @_;
419
420 (blessed($other))
421 || Moose->throw_error("You must pass in an blessed instance");
422
423 my $application_class;
424 if ($other->isa('Moose::Meta::Role')) {
425 $application_class = $self->application_to_role_class;
426 }
427 elsif ($other->isa('Moose::Meta::Class')) {
428 $application_class = $self->application_to_class_class;
429 }
430 else {
431 $application_class = $self->application_to_instance_class;
432 }
433
434 Class::MOP::load_class($application_class);
435 return $application_class->new(%args)->apply($self, $other, \%args);
436}
437
438sub composition_class_roles { }
439
440sub combine {
441 my ($class, @role_specs) = @_;
442
443 require Moose::Meta::Role::Composite;
444
445 my (@roles, %role_params);
446 while (@role_specs) {
447 my ($role, $params) = @{ splice @role_specs, 0, 1 };
448 my $requested_role
449 = blessed $role
450 ? $role
451 : Class::MOP::class_of($role);
452
453 my $actual_role = $requested_role->_role_for_combination($params);
454 push @roles => $actual_role;
455
456 next unless defined $params;
457 $role_params{$actual_role->name} = $params;
458 }
459
460 my $c = Moose::Meta::Role::Composite->new(roles => \@roles);
461 return $c->apply_params(\%role_params);
462}
463
464sub _role_for_combination {
465 my ($self, $params) = @_;
466 return $self;
467}
468
469sub create {
470 my ( $role, $package_name, %options ) = @_;
471
472 $options{package} = $package_name;
473
474 (ref $options{attributes} eq 'HASH')
475 || confess "You must pass a HASH ref of attributes"
476 if exists $options{attributes};
477
478 (ref $options{methods} eq 'HASH')
479 || confess "You must pass a HASH ref of methods"
480 if exists $options{methods};
481
482 $options{meta_name} = 'meta'
483 unless exists $options{meta_name};
484
485 my (%initialize_options) = %options;
486 delete @initialize_options{qw(
487 package
488 attributes
489 methods
490 meta_name
491 version
492 authority
493 )};
494
495 my $meta = $role->initialize( $package_name => %initialize_options );
496
497 $meta->_instantiate_module( $options{version}, $options{authority} );
498
499 $meta->_add_meta_method($options{meta_name})
500 if defined $options{meta_name};
501
502 if (exists $options{attributes}) {
503 foreach my $attribute_name (keys %{$options{attributes}}) {
504 my $attr = $options{attributes}->{$attribute_name};
505 $meta->add_attribute(
506 $attribute_name => blessed $attr ? $attr : %{$attr} );
507 }
508 }
509
510 if (exists $options{methods}) {
511 foreach my $method_name (keys %{$options{methods}}) {
512 $meta->add_method($method_name, $options{methods}->{$method_name});
513 }
514 }
515
516 Class::MOP::weaken_metaclass($meta->name)
517 if $meta->is_anon_role;
518
519 return $meta;
520}
521
522sub consumers {
523 my $self = shift;
524 my @consumers;
525 for my $meta (Class::MOP::get_all_metaclass_instances) {
526 next if $meta->name eq $self->name;
527 next unless $meta->isa('Moose::Meta::Class')
528 || $meta->isa('Moose::Meta::Role');
529 push @consumers, $meta->name
530 if $meta->does_role($self->name);
531 }
532 return @consumers;
533}
534
535# anonymous roles. most of it is copied straight out of Class::MOP::Class.
536# an intrepid hacker might find great riches if he unifies this code with that
537# code in Class::MOP::Module or Class::MOP::Package
538{
539 # NOTE:
540 # this should be sufficient, if you have a
541 # use case where it is not, write a test and
542 # I will change it.
54321µs650ns my $ANON_ROLE_SERIAL = 0;
544
545 # NOTE:
546 # we need a sufficiently annoying prefix
547 # this should suffice for now, this is
548 # used in a couple of places below, so
549 # need to put it up here for now.
55011µs1µs my $ANON_ROLE_PREFIX = 'Moose::Meta::Role::__ANON__::SERIAL::';
551
552 sub is_anon_role {
553 my $self = shift;
5543148µs49µs no warnings 'uninitialized';
# spent 31µs making 1 call to warnings::unimport
555 $self->name =~ /^$ANON_ROLE_PREFIX/;
556 }
557
558 sub create_anon_role {
559 my ($role, %options) = @_;
560 my $package_name = $ANON_ROLE_PREFIX . ++$ANON_ROLE_SERIAL;
561 return $role->create($package_name, %options);
562 }
563
564 # NOTE:
565 # this will only get called for
566 # anon-roles, all other calls
567 # are assumed to occur during
568 # global destruction and so don't
569 # really need to be handled explicitly
570 sub DESTROY {
571 my $self = shift;
572
573 return if in_global_destruction(); # it'll happen soon anyway and this just makes things more complicated
574
575386µs29µs no warnings 'uninitialized';
# spent 28µs making 1 call to warnings::unimport
576 return unless $self->name =~ /^$ANON_ROLE_PREFIX/;
577
578 # XXX: is this necessary for us? I don't understand what it's doing
579 # -sartak
580
581 # Moose does a weird thing where it replaces the metaclass for
582 # class when fixing metaclass incompatibility. In that case,
583 # we don't want to clean out the namespace now. We can detect
584 # that because Moose will explicitly update the singleton
585 # cache in Class::MOP.
586 #my $current_meta = Class::MOP::get_metaclass_by_name($self->name);
587 #return if $current_meta ne $self;
588
589 my ($serial_id) = ($self->name =~ /^$ANON_ROLE_PREFIX(\d+)/);
5903186µs62µs no strict 'refs';
# spent 26µs making 1 call to strict::unimport
591 foreach my $key (keys %{$ANON_ROLE_PREFIX . $serial_id}) {
592 delete ${$ANON_ROLE_PREFIX . $serial_id}{$key};
593 }
594 delete ${'main::' . $ANON_ROLE_PREFIX}{$serial_id . '::'};
595 }
596}
597
598#####################################################################
599## NOTE:
600## This is Moose::Meta::Role as defined by Moose (plus the use of
601## MooseX::AttributeHelpers module). It is here as a reference to
602## make it easier to see what is happening above with all the meta
603## programming. - SL
604#####################################################################
605#
606# has 'roles' => (
607# metaclass => 'Array',
608# reader => 'get_roles',
609# isa => 'ArrayRef[Moose::Meta::Role]',
610# default => sub { [] },
611# provides => {
612# 'push' => 'add_role',
613# }
614# );
615#
616# has 'excluded_roles_map' => (
617# metaclass => 'Hash',
618# reader => 'get_excluded_roles_map',
619# isa => 'HashRef[Str]',
620# provides => {
621# # Not exactly set, cause it sets multiple
622# 'set' => 'add_excluded_roles',
623# 'keys' => 'get_excluded_roles_list',
624# 'exists' => 'excludes_role',
625# }
626# );
627#
628# has 'required_methods' => (
629# metaclass => 'Hash',
630# reader => 'get_required_methods_map',
631# isa => 'HashRef[Moose::Meta::Role::Method::Required]',
632# provides => {
633# # not exactly set, or delete since it works for multiple
634# 'set' => 'add_required_methods',
635# 'delete' => 'remove_required_methods',
636# 'keys' => 'get_required_method_list',
637# 'exists' => 'requires_method',
638# }
639# );
640#
641# # the before, around and after modifiers are
642# # HASH keyed by method-name, with ARRAY of
643# # CODE refs to apply in that order
644#
645# has 'before_method_modifiers' => (
646# metaclass => 'Hash',
647# reader => 'get_before_method_modifiers_map',
648# isa => 'HashRef[ArrayRef[CodeRef]]',
649# provides => {
650# 'keys' => 'get_before_method_modifiers',
651# 'exists' => 'has_before_method_modifiers',
652# # This actually makes sure there is an
653# # ARRAY at the given key, and pushed onto
654# # it. It also checks for duplicates as well
655# # 'add' => 'add_before_method_modifier'
656# }
657# );
658#
659# has 'after_method_modifiers' => (
660# metaclass => 'Hash',
661# reader =>'get_after_method_modifiers_map',
662# isa => 'HashRef[ArrayRef[CodeRef]]',
663# provides => {
664# 'keys' => 'get_after_method_modifiers',
665# 'exists' => 'has_after_method_modifiers',
666# # This actually makes sure there is an
667# # ARRAY at the given key, and pushed onto
668# # it. It also checks for duplicates as well
669# # 'add' => 'add_after_method_modifier'
670# }
671# );
672#
673# has 'around_method_modifiers' => (
674# metaclass => 'Hash',
675# reader =>'get_around_method_modifiers_map',
676# isa => 'HashRef[ArrayRef[CodeRef]]',
677# provides => {
678# 'keys' => 'get_around_method_modifiers',
679# 'exists' => 'has_around_method_modifiers',
680# # This actually makes sure there is an
681# # ARRAY at the given key, and pushed onto
682# # it. It also checks for duplicates as well
683# # 'add' => 'add_around_method_modifier'
684# }
685# );
686#
687# # override is similar to the other modifiers
688# # except that it is not an ARRAY of code refs
689# # but instead just a single name->code mapping
690#
691# has 'override_method_modifiers' => (
692# metaclass => 'Hash',
693# reader =>'get_override_method_modifiers_map',
694# isa => 'HashRef[CodeRef]',
695# provides => {
696# 'keys' => 'get_override_method_modifier',
697# 'exists' => 'has_override_method_modifier',
698# 'add' => 'add_override_method_modifier', # checks for local method ..
699# }
700# );
701#
702#####################################################################
703
704
705159µs59µs1;
706
707__END__
708
709=pod
710
711=head1 NAME
712
713Moose::Meta::Role - The Moose Role metaclass
714
715=head1 DESCRIPTION
716
717This class is a subclass of L<Class::MOP::Module> that provides
718additional Moose-specific functionality.
719
720It's API looks a lot like L<Moose::Meta::Class>, but internally it
721implements many things differently. This may change in the future.
722
723=head1 INHERITANCE
724
725C<Moose::Meta::Role> is a subclass of L<Class::MOP::Module>.
726
727=head1 METHODS
728
729=head2 Construction
730
731=over 4
732
733=item B<< Moose::Meta::Role->initialize($role_name) >>
734
735This method creates a new role object with the provided name.
736
737=item B<< Moose::Meta::Role->combine( [ $role => { ... } ], [ $role ], ... ) >>
738
739This method accepts a list of array references. Each array reference
740should contain a role name or L<Moose::Meta::Role> object as its first element. The second element is
741an optional hash reference. The hash reference can contain C<-excludes>
742and C<-alias> keys to control how methods are composed from the role.
743
744The return value is a new L<Moose::Meta::Role::Composite> that
745represents the combined roles.
746
747=item B<< $metarole->composition_class_roles >>
748
749When combining multiple roles using C<combine>, this method is used to obtain a
750list of role names to be applied to the L<Moose::Meta::Role::Composite>
751instance returned by C<combine>. The default implementation returns an empty
752list. Extensions that need to hook into role combination may wrap this method
753to return additional role names.
754
755=item B<< Moose::Meta::Role->create($name, %options) >>
756
757This method is identical to the L<Moose::Meta::Class> C<create>
758method.
759
760=item B<< Moose::Meta::Role->create_anon_role >>
761
762This method is identical to the L<Moose::Meta::Class>
763C<create_anon_class> method.
764
765=item B<< $metarole->is_anon_role >>
766
767Returns true if the role is an anonymous role.
768
769=item B<< $metarole->consumers >>
770
771Returns a list of names of classes and roles which consume this role.
772
773=back
774
775=head2 Role application
776
777=over 4
778
779=item B<< $metarole->apply( $thing, @options ) >>
780
781This method applies a role to the given C<$thing>. That can be another
782L<Moose::Meta::Role>, object, a L<Moose::Meta::Class> object, or a
783(non-meta) object instance.
784
785The options are passed directly to the constructor for the appropriate
786L<Moose::Meta::Role::Application> subclass.
787
788Note that this will apply the role even if the C<$thing> in question already
789C<does> this role. L<Moose::Util/does_role> is a convenient wrapper for
790finding out if role application is necessary.
791
792=back
793
794=head2 Roles and other roles
795
796=over 4
797
798=item B<< $metarole->get_roles >>
799
800This returns an array reference of roles which this role does. This
801list may include duplicates.
802
803=item B<< $metarole->calculate_all_roles >>
804
805This returns a I<unique> list of all roles that this role does, and
806all the roles that its roles do.
807
808=item B<< $metarole->does_role($role) >>
809
810Given a role I<name> or L<Moose::Meta::Role> object, returns true if this role
811does the given role.
812
813=item B<< $metarole->add_role($role) >>
814
815Given a L<Moose::Meta::Role> object, this adds the role to the list of
816roles that the role does.
817
818=item B<< $metarole->get_excluded_roles_list >>
819
820Returns a list of role names which this role excludes.
821
822=item B<< $metarole->excludes_role($role_name) >>
823
824Given a role I<name>, returns true if this role excludes the named
825role.
826
827=item B<< $metarole->add_excluded_roles(@role_names) >>
828
829Given one or more role names, adds those roles to the list of excluded
830roles.
831
832=back
833
834=head2 Methods
835
836The methods for dealing with a role's methods are all identical in API
837and behavior to the same methods in L<Class::MOP::Class>.
838
839=over 4
840
841=item B<< $metarole->method_metaclass >>
842
843Returns the method metaclass name for the role. This defaults to
844L<Moose::Meta::Role::Method>.
845
846=item B<< $metarole->get_method($name) >>
847
848=item B<< $metarole->has_method($name) >>
849
850=item B<< $metarole->add_method( $name, $body ) >>
851
852=item B<< $metarole->get_method_list >>
853
854=item B<< $metarole->find_method_by_name($name) >>
855
856These methods are all identical to the methods of the same name in
857L<Class::MOP::Package>
858
859=back
860
861=head2 Attributes
862
863As with methods, the methods for dealing with a role's attribute are
864all identical in API and behavior to the same methods in
865L<Class::MOP::Class>.
866
867However, attributes stored in this class are I<not> stored as
868objects. Rather, the attribute definition is stored as a hash
869reference. When a role is composed into a class, this hash reference
870is passed directly to the metaclass's C<add_attribute> method.
871
872This is quite likely to change in the future.
873
874=over 4
875
876=item B<< $metarole->get_attribute($attribute_name) >>
877
878=item B<< $metarole->has_attribute($attribute_name) >>
879
880=item B<< $metarole->get_attribute_list >>
881
882=item B<< $metarole->add_attribute($name, %options) >>
883
884=item B<< $metarole->remove_attribute($attribute_name) >>
885
886=back
887
888=head2 Required methods
889
890=over 4
891
892=item B<< $metarole->get_required_method_list >>
893
894Returns the list of methods required by the role.
895
896=item B<< $metarole->requires_method($name) >>
897
898Returns true if the role requires the named method.
899
900=item B<< $metarole->add_required_methods(@names) >>
901
902Adds the named methods to the role's list of required methods.
903
904=item B<< $metarole->remove_required_methods(@names) >>
905
906Removes the named methods from the role's list of required methods.
907
908=item B<< $metarole->add_conflicting_method(%params) >>
909
910Instantiate the parameters as a L<Moose::Meta::Role::Method::Conflicting>
911object, then add it to the required method list.
912
913=back
914
915=head2 Method modifiers
916
917These methods act like their counterparts in L<Class::MOP::Class> and
918L<Moose::Meta::Class>.
919
920However, method modifiers are simply stored internally, and are not
921applied until the role itself is applied to a class.
922
923=over 4
924
925=item B<< $metarole->add_after_method_modifier($method_name, $method) >>
926
927=item B<< $metarole->add_around_method_modifier($method_name, $method) >>
928
929=item B<< $metarole->add_before_method_modifier($method_name, $method) >>
930
931=item B<< $metarole->add_override_method_modifier($method_name, $method) >>
932
933These methods all add an appropriate modifier to the internal list of
934modifiers.
935
936=item B<< $metarole->has_after_method_modifiers >>
937
938=item B<< $metarole->has_around_method_modifiers >>
939
940=item B<< $metarole->has_before_method_modifiers >>
941
942=item B<< $metarole->has_override_method_modifier >>
943
944Return true if the role has any modifiers of the given type.
945
946=item B<< $metarole->get_after_method_modifiers($method_name) >>
947
948=item B<< $metarole->get_around_method_modifiers($method_name) >>
949
950=item B<< $metarole->get_before_method_modifiers($method_name) >>
951
952Given a method name, returns a list of the appropriate modifiers for
953that method.
954
955=item B<< $metarole->get_override_method_modifier($method_name) >>
956
957Given a method name, returns the override method modifier for that
958method, if it has one.
959
960=back
961
962=head2 Introspection
963
964=over 4
965
966=item B<< Moose::Meta::Role->meta >>
967
968This will return a L<Class::MOP::Class> instance for this class.
969
970=back
971
972=head1 BUGS
973
974See L<Moose/BUGS> for details on reporting bugs.
975
976=head1 AUTHOR
977
978Stevan Little E<lt>stevan@iinteractive.comE<gt>
979
980=head1 COPYRIGHT AND LICENSE
981
982Copyright 2006-2010 by Infinity Interactive, Inc.
983
984L<http://www.iinteractive.com>
985
986This library is free software; you can redistribute it and/or modify
987it under the same terms as Perl itself.
988
989=cut