← Index
NYTProf Performance Profile   « block view • line view • sub view »
For 01.HTTP.t
  Run on Tue May 4 15:25:55 2010
Reported on Tue May 4 15:26:06 2010

File /usr/local/lib/perl5/site_perl/5.10.1/darwin-2level/Moose/Util.pm
Statements Executed 42
Statement Execution Time 1.19ms
Subroutines — ordered by exclusive time
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
41134µs34µsMoose::Util::::_caller_infoMoose::Util::_caller_info
11113µs16µsMoose::Util::::BEGIN@3Moose::Util::BEGIN@3
1119µs55µsMoose::Util::::BEGIN@9Moose::Util::BEGIN@9
1119µs14µsMoose::Util::::BEGIN@6Moose::Util::BEGIN@6
1118µs163µsMoose::Util::::BEGIN@7Moose::Util::BEGIN@7
1117µs16µsMoose::Util::::BEGIN@4Moose::Util::BEGIN@4
1116µs31µsMoose::Util::::BEGIN@8Moose::Util::BEGIN@8
0000s0sMoose::Util::::__ANON__[:257]Moose::Util::__ANON__[:257]
0000s0sMoose::Util::::__ANON__[:81]Moose::Util::__ANON__[:81]
0000s0sMoose::Util::::_apply_all_rolesMoose::Util::_apply_all_roles
0000s0sMoose::Util::::_build_alias_package_nameMoose::Util::_build_alias_package_name
0000s0sMoose::Util::::_create_aliasMoose::Util::_create_alias
0000s0sMoose::Util::::add_method_modifierMoose::Util::add_method_modifier
0000s0sMoose::Util::::apply_all_rolesMoose::Util::apply_all_roles
0000s0sMoose::Util::::does_roleMoose::Util::does_role
0000s0sMoose::Util::::english_listMoose::Util::english_list
0000s0sMoose::Util::::ensure_all_rolesMoose::Util::ensure_all_roles
0000s0sMoose::Util::::find_metaMoose::Util::find_meta
0000s0sMoose::Util::::get_all_attribute_valuesMoose::Util::get_all_attribute_values
0000s0sMoose::Util::::get_all_init_argsMoose::Util::get_all_init_args
0000s0sMoose::Util::::meta_attribute_aliasMoose::Util::meta_attribute_alias
0000s0sMoose::Util::::meta_class_aliasMoose::Util::meta_class_alias
0000s0sMoose::Util::::resolve_metaclass_aliasMoose::Util::resolve_metaclass_alias
0000s0sMoose::Util::::resolve_metatrait_aliasMoose::Util::resolve_metatrait_alias
0000s0sMoose::Util::::search_class_by_roleMoose::Util::search_class_by_role
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments
Time
on line
Calls Time
in subs
Code
1package Moose::Util;
2
3320µs219µs
# spent 16µs (13+3) within Moose::Util::BEGIN@3 which was called # once (13µs+3µs) by Moose::Meta::Attribute::BEGIN@17 at line 3
use strict;
# spent 16µs making 1 call to Moose::Util::BEGIN@3 # spent 3µs making 1 call to strict::import
4318µs225µs
# spent 16µs (7+9) within Moose::Util::BEGIN@4 which was called # once (7µs+9µs) by Moose::Meta::Attribute::BEGIN@17 at line 4
use warnings;
# spent 16µs making 1 call to Moose::Util::BEGIN@4 # spent 9µs making 1 call to warnings::import
5
6321µs220µs
# spent 14µs (9+6) within Moose::Util::BEGIN@6 which was called # once (9µs+6µs) by Moose::Meta::Attribute::BEGIN@17 at line 6
use Data::OptList;
# spent 14µs making 1 call to Moose::Util::BEGIN@6 # spent 6µs making 1 call to Sub::Install::__ANON__[Sub/Install.pm:284]
7328µs2318µs
# spent 163µs (8+155) within Moose::Util::BEGIN@7 which was called # once (8µs+155µs) by Moose::Meta::Attribute::BEGIN@17 at line 7
use Sub::Exporter;
# spent 163µs making 1 call to Moose::Util::BEGIN@7 # spent 155µs making 1 call to Sub::Exporter::__ANON__[Sub/Exporter.pm:756]
8322µs255µs
# spent 31µs (6+24) within Moose::Util::BEGIN@8 which was called # once (6µs+24µs) by Moose::Meta::Attribute::BEGIN@17 at line 8
use Scalar::Util 'blessed';
# spent 31µs making 1 call to Moose::Util::BEGIN@8 # spent 24µs making 1 call to Exporter::import
93997µs2100µs
# spent 55µs (9+45) within Moose::Util::BEGIN@9 which was called # once (9µs+45µs) by Moose::Meta::Attribute::BEGIN@17 at line 9
use Class::MOP 0.60;
# spent 55µs making 1 call to Moose::Util::BEGIN@9 # spent 46µs making 1 call to UNIVERSAL::VERSION
10
111700nsour $VERSION = '0.98';
12119µs$VERSION = eval $VERSION;
131300nsour $AUTHORITY = 'cpan:STEVAN';
14
1513µsmy @exports = qw[
16 find_meta
17 does_role
18 search_class_by_role
19 ensure_all_roles
20 apply_all_roles
21 get_all_init_args
22 get_all_attribute_values
23 resolve_metatrait_alias
24 resolve_metaclass_alias
25 add_method_modifier
26 english_list
27 meta_attribute_alias
28 meta_class_alias
29];
30
3115µs1271µsSub::Exporter::setup_exporter({
# spent 271µs making 1 call to Sub::Exporter::setup_exporter
32 exports => \@exports,
33 groups => { all => \@exports }
34});
35
36## some utils for the utils ...
37
38sub find_meta { Class::MOP::class_of(@_) }
39
40## the functions ...
41
42sub does_role {
43 my ($class_or_obj, $role) = @_;
44
45 my $meta = find_meta($class_or_obj);
46
47 return unless defined $meta;
48 return unless $meta->can('does_role');
49 return 1 if $meta->does_role($role);
50 return;
51}
52
53sub search_class_by_role {
54 my ($class_or_obj, $role) = @_;
55
56 my $meta = find_meta($class_or_obj);
57
58 return unless defined $meta;
59
60 my $role_name = blessed $role ? $role->name : $role;
61
62 foreach my $class ($meta->class_precedence_list) {
63
64 my $_meta = find_meta($class);
65
66 next unless defined $_meta;
67
68 foreach my $role (@{ $_meta->roles || [] }) {
69 return $class if $role->name eq $role_name;
70 }
71 }
72
73 return;
74}
75
76# this can possibly behave in unexpected ways because the roles being composed
77# before being applied could differ from call to call; I'm not sure if or how
78# to document this possible quirk.
79sub ensure_all_roles {
80 my $applicant = shift;
81 _apply_all_roles($applicant, sub { !does_role($applicant, $_) }, @_);
82}
83
84sub apply_all_roles {
85 my $applicant = shift;
86 _apply_all_roles($applicant, undef, @_);
87}
88
89sub _apply_all_roles {
90 my $applicant = shift;
91 my $role_filter = shift;
92
93 unless (@_) {
94 require Moose;
95 Moose->throw_error("Must specify at least one role to apply to $applicant");
96 }
97
98 my $roles = Data::OptList::mkopt( [@_] );
99
100 my @role_metas;
101 foreach my $role (@$roles) {
102 my $meta;
103
104 if ( blessed $role->[0] ) {
105 $meta = $role->[0];
106 }
107 else {
108 Class::MOP::load_class( $role->[0] );
109 $meta = Class::MOP::class_of( $role->[0] );
110 }
111
112 unless ($meta && $meta->isa('Moose::Meta::Role') ) {
113 require Moose;
114 Moose->throw_error( "You can only consume roles, "
115 . $role->[0]
116 . " is not a Moose role" );
117 }
118
119 push @role_metas, [ $meta, $role->[1] ];
120 }
121
122 if ( defined $role_filter ) {
123 @role_metas = grep { local $_ = $_->[0]; $role_filter->() } @role_metas;
124 }
125
126 return unless @role_metas;
127
128 my $meta = ( blessed $applicant ? $applicant : find_meta($applicant) );
129
130 if ( scalar @role_metas == 1 ) {
131 my ( $role, $params ) = @{ $role_metas[0] };
132 $role->apply( $meta, ( defined $params ? %$params : () ) );
133 }
134 else {
135 Moose::Meta::Role->combine(@role_metas)->apply($meta);
136 }
137}
138
139# instance deconstruction ...
140
141sub get_all_attribute_values {
142 my ($class, $instance) = @_;
143 return +{
144 map { $_->name => $_->get_value($instance) }
145 grep { $_->has_value($instance) }
146 $class->get_all_attributes
147 };
148}
149
150sub get_all_init_args {
151 my ($class, $instance) = @_;
152 return +{
153 map { $_->init_arg => $_->get_value($instance) }
154 grep { $_->has_value($instance) }
155 grep { defined($_->init_arg) }
156 $class->get_all_attributes
157 };
158}
159
160sub resolve_metatrait_alias {
161 return resolve_metaclass_alias( @_, trait => 1 );
162}
163
164sub _build_alias_package_name {
165 my ($type, $name, $trait) = @_;
166 return 'Moose::Meta::'
167 . $type
168 . '::Custom::'
169 . ( $trait ? 'Trait::' : '' )
170 . $name;
171}
172
173{
1742400ns my %cache;
175
176 sub resolve_metaclass_alias {
177 my ( $type, $metaclass_name, %options ) = @_;
178
179 my $cache_key = $type . q{ } . ( $options{trait} ? '-Trait' : '' );
180 return $cache{$cache_key}{$metaclass_name}
181 if $cache{$cache_key}{$metaclass_name};
182
183 my $possible_full_name = _build_alias_package_name(
184 $type, $metaclass_name, $options{trait}
185 );
186
187 my $loaded_class = Class::MOP::load_first_existing_class(
188 $possible_full_name,
189 $metaclass_name
190 );
191
192 return $cache{$cache_key}{$metaclass_name}
193 = $loaded_class->can('register_implementation')
194 ? $loaded_class->register_implementation
195 : $loaded_class;
196 }
197}
198
199sub add_method_modifier {
200 my ( $class_or_obj, $modifier_name, $args ) = @_;
201 my $meta
202 = $class_or_obj->can('add_before_method_modifier')
203 ? $class_or_obj
204 : find_meta($class_or_obj);
205 my $code = pop @{$args};
206 my $add_modifier_method = 'add_' . $modifier_name . '_method_modifier';
207 if ( my $method_modifier_type = ref( @{$args}[0] ) ) {
208 if ( $method_modifier_type eq 'Regexp' ) {
209 my @all_methods = $meta->get_all_methods;
210 my @matched_methods
211 = grep { $_->name =~ @{$args}[0] } @all_methods;
212 $meta->$add_modifier_method( $_->name, $code )
213 for @matched_methods;
214 }
215 elsif ($method_modifier_type eq 'ARRAY') {
216 $meta->$add_modifier_method( $_, $code ) for @{$args->[0]};
217 }
218 else {
219 $meta->throw_error(
220 sprintf(
221 "Methods passed to %s must be provided as a list, arrayref or regex, not %s",
222 $modifier_name,
223 $method_modifier_type,
224 )
225 );
226 }
227 }
228 else {
229 $meta->$add_modifier_method( $_, $code ) for @{$args};
230 }
231}
232
233sub english_list {
234 my @items = sort @_;
235
236 return $items[0] if @items == 1;
237 return "$items[0] and $items[1]" if @items == 2;
238
239 my $tail = pop @items;
240 my $list = join ', ', @items;
241 $list .= ', and ' . $tail;
242
243 return $list;
244}
245
246
# spent 34µs within Moose::Util::_caller_info which was called 4 times, avg 9µs/call: # 4 times (34µs+0s) by Moose::has at line 67 of Moose.pm, avg 9µs/call
sub _caller_info {
2471636µs my $level = @_ ? ($_[0] + 1) : 2;
248 my %info;
249 @info{qw(package file line)} = caller($level);
250 return \%info;
251}
252
253sub _create_alias {
254 my ($type, $name, $trait, $for) = @_;
255 my $package = _build_alias_package_name($type, $name, $trait);
256 Class::MOP::Class->initialize($package)->add_method(
257 register_implementation => sub { $for }
258 );
259}
260
261sub meta_attribute_alias {
262 my ($to, $from) = @_;
263 $from ||= caller;
264 my $meta = Class::MOP::class_of($from);
265 my $trait = $meta->isa('Moose::Meta::Role');
266 _create_alias('Attribute', $to, $trait, $from);
267}
268
269sub meta_class_alias {
270 my ($to, $from) = @_;
271 $from ||= caller;
272 my $meta = Class::MOP::class_of($from);
273 my $trait = $meta->isa('Moose::Meta::Role');
274 _create_alias('Class', $to, $trait, $from);
275}
276
277119µs1;
278
279__END__
280
281=pod
282
283=head1 NAME
284
285Moose::Util - Utilities for working with Moose classes
286
287=head1 SYNOPSIS
288
289 use Moose::Util qw/find_meta does_role search_class_by_role/;
290
291 my $meta = find_meta($object) || die "No metaclass found";
292
293 if (does_role($object, $role)) {
294 print "The object can do $role!\n";
295 }
296
297 my $class = search_class_by_role($object, 'FooRole');
298 print "Nearest class with 'FooRole' is $class\n";
299
300=head1 DESCRIPTION
301
302This module provides a set of utility functions. Many of these
303functions are intended for use in Moose itself or MooseX modules, but
304some of them may be useful for use in your own code.
305
306=head1 EXPORTED FUNCTIONS
307
308=over 4
309
310=item B<find_meta($class_or_obj)>
311
312This method takes a class name or object and attempts to find a
313metaclass for the class, if one exists. It will B<not> create one if it
314does not yet exist.
315
316=item B<does_role($class_or_obj, $role_or_obj)>
317
318Returns true if C<$class_or_obj> does the given C<$role_or_obj>. The role can
319be provided as a name or a L<Moose::Meta::Role> object.
320
321The class must already have a metaclass for this to work. If it doesn't, this
322function simply returns false.
323
324=item B<search_class_by_role($class_or_obj, $role_or_obj)>
325
326Returns the first class in the class's precedence list that does
327C<$role_or_obj>, if any. The role can be either a name or a
328L<Moose::Meta::Role> object.
329
330The class must already have a metaclass for this to work.
331
332=item B<apply_all_roles($applicant, @roles)>
333
334This function applies one or more roles to the given C<$applicant> The
335applicant can be a role name, class name, or object.
336
337The C<$applicant> must already have a metaclass object.
338
339The list of C<@roles> should a list of names or L<Moose::Meta::Role> objects,
340each of which can be followed by an optional hash reference of options
341(C<-excludes> and C<-alias>).
342
343=item B<ensure_all_roles($applicant, @roles)>
344
345This function is similar to L</apply_all_roles>, but only applies roles that
346C<$applicant> does not already consume.
347
348=item B<get_all_attribute_values($meta, $instance)>
349
350Returns a hash reference containing all of the C<$instance>'s
351attributes. The keys are attribute names.
352
353=item B<get_all_init_args($meta, $instance)>
354
355Returns a hash reference containing all of the C<init_arg> values for
356the instance's attributes. The values are the associated attribute
357values. If an attribute does not have a defined C<init_arg>, it is
358skipped.
359
360This could be useful in cloning an object.
361
362=item B<resolve_metaclass_alias($category, $name, %options)>
363
364=item B<resolve_metatrait_alias($category, $name, %options)>
365
366Resolves a short name to a full class name. Short names are often used
367when specifying the C<metaclass> or C<traits> option for an attribute:
368
369 has foo => (
370 metaclass => "Bar",
371 );
372
373The name resolution mechanism is covered in
374L<Moose/Metaclass and Trait Name Resolution>.
375
376=item B<english_list(@items)>
377
378Given a list of scalars, turns them into a proper list in English
379("one and two", "one, two, three, and four"). This is used to help us
380make nicer error messages.
381
382=item B<meta_class_alias($to[, $from])>
383
384=item B<meta_attribute_alias($to[, $from])>
385
386Create an alias from the class C<$from> (or the current package, if
387C<$from> is unspecified), so that
388L<Moose/Metaclass and Trait Name Resolution> works properly.
389
390=back
391
392=head1 TODO
393
394Here is a list of possible functions to write
395
396=over 4
397
398=item discovering original method from modified method
399
400=item search for origin class of a method or attribute
401
402=back
403
404=head1 BUGS
405
406See L<Moose/BUGS> for details on reporting bugs.
407
408=head1 AUTHOR
409
410Anders Nor Berle E<lt>debolaz@gmail.comE<gt>
411
412B<with contributions from:>
413
414Robert (phaylon) Sedlacek
415
416Stevan Little
417
418=head1 COPYRIGHT AND LICENSE
419
420Copyright 2007-2009 by Infinity Interactive, Inc.
421
422L<http://www.iinteractive.com>
423
424This library is free software; you can redistribute it and/or modify
425it under the same terms as Perl itself.
426
427=cut
428