File | /usr/local/lib/perl/5.10.0/Moose/Util.pm |
Statements Executed | 67 |
Total Time | 0.0032478 seconds |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
8 | 1 | 1 | 121µs | 121µs | _caller_info | Moose::Util::
0 | 0 | 0 | 0s | 0s | BEGIN | Moose::Util::
0 | 0 | 0 | 0s | 0s | _STRINGLIKE | Moose::Util::
0 | 0 | 0 | 0s | 0s | __ANON__[:271] | Moose::Util::
0 | 0 | 0 | 0s | 0s | __ANON__[:335] | Moose::Util::
0 | 0 | 0 | 0s | 0s | __ANON__[:354] | Moose::Util::
0 | 0 | 0 | 0s | 0s | __ANON__[:373] | Moose::Util::
0 | 0 | 0 | 0s | 0s | __ANON__[:423] | Moose::Util::
0 | 0 | 0 | 0s | 0s | __ANON__[:425] | Moose::Util::
0 | 0 | 0 | 0s | 0s | __ANON__[:427] | Moose::Util::
0 | 0 | 0 | 0s | 0s | __ANON__[:439] | Moose::Util::
0 | 0 | 0 | 0s | 0s | __ANON__[:85] | Moose::Util::
0 | 0 | 0 | 0s | 0s | _apply_all_roles | Moose::Util::
0 | 0 | 0 | 0s | 0s | _build_alias_package_name | Moose::Util::
0 | 0 | 0 | 0s | 0s | _classes_differ_by_roles_only | Moose::Util::
0 | 0 | 0 | 0s | 0s | _create_alias | Moose::Util::
0 | 0 | 0 | 0s | 0s | _find_common_base | Moose::Util::
0 | 0 | 0 | 0s | 0s | _get_ancestors_until | Moose::Util::
0 | 0 | 0 | 0s | 0s | _is_role_only_subclass | Moose::Util::
0 | 0 | 0 | 0s | 0s | _reconcile_roles_for_metaclass | Moose::Util::
0 | 0 | 0 | 0s | 0s | _role_differences | Moose::Util::
0 | 0 | 0 | 0s | 0s | add_method_modifier | Moose::Util::
0 | 0 | 0 | 0s | 0s | apply_all_roles | Moose::Util::
0 | 0 | 0 | 0s | 0s | does_role | Moose::Util::
0 | 0 | 0 | 0s | 0s | english_list | Moose::Util::
0 | 0 | 0 | 0s | 0s | ensure_all_roles | Moose::Util::
0 | 0 | 0 | 0s | 0s | find_meta | Moose::Util::
0 | 0 | 0 | 0s | 0s | get_all_attribute_values | Moose::Util::
0 | 0 | 0 | 0s | 0s | get_all_init_args | Moose::Util::
0 | 0 | 0 | 0s | 0s | meta_attribute_alias | Moose::Util::
0 | 0 | 0 | 0s | 0s | meta_class_alias | Moose::Util::
0 | 0 | 0 | 0s | 0s | resolve_metaclass_alias | Moose::Util::
0 | 0 | 0 | 0s | 0s | resolve_metatrait_alias | Moose::Util::
0 | 0 | 0 | 0s | 0s | search_class_by_role | Moose::Util::
0 | 0 | 0 | 0s | 0s | with_traits | Moose::Util::
Line | Stmts. | Exclusive Time | Avg. | Code |
---|---|---|---|---|
1 | package Moose::Util; | |||
2 | ||||
3 | 3 | 38µs | 13µs | use strict; # spent 22µs making 1 call to strict::import |
4 | 3 | 26µs | 9µs | use warnings; # spent 26µs making 1 call to warnings::import |
5 | ||||
6 | 3 | 32µs | 11µs | use Data::OptList; # spent 11µs making 1 call to Sub::Install::__ANON__[/usr/local/share/perl/5.10.0/Sub/Install.pm:284] |
7 | 3 | 29µs | 10µs | use Params::Util qw( _STRING ); # spent 47µs making 1 call to Exporter::import |
8 | 3 | 34µs | 11µs | use Sub::Exporter; # spent 219µs making 1 call to Sub::Exporter::__ANON__[/usr/local/share/perl/5.10.0/Sub/Exporter.pm:756] |
9 | 3 | 32µs | 11µs | use Scalar::Util 'blessed'; # spent 48µs making 1 call to Exporter::import |
10 | 3 | 34µs | 11µs | use List::Util qw(first); # spent 41µs making 1 call to Exporter::import |
11 | 3 | 36µs | 12µs | use List::MoreUtils qw(any all); # spent 46µs making 1 call to Exporter::import |
12 | 3 | 2.83ms | 942µs | use Class::MOP 0.60; # spent 38µs making 1 call to UNIVERSAL::VERSION
# spent 3µs making 1 call to import |
13 | ||||
14 | 1 | 900ns | 900ns | our $VERSION = '1.15'; |
15 | 1 | 24µs | 24µs | $VERSION = eval $VERSION; |
16 | 1 | 600ns | 600ns | our $AUTHORITY = 'cpan:STEVAN'; |
17 | ||||
18 | 1 | 10µs | 10µs | my @exports = qw[ |
19 | find_meta | |||
20 | does_role | |||
21 | search_class_by_role | |||
22 | ensure_all_roles | |||
23 | apply_all_roles | |||
24 | with_traits | |||
25 | get_all_init_args | |||
26 | get_all_attribute_values | |||
27 | resolve_metatrait_alias | |||
28 | resolve_metaclass_alias | |||
29 | add_method_modifier | |||
30 | english_list | |||
31 | meta_attribute_alias | |||
32 | meta_class_alias | |||
33 | ]; | |||
34 | ||||
35 | 1 | 14µs | 14µs | Sub::Exporter::setup_exporter({ # spent 466µs making 1 call to Sub::Exporter::setup_exporter |
36 | exports => \@exports, | |||
37 | groups => { all => \@exports } | |||
38 | }); | |||
39 | ||||
40 | ## some utils for the utils ... | |||
41 | ||||
42 | sub find_meta { Class::MOP::class_of(@_) } | |||
43 | ||||
44 | ## the functions ... | |||
45 | ||||
46 | sub does_role { | |||
47 | my ($class_or_obj, $role) = @_; | |||
48 | ||||
49 | my $meta = find_meta($class_or_obj); | |||
50 | ||||
51 | return unless defined $meta; | |||
52 | return unless $meta->can('does_role'); | |||
53 | return 1 if $meta->does_role($role); | |||
54 | return; | |||
55 | } | |||
56 | ||||
57 | sub search_class_by_role { | |||
58 | my ($class_or_obj, $role) = @_; | |||
59 | ||||
60 | my $meta = find_meta($class_or_obj); | |||
61 | ||||
62 | return unless defined $meta; | |||
63 | ||||
64 | my $role_name = blessed $role ? $role->name : $role; | |||
65 | ||||
66 | foreach my $class ($meta->class_precedence_list) { | |||
67 | ||||
68 | my $_meta = find_meta($class); | |||
69 | ||||
70 | next unless defined $_meta; | |||
71 | ||||
72 | foreach my $role (@{ $_meta->roles || [] }) { | |||
73 | return $class if $role->name eq $role_name; | |||
74 | } | |||
75 | } | |||
76 | ||||
77 | return; | |||
78 | } | |||
79 | ||||
80 | # this can possibly behave in unexpected ways because the roles being composed | |||
81 | # before being applied could differ from call to call; I'm not sure if or how | |||
82 | # to document this possible quirk. | |||
83 | sub ensure_all_roles { | |||
84 | my $applicant = shift; | |||
85 | _apply_all_roles($applicant, sub { !does_role($applicant, $_) }, @_); | |||
86 | } | |||
87 | ||||
88 | sub apply_all_roles { | |||
89 | my $applicant = shift; | |||
90 | _apply_all_roles($applicant, undef, @_); | |||
91 | } | |||
92 | ||||
93 | sub _apply_all_roles { | |||
94 | my $applicant = shift; | |||
95 | my $role_filter = shift; | |||
96 | ||||
97 | unless (@_) { | |||
98 | require Moose; | |||
99 | Moose->throw_error("Must specify at least one role to apply to $applicant"); | |||
100 | } | |||
101 | ||||
102 | my $roles = Data::OptList::mkopt( [@_] ); | |||
103 | ||||
104 | my @role_metas; | |||
105 | foreach my $role (@$roles) { | |||
106 | my $meta; | |||
107 | ||||
108 | if ( blessed $role->[0] ) { | |||
109 | $meta = $role->[0]; | |||
110 | } | |||
111 | else { | |||
112 | Class::MOP::load_class( $role->[0] , $role->[1] ); | |||
113 | $meta = Class::MOP::class_of( $role->[0] ); | |||
114 | } | |||
115 | ||||
116 | unless ($meta && $meta->isa('Moose::Meta::Role') ) { | |||
117 | require Moose; | |||
118 | Moose->throw_error( "You can only consume roles, " | |||
119 | . $role->[0] | |||
120 | . " is not a Moose role" ); | |||
121 | } | |||
122 | ||||
123 | push @role_metas, [ $meta, $role->[1] ]; | |||
124 | } | |||
125 | ||||
126 | if ( defined $role_filter ) { | |||
127 | @role_metas = grep { local $_ = $_->[0]; $role_filter->() } @role_metas; | |||
128 | } | |||
129 | ||||
130 | return unless @role_metas; | |||
131 | ||||
132 | my $meta = ( blessed $applicant ? $applicant : find_meta($applicant) ); | |||
133 | ||||
134 | if ( scalar @role_metas == 1 ) { | |||
135 | my ( $role, $params ) = @{ $role_metas[0] }; | |||
136 | $role->apply( $meta, ( defined $params ? %$params : () ) ); | |||
137 | } | |||
138 | else { | |||
139 | Moose::Meta::Role->combine(@role_metas)->apply($meta); | |||
140 | } | |||
141 | } | |||
142 | ||||
143 | sub with_traits { | |||
144 | my ($class, @roles) = @_; | |||
145 | return $class unless @roles; | |||
146 | return Moose::Meta::Class->create_anon_class( | |||
147 | superclasses => [$class], | |||
148 | roles => \@roles, | |||
149 | cache => 1, | |||
150 | )->name; | |||
151 | } | |||
152 | ||||
153 | # instance deconstruction ... | |||
154 | ||||
155 | sub get_all_attribute_values { | |||
156 | my ($class, $instance) = @_; | |||
157 | return +{ | |||
158 | map { $_->name => $_->get_value($instance) } | |||
159 | grep { $_->has_value($instance) } | |||
160 | $class->get_all_attributes | |||
161 | }; | |||
162 | } | |||
163 | ||||
164 | sub get_all_init_args { | |||
165 | my ($class, $instance) = @_; | |||
166 | return +{ | |||
167 | map { $_->init_arg => $_->get_value($instance) } | |||
168 | grep { $_->has_value($instance) } | |||
169 | grep { defined($_->init_arg) } | |||
170 | $class->get_all_attributes | |||
171 | }; | |||
172 | } | |||
173 | ||||
174 | sub resolve_metatrait_alias { | |||
175 | return resolve_metaclass_alias( @_, trait => 1 ); | |||
176 | } | |||
177 | ||||
178 | sub _build_alias_package_name { | |||
179 | my ($type, $name, $trait) = @_; | |||
180 | return 'Moose::Meta::' | |||
181 | . $type | |||
182 | . '::Custom::' | |||
183 | . ( $trait ? 'Trait::' : '' ) | |||
184 | . $name; | |||
185 | } | |||
186 | ||||
187 | { | |||
188 | 2 | 1µs | 550ns | my %cache; |
189 | ||||
190 | sub resolve_metaclass_alias { | |||
191 | my ( $type, $metaclass_name, %options ) = @_; | |||
192 | ||||
193 | my $cache_key = $type . q{ } . ( $options{trait} ? '-Trait' : '' ); | |||
194 | return $cache{$cache_key}{$metaclass_name} | |||
195 | if $cache{$cache_key}{$metaclass_name}; | |||
196 | ||||
197 | my $possible_full_name = _build_alias_package_name( | |||
198 | $type, $metaclass_name, $options{trait} | |||
199 | ); | |||
200 | ||||
201 | my $loaded_class = Class::MOP::load_first_existing_class( | |||
202 | $possible_full_name, | |||
203 | $metaclass_name | |||
204 | ); | |||
205 | ||||
206 | return $cache{$cache_key}{$metaclass_name} | |||
207 | = $loaded_class->can('register_implementation') | |||
208 | ? $loaded_class->register_implementation | |||
209 | : $loaded_class; | |||
210 | } | |||
211 | } | |||
212 | ||||
213 | sub add_method_modifier { | |||
214 | my ( $class_or_obj, $modifier_name, $args ) = @_; | |||
215 | my $meta | |||
216 | = $class_or_obj->can('add_before_method_modifier') | |||
217 | ? $class_or_obj | |||
218 | : find_meta($class_or_obj); | |||
219 | my $code = pop @{$args}; | |||
220 | my $add_modifier_method = 'add_' . $modifier_name . '_method_modifier'; | |||
221 | if ( my $method_modifier_type = ref( @{$args}[0] ) ) { | |||
222 | if ( $method_modifier_type eq 'Regexp' ) { | |||
223 | my @all_methods = $meta->get_all_methods; | |||
224 | my @matched_methods | |||
225 | = grep { $_->name =~ @{$args}[0] } @all_methods; | |||
226 | $meta->$add_modifier_method( $_->name, $code ) | |||
227 | for @matched_methods; | |||
228 | } | |||
229 | elsif ($method_modifier_type eq 'ARRAY') { | |||
230 | $meta->$add_modifier_method( $_, $code ) for @{$args->[0]}; | |||
231 | } | |||
232 | else { | |||
233 | $meta->throw_error( | |||
234 | sprintf( | |||
235 | "Methods passed to %s must be provided as a list, arrayref or regex, not %s", | |||
236 | $modifier_name, | |||
237 | $method_modifier_type, | |||
238 | ) | |||
239 | ); | |||
240 | } | |||
241 | } | |||
242 | else { | |||
243 | $meta->$add_modifier_method( $_, $code ) for @{$args}; | |||
244 | } | |||
245 | } | |||
246 | ||||
247 | sub english_list { | |||
248 | my @items = sort @_; | |||
249 | ||||
250 | return $items[0] if @items == 1; | |||
251 | return "$items[0] and $items[1]" if @items == 2; | |||
252 | ||||
253 | my $tail = pop @items; | |||
254 | my $list = join ', ', @items; | |||
255 | $list .= ', and ' . $tail; | |||
256 | ||||
257 | return $list; | |||
258 | } | |||
259 | ||||
260 | # spent 121µs within Moose::Util::_caller_info which was called 8 times, avg 15µs/call:
# 8 times (121µs+0s) by Moose::has at line 68 of /usr/local/lib/perl/5.10.0/Moose.pm, avg 15µs/call | |||
261 | 8 | 7µs | 850ns | my $level = @_ ? ($_[0] + 1) : 2; |
262 | 8 | 2µs | 300ns | my %info; |
263 | 8 | 69µs | 9µs | @info{qw(package file line)} = caller($level); |
264 | 8 | 13µs | 2µs | return \%info; |
265 | } | |||
266 | ||||
267 | sub _create_alias { | |||
268 | my ($type, $name, $trait, $for) = @_; | |||
269 | my $package = _build_alias_package_name($type, $name, $trait); | |||
270 | Class::MOP::Class->initialize($package)->add_method( | |||
271 | register_implementation => sub { $for } | |||
272 | ); | |||
273 | } | |||
274 | ||||
275 | sub meta_attribute_alias { | |||
276 | my ($to, $from) = @_; | |||
277 | $from ||= caller; | |||
278 | my $meta = Class::MOP::class_of($from); | |||
279 | my $trait = $meta->isa('Moose::Meta::Role'); | |||
280 | _create_alias('Attribute', $to, $trait, $from); | |||
281 | } | |||
282 | ||||
283 | sub meta_class_alias { | |||
284 | my ($to, $from) = @_; | |||
285 | $from ||= caller; | |||
286 | my $meta = Class::MOP::class_of($from); | |||
287 | my $trait = $meta->isa('Moose::Meta::Role'); | |||
288 | _create_alias('Class', $to, $trait, $from); | |||
289 | } | |||
290 | ||||
291 | # XXX - this should be added to Params::Util | |||
292 | sub _STRINGLIKE ($) { | |||
293 | return _STRING( $_[0] ) | |||
294 | || ( blessed $_[0] | |||
295 | && overload::Method( $_[0], q{""} ) | |||
296 | && length "$_[0]" ); | |||
297 | } | |||
298 | ||||
299 | sub _reconcile_roles_for_metaclass { | |||
300 | my ($class_meta_name, $super_meta_name) = @_; | |||
301 | ||||
302 | my @role_differences = _role_differences( | |||
303 | $class_meta_name, $super_meta_name, | |||
304 | ); | |||
305 | ||||
306 | # handle the case where we need to fix compatibility between a class and | |||
307 | # its parent, but all roles in the class are already also done by the | |||
308 | # parent | |||
309 | # see t/050/054.t | |||
310 | return $super_meta_name | |||
311 | unless @role_differences; | |||
312 | ||||
313 | return Moose::Meta::Class->create_anon_class( | |||
314 | superclasses => [$super_meta_name], | |||
315 | roles => [map { $_->name } @role_differences], | |||
316 | cache => 1, | |||
317 | )->name; | |||
318 | } | |||
319 | ||||
320 | sub _role_differences { | |||
321 | my ($class_meta_name, $super_meta_name) = @_; | |||
322 | my @super_role_metas = $super_meta_name->meta->can('calculate_all_roles_with_inheritance') | |||
323 | ? $super_meta_name->meta->calculate_all_roles_with_inheritance | |||
324 | : $super_meta_name->meta->can('calculate_all_roles') | |||
325 | ? $super_meta_name->meta->calculate_all_roles | |||
326 | : (); | |||
327 | my @role_metas = $class_meta_name->meta->can('calculate_all_roles_with_inheritance') | |||
328 | ? $class_meta_name->meta->calculate_all_roles_with_inheritance | |||
329 | : $class_meta_name->meta->can('calculate_all_roles') | |||
330 | ? $class_meta_name->meta->calculate_all_roles | |||
331 | : (); | |||
332 | my @differences; | |||
333 | for my $role_meta (@role_metas) { | |||
334 | push @differences, $role_meta | |||
335 | unless any { $_->name eq $role_meta->name } @super_role_metas; | |||
336 | } | |||
337 | return @differences; | |||
338 | } | |||
339 | ||||
340 | sub _classes_differ_by_roles_only { | |||
341 | my ( $self_meta_name, $super_meta_name ) = @_; | |||
342 | ||||
343 | my $common_base_name | |||
344 | = _find_common_base( $self_meta_name, $super_meta_name ); | |||
345 | ||||
346 | return unless defined $common_base_name; | |||
347 | ||||
348 | my @super_meta_name_ancestor_names | |||
349 | = _get_ancestors_until( $super_meta_name, $common_base_name ); | |||
350 | my @class_meta_name_ancestor_names | |||
351 | = _get_ancestors_until( $self_meta_name, $common_base_name ); | |||
352 | ||||
353 | return | |||
354 | unless all { _is_role_only_subclass($_) } | |||
355 | @super_meta_name_ancestor_names, | |||
356 | @class_meta_name_ancestor_names; | |||
357 | ||||
358 | return 1; | |||
359 | } | |||
360 | ||||
361 | sub _find_common_base { | |||
362 | my ($meta1, $meta2) = map { Class::MOP::class_of($_) } @_; | |||
363 | return unless defined $meta1 && defined $meta2; | |||
364 | ||||
365 | # FIXME? This doesn't account for multiple inheritance (not sure | |||
366 | # if it needs to though). For example, if somewhere in $meta1's | |||
367 | # history it inherits from both ClassA and ClassB, and $meta2 | |||
368 | # inherits from ClassB & ClassA, does it matter? And what crazy | |||
369 | # fool would do that anyway? | |||
370 | ||||
371 | my %meta1_parents = map { $_ => 1 } $meta1->linearized_isa; | |||
372 | ||||
373 | return first { $meta1_parents{$_} } $meta2->linearized_isa; | |||
374 | } | |||
375 | ||||
376 | sub _get_ancestors_until { | |||
377 | my ($start_name, $until_name) = @_; | |||
378 | ||||
379 | my @ancestor_names; | |||
380 | for my $ancestor_name (Class::MOP::class_of($start_name)->linearized_isa) { | |||
381 | last if $ancestor_name eq $until_name; | |||
382 | push @ancestor_names, $ancestor_name; | |||
383 | } | |||
384 | return @ancestor_names; | |||
385 | } | |||
386 | ||||
387 | sub _is_role_only_subclass { | |||
388 | my ($meta_name) = @_; | |||
389 | my $meta = Class::MOP::Class->initialize($meta_name); | |||
390 | my @parent_names = $meta->superclasses; | |||
391 | ||||
392 | # XXX: don't feel like messing with multiple inheritance here... what would | |||
393 | # that even do? | |||
394 | return unless @parent_names == 1; | |||
395 | my ($parent_name) = @parent_names; | |||
396 | my $parent_meta = Class::MOP::Class->initialize($parent_name); | |||
397 | ||||
398 | # only get the roles attached to this particular class, don't look at | |||
399 | # superclasses | |||
400 | my @roles = $meta->can('calculate_all_roles') | |||
401 | ? $meta->calculate_all_roles | |||
402 | : (); | |||
403 | ||||
404 | # it's obviously not a role-only subclass if it doesn't do any roles | |||
405 | return unless @roles; | |||
406 | ||||
407 | # loop over all methods that are a part of the current class | |||
408 | # (not inherited) | |||
409 | for my $method ( $meta->_get_local_methods ) { | |||
410 | # always ignore meta | |||
411 | next if $method->isa('Class::MOP::Method::Meta'); | |||
412 | # we'll deal with attributes below | |||
413 | next if $method->can('associated_attribute'); | |||
414 | # if the method comes from a role we consumed, ignore it | |||
415 | next if $meta->can('does_role') | |||
416 | && $meta->does_role($method->original_package_name); | |||
417 | # FIXME - this really isn't right. Just because a modifier is | |||
418 | # defined in a role doesn't mean it isn't _also_ defined in the | |||
419 | # subclass. | |||
420 | next if $method->isa('Class::MOP::Method::Wrapped') | |||
421 | && ( | |||
422 | (!scalar($method->around_modifiers) | |||
423 | || any { $_->has_around_method_modifiers($method->name) } @roles) | |||
424 | && (!scalar($method->before_modifiers) | |||
425 | || any { $_->has_before_method_modifiers($method->name) } @roles) | |||
426 | && (!scalar($method->after_modifiers) | |||
427 | || any { $_->has_after_method_modifiers($method->name) } @roles) | |||
428 | ); | |||
429 | ||||
430 | return 0; | |||
431 | } | |||
432 | ||||
433 | # loop over all attributes that are a part of the current class | |||
434 | # (not inherited) | |||
435 | # FIXME - this really isn't right. Just because an attribute is | |||
436 | # defined in a role doesn't mean it isn't _also_ defined in the | |||
437 | # subclass. | |||
438 | for my $attr (map { $meta->get_attribute($_) } $meta->get_attribute_list) { | |||
439 | next if any { $_->has_attribute($attr->name) } @roles; | |||
440 | ||||
441 | return 0; | |||
442 | } | |||
443 | ||||
444 | return 1; | |||
445 | } | |||
446 | ||||
447 | 1 | 19µs | 19µs | 1; |
448 | ||||
449 | __END__ | |||
450 | ||||
451 | =pod | |||
452 | ||||
453 | =head1 NAME | |||
454 | ||||
455 | Moose::Util - Utilities for working with Moose classes | |||
456 | ||||
457 | =head1 SYNOPSIS | |||
458 | ||||
459 | use Moose::Util qw/find_meta does_role search_class_by_role/; | |||
460 | ||||
461 | my $meta = find_meta($object) || die "No metaclass found"; | |||
462 | ||||
463 | if (does_role($object, $role)) { | |||
464 | print "The object can do $role!\n"; | |||
465 | } | |||
466 | ||||
467 | my $class = search_class_by_role($object, 'FooRole'); | |||
468 | print "Nearest class with 'FooRole' is $class\n"; | |||
469 | ||||
470 | =head1 DESCRIPTION | |||
471 | ||||
472 | This module provides a set of utility functions. Many of these | |||
473 | functions are intended for use in Moose itself or MooseX modules, but | |||
474 | some of them may be useful for use in your own code. | |||
475 | ||||
476 | =head1 EXPORTED FUNCTIONS | |||
477 | ||||
478 | =over 4 | |||
479 | ||||
480 | =item B<find_meta($class_or_obj)> | |||
481 | ||||
482 | This method takes a class name or object and attempts to find a | |||
483 | metaclass for the class, if one exists. It will B<not> create one if it | |||
484 | does not yet exist. | |||
485 | ||||
486 | =item B<does_role($class_or_obj, $role_or_obj)> | |||
487 | ||||
488 | Returns true if C<$class_or_obj> does the given C<$role_or_obj>. The role can | |||
489 | be provided as a name or a L<Moose::Meta::Role> object. | |||
490 | ||||
491 | The class must already have a metaclass for this to work. If it doesn't, this | |||
492 | function simply returns false. | |||
493 | ||||
494 | =item B<search_class_by_role($class_or_obj, $role_or_obj)> | |||
495 | ||||
496 | Returns the first class in the class's precedence list that does | |||
497 | C<$role_or_obj>, if any. The role can be either a name or a | |||
498 | L<Moose::Meta::Role> object. | |||
499 | ||||
500 | The class must already have a metaclass for this to work. | |||
501 | ||||
502 | =item B<apply_all_roles($applicant, @roles)> | |||
503 | ||||
504 | This function applies one or more roles to the given C<$applicant> The | |||
505 | applicant can be a role name, class name, or object. | |||
506 | ||||
507 | The C<$applicant> must already have a metaclass object. | |||
508 | ||||
509 | The list of C<@roles> should a list of names or L<Moose::Meta::Role> objects, | |||
510 | each of which can be followed by an optional hash reference of options | |||
511 | (C<-excludes> and C<-alias>). | |||
512 | ||||
513 | =item B<ensure_all_roles($applicant, @roles)> | |||
514 | ||||
515 | This function is similar to L</apply_all_roles>, but only applies roles that | |||
516 | C<$applicant> does not already consume. | |||
517 | ||||
518 | =item B<with_traits($class_name, @role_names)> | |||
519 | ||||
520 | This function creates a new class from C<$class_name> with each of | |||
521 | C<@role_names> applied. It returns the name of the new class. | |||
522 | ||||
523 | =item B<get_all_attribute_values($meta, $instance)> | |||
524 | ||||
525 | Returns a hash reference containing all of the C<$instance>'s | |||
526 | attributes. The keys are attribute names. | |||
527 | ||||
528 | =item B<get_all_init_args($meta, $instance)> | |||
529 | ||||
530 | Returns a hash reference containing all of the C<init_arg> values for | |||
531 | the instance's attributes. The values are the associated attribute | |||
532 | values. If an attribute does not have a defined C<init_arg>, it is | |||
533 | skipped. | |||
534 | ||||
535 | This could be useful in cloning an object. | |||
536 | ||||
537 | =item B<resolve_metaclass_alias($category, $name, %options)> | |||
538 | ||||
539 | =item B<resolve_metatrait_alias($category, $name, %options)> | |||
540 | ||||
541 | Resolves a short name to a full class name. Short names are often used | |||
542 | when specifying the C<metaclass> or C<traits> option for an attribute: | |||
543 | ||||
544 | has foo => ( | |||
545 | metaclass => "Bar", | |||
546 | ); | |||
547 | ||||
548 | The name resolution mechanism is covered in | |||
549 | L<Moose/Metaclass and Trait Name Resolution>. | |||
550 | ||||
551 | =item B<meta_class_alias($to[, $from])> | |||
552 | ||||
553 | =item B<meta_attribute_alias($to[, $from])> | |||
554 | ||||
555 | Create an alias from the class C<$from> (or the current package, if | |||
556 | C<$from> is unspecified), so that | |||
557 | L<Moose/Metaclass and Trait Name Resolution> works properly. | |||
558 | ||||
559 | =item B<english_list(@items)> | |||
560 | ||||
561 | Given a list of scalars, turns them into a proper list in English | |||
562 | ("one and two", "one, two, three, and four"). This is used to help us | |||
563 | make nicer error messages. | |||
564 | ||||
565 | =back | |||
566 | ||||
567 | =head1 TODO | |||
568 | ||||
569 | Here is a list of possible functions to write | |||
570 | ||||
571 | =over 4 | |||
572 | ||||
573 | =item discovering original method from modified method | |||
574 | ||||
575 | =item search for origin class of a method or attribute | |||
576 | ||||
577 | =back | |||
578 | ||||
579 | =head1 BUGS | |||
580 | ||||
581 | See L<Moose/BUGS> for details on reporting bugs. | |||
582 | ||||
583 | =head1 AUTHOR | |||
584 | ||||
585 | Anders Nor Berle E<lt>debolaz@gmail.comE<gt> | |||
586 | ||||
587 | B<with contributions from:> | |||
588 | ||||
589 | Robert (phaylon) Sedlacek | |||
590 | ||||
591 | Stevan Little | |||
592 | ||||
593 | =head1 COPYRIGHT AND LICENSE | |||
594 | ||||
595 | Copyright 2007-2009 by Infinity Interactive, Inc. | |||
596 | ||||
597 | L<http://www.iinteractive.com> | |||
598 | ||||
599 | This library is free software; you can redistribute it and/or modify | |||
600 | it under the same terms as Perl itself. | |||
601 | ||||
602 | =cut | |||
603 |