File | /usr/local/lib/perl/5.10.0/Moose/Meta/Role.pm |
Statements Executed | 106 |
Total Time | 0.0046835 seconds |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
0 | 0 | 0 | 0s | 0s | BEGIN | Moose::Meta::Role::
0 | 0 | 0 | 0s | 0s | DESTROY | Moose::Meta::Role::
0 | 0 | 0 | 0s | 0s | __ANON__[:101] | Moose::Meta::Role::
0 | 0 | 0 | 0s | 0s | __ANON__[:106] | Moose::Meta::Role::
0 | 0 | 0 | 0s | 0s | __ANON__[:111] | Moose::Meta::Role::
0 | 0 | 0 | 0s | 0s | __ANON__[:116] | Moose::Meta::Role::
0 | 0 | 0 | 0s | 0s | __ANON__[:121] | Moose::Meta::Role::
0 | 0 | 0 | 0s | 0s | __ANON__[:279] | Moose::Meta::Role::
0 | 0 | 0 | 0s | 0s | __ANON__[:288] | Moose::Meta::Role::
0 | 0 | 0 | 0s | 0s | __ANON__[:296] | Moose::Meta::Role::
0 | 0 | 0 | 0s | 0s | __ANON__[:315] | Moose::Meta::Role::
0 | 0 | 0 | 0s | 0s | __ANON__[:324] | Moose::Meta::Role::
0 | 0 | 0 | 0s | 0s | __ANON__[:376] | Moose::Meta::Role::
0 | 0 | 0 | 0s | 0s | __ANON__[:89] | Moose::Meta::Role::
0 | 0 | 0 | 0s | 0s | __ANON__[:96] | Moose::Meta::Role::
0 | 0 | 0 | 0s | 0s | _attach_attribute | Moose::Meta::Role::
0 | 0 | 0 | 0s | 0s | _meta_method_class | Moose::Meta::Role::
0 | 0 | 0 | 0s | 0s | _restore_metaobjects_from | Moose::Meta::Role::
0 | 0 | 0 | 0s | 0s | _role_for_combination | Moose::Meta::Role::
0 | 0 | 0 | 0s | 0s | add_attribute | Moose::Meta::Role::
0 | 0 | 0 | 0s | 0s | add_conflicting_method | Moose::Meta::Role::
0 | 0 | 0 | 0s | 0s | add_override_method_modifier | Moose::Meta::Role::
0 | 0 | 0 | 0s | 0s | add_required_methods | Moose::Meta::Role::
0 | 0 | 0 | 0s | 0s | add_role | Moose::Meta::Role::
0 | 0 | 0 | 0s | 0s | apply | Moose::Meta::Role::
0 | 0 | 0 | 0s | 0s | calculate_all_roles | Moose::Meta::Role::
0 | 0 | 0 | 0s | 0s | combine | Moose::Meta::Role::
0 | 0 | 0 | 0s | 0s | composition_class_roles | Moose::Meta::Role::
0 | 0 | 0 | 0s | 0s | consumers | Moose::Meta::Role::
0 | 0 | 0 | 0s | 0s | create | Moose::Meta::Role::
0 | 0 | 0 | 0s | 0s | create_anon_role | Moose::Meta::Role::
0 | 0 | 0 | 0s | 0s | does_role | Moose::Meta::Role::
0 | 0 | 0 | 0s | 0s | find_method_by_name | Moose::Meta::Role::
0 | 0 | 0 | 0s | 0s | get_method_modifier_list | Moose::Meta::Role::
0 | 0 | 0 | 0s | 0s | get_override_method_modifier | Moose::Meta::Role::
0 | 0 | 0 | 0s | 0s | has_override_method_modifier | Moose::Meta::Role::
0 | 0 | 0 | 0s | 0s | initialize | Moose::Meta::Role::
0 | 0 | 0 | 0s | 0s | is_anon_role | Moose::Meta::Role::
0 | 0 | 0 | 0s | 0s | reinitialize | Moose::Meta::Role::
0 | 0 | 0 | 0s | 0s | reset_package_cache_flag | Moose::Meta::Role::
0 | 0 | 0 | 0s | 0s | update_package_cache_flag | Moose::Meta::Role::
Line | Stmts. | Exclusive Time | Avg. | Code |
---|---|---|---|---|
1 | ||||
2 | package Moose::Meta::Role; | |||
3 | ||||
4 | 3 | 27µs | 9µs | use strict; # spent 9µs making 1 call to strict::import |
5 | 3 | 27µs | 9µs | use warnings; # spent 19µs making 1 call to warnings::import |
6 | 3 | 50µs | 16µs | use metaclass; # spent 843µs making 1 call to metaclass::import |
7 | ||||
8 | 3 | 29µs | 10µs | use Scalar::Util 'blessed'; # spent 48µs making 1 call to Exporter::import |
9 | 3 | 41µs | 14µs | use Carp 'confess'; # spent 46µs making 1 call to Exporter::import |
10 | 3 | 76µs | 26µs | use Devel::GlobalDestruction 'in_global_destruction'; # spent 298µs making 1 call to Sub::Exporter::__ANON__[/usr/local/share/perl/5.10.0/Sub/Exporter.pm:756] |
11 | ||||
12 | 1 | 1µs | 1µs | our $VERSION = '1.15'; |
13 | 1 | 32µs | 32µs | $VERSION = eval $VERSION; |
14 | 1 | 900ns | 900ns | our $AUTHORITY = 'cpan:STEVAN'; |
15 | ||||
16 | 3 | 24µs | 8µs | use Moose::Meta::Class; # spent 4µs making 1 call to import |
17 | 3 | 148µs | 49µs | use Moose::Meta::Role::Attribute; # spent 4µs making 1 call to import |
18 | 3 | 123µs | 41µs | use Moose::Meta::Role::Method; # spent 3µs making 1 call to import |
19 | 3 | 126µs | 42µs | use Moose::Meta::Role::Method::Required; # spent 8µs making 1 call to import |
20 | 3 | 147µs | 49µs | use Moose::Meta::Role::Method::Conflicting; # spent 4µs making 1 call to import |
21 | 3 | 34µs | 12µs | use Moose::Meta::Method::Meta; # spent 3µs making 1 call to import |
22 | 3 | 33µs | 11µs | use Moose::Util qw( ensure_all_roles ); # spent 279µs making 1 call to Sub::Exporter::__ANON__[/usr/local/share/perl/5.10.0/Sub/Exporter.pm:756] |
23 | 3 | 33µs | 11µs | use Class::MOP::MiniTrait; # spent 3µs making 1 call to import |
24 | ||||
25 | use base 'Class::MOP::Module', # spent 195µs making 1 call to base::import | |||
26 | 'Class::MOP::Mixin::HasAttributes', | |||
27 | 3 | 2.88ms | 961µs | 'Class::MOP::Mixin::HasMethods'; |
28 | ||||
29 | 1 | 8µs | 8µs | Class::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 | ||||
43 | 1 | 7µs | 7µs | my $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 | ||||
62 | 1 | 14µs | 14µs | foreach 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 | ||||
83 | 18 | 105µs | 6µs | my $attr_reader = $action->{attr_reader}; |
84 | my $methods = $action->{methods}; | |||
85 | ||||
86 | # create the attribute | |||
87 | $META->add_attribute($action->{name} => ( | |||
88 | reader => $attr_reader, | |||
89 | default => sub { {} } | |||
90 | )); # 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; | |||
96 | }) 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}; | |||
101 | }) 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}; | |||
106 | }) 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} | |||
111 | }) if exists $methods->{get}; | |||
112 | ||||
113 | $META->add_method($methods->{existence} => sub { | |||
114 | my ($self, $name) = @_; | |||
115 | exists $self->$attr_reader->{$name} ? 1 : 0; | |||
116 | }) 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; | |||
121 | }) if exists $methods->{remove}; # spent 95µs making 1 call to Class::MOP::Mixin::HasMethods::add_method | |||
122 | } | |||
123 | ||||
124 | $META->add_attribute( | |||
125 | 1 | 12µs | 12µ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 | ||||
130 | 1 | 12µs | 12µ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 | ||||
136 | 1 | 8µs | 8µ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 | ||||
142 | 1 | 11µs | 11µ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 | ||||
148 | 1 | 11µs | 11µ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 | ||||
154 | 1 | 16µs | 16µ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 | |||
161 | sub 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 | ||||
172 | sub 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 | ||||
205 | sub _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 | ||||
213 | sub 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 | ||||
227 | sub _attach_attribute { | |||
228 | my ( $self, $attribute ) = @_; | |||
229 | ||||
230 | $attribute->attach_to_role($self); | |||
231 | } | |||
232 | ||||
233 | sub 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 | ||||
247 | sub 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 | ||||
272 | 1 | 1µs | 1µs | foreach my $modifier_type (qw[ before around after ]) { |
273 | ||||
274 | 15 | 141µs | 9µ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 { {} } | |||
280 | )); # 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 : (); | |||
288 | }); # 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; | |||
296 | }); # 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; | |||
315 | }); # 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 { {} } | |||
325 | 1 | 9µs | 9µ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 | ||||
333 | sub 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 | ||||
341 | sub 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 | ||||
349 | sub 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 | ||||
356 | sub get_method_modifier_list { | |||
357 | my ($self, $modifier_type) = @_; | |||
358 | my $accessor = "get_${modifier_type}_method_modifiers_map"; | |||
359 | keys %{$self->$accessor}; | |||
360 | } | |||
361 | ||||
362 | sub reset_package_cache_flag { (shift)->{'_package_cache_flag'} = undef } | |||
363 | sub update_package_cache_flag { | |||
364 | my $self = shift; | |||
365 | $self->{'_package_cache_flag'} = Class::MOP::check_package_cache_flag($self->name); | |||
366 | } | |||
367 | ||||
368 | ||||
369 | sub _meta_method_class { 'Moose::Meta::Method::Meta' } | |||
370 | ||||
371 | ## ------------------------------------------------------------------ | |||
372 | ## subroles | |||
373 | ||||
374 | $META->add_attribute('roles' => ( | |||
375 | reader => 'get_roles', | |||
376 | default => sub { [] } | |||
377 | 1 | 13µs | 13µs | )); # spent 499µs making 1 call to Class::MOP::Mixin::HasAttributes::add_attribute |
378 | ||||
379 | sub 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 | ||||
387 | sub 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 | ||||
397 | sub 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 | ||||
411 | sub find_method_by_name { (shift)->get_method(@_) } | |||
412 | ||||
413 | ## ------------------------------------------------------------------ | |||
414 | ## role construction | |||
415 | ## ------------------------------------------------------------------ | |||
416 | ||||
417 | sub 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 | ||||
438 | sub composition_class_roles { } | |||
439 | ||||
440 | sub 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 | ||||
464 | sub _role_for_combination { | |||
465 | my ($self, $params) = @_; | |||
466 | return $self; | |||
467 | } | |||
468 | ||||
469 | sub 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 | ||||
522 | sub 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. | |||
543 | 3 | 2µs | 767ns | 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. | |||
550 | my $ANON_ROLE_PREFIX = 'Moose::Meta::Role::__ANON__::SERIAL::'; | |||
551 | ||||
552 | sub is_anon_role { | |||
553 | my $self = shift; | |||
554 | 3 | 148µs | 49µ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 | ||||
575 | 3 | 86µs | 29µ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+)/); | |||
590 | 3 | 186µs | 62µ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 | ||||
705 | 1 | 59µs | 59µs | 1; |
706 | ||||
707 | __END__ | |||
708 | ||||
709 | =pod | |||
710 | ||||
711 | =head1 NAME | |||
712 | ||||
713 | Moose::Meta::Role - The Moose Role metaclass | |||
714 | ||||
715 | =head1 DESCRIPTION | |||
716 | ||||
717 | This class is a subclass of L<Class::MOP::Module> that provides | |||
718 | additional Moose-specific functionality. | |||
719 | ||||
720 | It's API looks a lot like L<Moose::Meta::Class>, but internally it | |||
721 | implements many things differently. This may change in the future. | |||
722 | ||||
723 | =head1 INHERITANCE | |||
724 | ||||
725 | C<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 | ||||
735 | This method creates a new role object with the provided name. | |||
736 | ||||
737 | =item B<< Moose::Meta::Role->combine( [ $role => { ... } ], [ $role ], ... ) >> | |||
738 | ||||
739 | This method accepts a list of array references. Each array reference | |||
740 | should contain a role name or L<Moose::Meta::Role> object as its first element. The second element is | |||
741 | an optional hash reference. The hash reference can contain C<-excludes> | |||
742 | and C<-alias> keys to control how methods are composed from the role. | |||
743 | ||||
744 | The return value is a new L<Moose::Meta::Role::Composite> that | |||
745 | represents the combined roles. | |||
746 | ||||
747 | =item B<< $metarole->composition_class_roles >> | |||
748 | ||||
749 | When combining multiple roles using C<combine>, this method is used to obtain a | |||
750 | list of role names to be applied to the L<Moose::Meta::Role::Composite> | |||
751 | instance returned by C<combine>. The default implementation returns an empty | |||
752 | list. Extensions that need to hook into role combination may wrap this method | |||
753 | to return additional role names. | |||
754 | ||||
755 | =item B<< Moose::Meta::Role->create($name, %options) >> | |||
756 | ||||
757 | This method is identical to the L<Moose::Meta::Class> C<create> | |||
758 | method. | |||
759 | ||||
760 | =item B<< Moose::Meta::Role->create_anon_role >> | |||
761 | ||||
762 | This method is identical to the L<Moose::Meta::Class> | |||
763 | C<create_anon_class> method. | |||
764 | ||||
765 | =item B<< $metarole->is_anon_role >> | |||
766 | ||||
767 | Returns true if the role is an anonymous role. | |||
768 | ||||
769 | =item B<< $metarole->consumers >> | |||
770 | ||||
771 | Returns 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 | ||||
781 | This method applies a role to the given C<$thing>. That can be another | |||
782 | L<Moose::Meta::Role>, object, a L<Moose::Meta::Class> object, or a | |||
783 | (non-meta) object instance. | |||
784 | ||||
785 | The options are passed directly to the constructor for the appropriate | |||
786 | L<Moose::Meta::Role::Application> subclass. | |||
787 | ||||
788 | Note that this will apply the role even if the C<$thing> in question already | |||
789 | C<does> this role. L<Moose::Util/does_role> is a convenient wrapper for | |||
790 | finding 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 | ||||
800 | This returns an array reference of roles which this role does. This | |||
801 | list may include duplicates. | |||
802 | ||||
803 | =item B<< $metarole->calculate_all_roles >> | |||
804 | ||||
805 | This returns a I<unique> list of all roles that this role does, and | |||
806 | all the roles that its roles do. | |||
807 | ||||
808 | =item B<< $metarole->does_role($role) >> | |||
809 | ||||
810 | Given a role I<name> or L<Moose::Meta::Role> object, returns true if this role | |||
811 | does the given role. | |||
812 | ||||
813 | =item B<< $metarole->add_role($role) >> | |||
814 | ||||
815 | Given a L<Moose::Meta::Role> object, this adds the role to the list of | |||
816 | roles that the role does. | |||
817 | ||||
818 | =item B<< $metarole->get_excluded_roles_list >> | |||
819 | ||||
820 | Returns a list of role names which this role excludes. | |||
821 | ||||
822 | =item B<< $metarole->excludes_role($role_name) >> | |||
823 | ||||
824 | Given a role I<name>, returns true if this role excludes the named | |||
825 | role. | |||
826 | ||||
827 | =item B<< $metarole->add_excluded_roles(@role_names) >> | |||
828 | ||||
829 | Given one or more role names, adds those roles to the list of excluded | |||
830 | roles. | |||
831 | ||||
832 | =back | |||
833 | ||||
834 | =head2 Methods | |||
835 | ||||
836 | The methods for dealing with a role's methods are all identical in API | |||
837 | and behavior to the same methods in L<Class::MOP::Class>. | |||
838 | ||||
839 | =over 4 | |||
840 | ||||
841 | =item B<< $metarole->method_metaclass >> | |||
842 | ||||
843 | Returns the method metaclass name for the role. This defaults to | |||
844 | L<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 | ||||
856 | These methods are all identical to the methods of the same name in | |||
857 | L<Class::MOP::Package> | |||
858 | ||||
859 | =back | |||
860 | ||||
861 | =head2 Attributes | |||
862 | ||||
863 | As with methods, the methods for dealing with a role's attribute are | |||
864 | all identical in API and behavior to the same methods in | |||
865 | L<Class::MOP::Class>. | |||
866 | ||||
867 | However, attributes stored in this class are I<not> stored as | |||
868 | objects. Rather, the attribute definition is stored as a hash | |||
869 | reference. When a role is composed into a class, this hash reference | |||
870 | is passed directly to the metaclass's C<add_attribute> method. | |||
871 | ||||
872 | This 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 | ||||
894 | Returns the list of methods required by the role. | |||
895 | ||||
896 | =item B<< $metarole->requires_method($name) >> | |||
897 | ||||
898 | Returns true if the role requires the named method. | |||
899 | ||||
900 | =item B<< $metarole->add_required_methods(@names) >> | |||
901 | ||||
902 | Adds the named methods to the role's list of required methods. | |||
903 | ||||
904 | =item B<< $metarole->remove_required_methods(@names) >> | |||
905 | ||||
906 | Removes the named methods from the role's list of required methods. | |||
907 | ||||
908 | =item B<< $metarole->add_conflicting_method(%params) >> | |||
909 | ||||
910 | Instantiate the parameters as a L<Moose::Meta::Role::Method::Conflicting> | |||
911 | object, then add it to the required method list. | |||
912 | ||||
913 | =back | |||
914 | ||||
915 | =head2 Method modifiers | |||
916 | ||||
917 | These methods act like their counterparts in L<Class::MOP::Class> and | |||
918 | L<Moose::Meta::Class>. | |||
919 | ||||
920 | However, method modifiers are simply stored internally, and are not | |||
921 | applied 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 | ||||
933 | These methods all add an appropriate modifier to the internal list of | |||
934 | modifiers. | |||
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 | ||||
944 | Return 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 | ||||
952 | Given a method name, returns a list of the appropriate modifiers for | |||
953 | that method. | |||
954 | ||||
955 | =item B<< $metarole->get_override_method_modifier($method_name) >> | |||
956 | ||||
957 | Given a method name, returns the override method modifier for that | |||
958 | method, if it has one. | |||
959 | ||||
960 | =back | |||
961 | ||||
962 | =head2 Introspection | |||
963 | ||||
964 | =over 4 | |||
965 | ||||
966 | =item B<< Moose::Meta::Role->meta >> | |||
967 | ||||
968 | This will return a L<Class::MOP::Class> instance for this class. | |||
969 | ||||
970 | =back | |||
971 | ||||
972 | =head1 BUGS | |||
973 | ||||
974 | See L<Moose/BUGS> for details on reporting bugs. | |||
975 | ||||
976 | =head1 AUTHOR | |||
977 | ||||
978 | Stevan Little E<lt>stevan@iinteractive.comE<gt> | |||
979 | ||||
980 | =head1 COPYRIGHT AND LICENSE | |||
981 | ||||
982 | Copyright 2006-2010 by Infinity Interactive, Inc. | |||
983 | ||||
984 | L<http://www.iinteractive.com> | |||
985 | ||||
986 | This library is free software; you can redistribute it and/or modify | |||
987 | it under the same terms as Perl itself. | |||
988 | ||||
989 | =cut |