← 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:23 2010

File /usr/local/lib/perl5/site_perl/5.10.1/darwin-2level/Moose/Util/MetaRole.pm
Statements Executed 19
Statement Execution Time 652µs
Subroutines — ordered by exclusive time
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
11150µs59µsMoose::Util::MetaRole::::BEGIN@3Moose::Util::MetaRole::BEGIN@3
11111µs53µsMoose::Util::MetaRole::::BEGIN@12Moose::Util::MetaRole::BEGIN@12
1119µs27µsMoose::Util::MetaRole::::BEGIN@4Moose::Util::MetaRole::BEGIN@4
1117µs30µsMoose::Util::MetaRole::::BEGIN@11Moose::Util::MetaRole::BEGIN@11
1117µs34µsMoose::Util::MetaRole::::BEGIN@5Moose::Util::MetaRole::BEGIN@5
0000s0sMoose::Util::MetaRole::::__ANON__[:103]Moose::Util::MetaRole::__ANON__[:103]
0000s0sMoose::Util::MetaRole::::__ANON__[:147]Moose::Util::MetaRole::__ANON__[:147]
0000s0sMoose::Util::MetaRole::::_fixup_old_style_argsMoose::Util::MetaRole::_fixup_old_style_args
0000s0sMoose::Util::MetaRole::::_make_new_classMoose::Util::MetaRole::_make_new_class
0000s0sMoose::Util::MetaRole::::_make_new_metaclassMoose::Util::MetaRole::_make_new_metaclass
0000s0sMoose::Util::MetaRole::::apply_base_class_rolesMoose::Util::MetaRole::apply_base_class_roles
0000s0sMoose::Util::MetaRole::::apply_metaclass_rolesMoose::Util::MetaRole::apply_metaclass_roles
0000s0sMoose::Util::MetaRole::::apply_metarolesMoose::Util::MetaRole::apply_metaroles
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::MetaRole;
2
3329µs268µs
# spent 59µs (50+9) within Moose::Util::MetaRole::BEGIN@3 which was called # once (50µs+9µs) by Moose::Exporter::BEGIN@13 at line 3
use strict;
# spent 59µs making 1 call to Moose::Util::MetaRole::BEGIN@3 # spent 9µs making 1 call to strict::import
4323µs245µs
# spent 27µs (9+18) within Moose::Util::MetaRole::BEGIN@4 which was called # once (9µs+18µs) by Moose::Exporter::BEGIN@13 at line 4
use warnings;
# spent 27µs making 1 call to Moose::Util::MetaRole::BEGIN@4 # spent 18µs making 1 call to warnings::import
5347µs260µs
# spent 34µs (7+27) within Moose::Util::MetaRole::BEGIN@5 which was called # once (7µs+27µs) by Moose::Exporter::BEGIN@13 at line 5
use Scalar::Util 'blessed';
# spent 34µs making 1 call to Moose::Util::MetaRole::BEGIN@5 # spent 26µs making 1 call to Exporter::import
6
71600nsour $VERSION = '0.98';
8116µs$VERSION = eval $VERSION;
91400nsour $AUTHORITY = 'cpan:STEVAN';
10
11325µs252µs
# spent 30µs (7+23) within Moose::Util::MetaRole::BEGIN@11 which was called # once (7µs+23µs) by Moose::Exporter::BEGIN@13 at line 11
use List::MoreUtils qw( all );
# spent 30µs making 1 call to Moose::Util::MetaRole::BEGIN@11 # spent 23µs making 1 call to Exporter::import
123507µs295µs
# spent 53µs (11+42) within Moose::Util::MetaRole::BEGIN@12 which was called # once (11µs+42µs) by Moose::Exporter::BEGIN@13 at line 12
use List::Util qw( first );
# spent 53µs making 1 call to Moose::Util::MetaRole::BEGIN@12 # spent 42µs making 1 call to Exporter::import
13
14sub apply_metaclass_roles {
15 goto &apply_metaroles;
16}
17
18sub apply_metaroles {
19 my %args = @_;
20
21 _fixup_old_style_args(\%args);
22 Carp::cluck('applying') if $::D;
23 my $for
24 = blessed $args{for}
25 ? $args{for}
26 : Class::MOP::class_of( $args{for} );
27
28 if ( $for->isa('Moose::Meta::Role') ) {
29 return _make_new_metaclass( $for, $args{role_metaroles}, 'role' );
30 }
31 else {
32 return _make_new_metaclass( $for, $args{class_metaroles}, 'class' );
33 }
34}
35
36sub _fixup_old_style_args {
37 my $args = shift;
38
39 return if $args->{class_metaroles} || $args->{roles_metaroles};
40
41 $args->{for} = delete $args->{for_class}
42 if exists $args->{for_class};
43
44 my @old_keys = qw(
45 attribute_metaclass_roles
46 method_metaclass_roles
47 wrapped_method_metaclass_roles
48 instance_metaclass_roles
49 constructor_class_roles
50 destructor_class_roles
51 error_class_roles
52
53 application_to_class_class_roles
54 application_to_role_class_roles
55 application_to_instance_class_roles
56 application_role_summation_class_roles
57 );
58
59 my $for
60 = blessed $args->{for}
61 ? $args->{for}
62 : Class::MOP::class_of( $args->{for} );
63
64 my $top_key;
65 if ( $for->isa('Moose::Meta::Class') ) {
66 $top_key = 'class_metaroles';
67
68 $args->{class_metaroles}{class} = delete $args->{metaclass_roles}
69 if exists $args->{metaclass_roles};
70 }
71 else {
72 $top_key = 'role_metaroles';
73
74 $args->{role_metaroles}{role} = delete $args->{metaclass_roles}
75 if exists $args->{metaclass_roles};
76 }
77
78 for my $old_key (@old_keys) {
79 my ($new_key) = $old_key =~ /^(.+)_(?:class|metaclass)_roles$/;
80
81 $args->{$top_key}{$new_key} = delete $args->{$old_key}
82 if exists $args->{$old_key};
83 }
84
85 return;
86}
87
88sub _make_new_metaclass {
89 my $for = shift;
90 my $roles = shift;
91 my $primary = shift;
92
93 return $for unless keys %{$roles};
94
95 my $new_metaclass
96 = exists $roles->{$primary}
97 ? _make_new_class( ref $for, $roles->{$primary} )
98 : blessed $for;
99
100 my %classes;
101
102 for my $key ( grep { $_ ne $primary } keys %{$roles} ) {
103 my $attr = first {$_}
104 map { $for->meta->find_attribute_by_name($_) } (
105 $key . '_metaclass',
106 $key . '_class'
107 );
108
109 my $reader = $attr->get_read_method;
110
111 $classes{ $attr->init_arg }
112 = _make_new_class( $for->$reader(), $roles->{$key} );
113 }
114
115 my $new_meta = $new_metaclass->reinitialize( $for, %classes );
116
117 return $new_meta;
118}
119
120sub apply_base_class_roles {
121 my %args = @_;
122
123 my $for = $args{for} || $args{for_class};
124
125 my $meta = Class::MOP::class_of($for);
126
127 my $new_base = _make_new_class(
128 $for,
129 $args{roles},
130 [ $meta->superclasses() ],
131 );
132
133 $meta->superclasses($new_base)
134 if $new_base ne $meta->name();
135}
136
137sub _make_new_class {
138 my $existing_class = shift;
139 my $roles = shift;
140 my $superclasses = shift || [$existing_class];
141
142 return $existing_class unless $roles;
143
144 my $meta = Class::MOP::Class->initialize($existing_class);
145
146 return $existing_class
147 if $meta->can('does_role') && all { $meta->does_role($_) }
148 grep { !ref $_ } @{$roles};
149
150 return Moose::Meta::Class->create_anon_class(
151 superclasses => $superclasses,
152 roles => $roles,
153 cache => 1,
154 )->name();
155}
156
15714µs1;
158
159__END__
160
161=head1 NAME
162
163Moose::Util::MetaRole - Apply roles to any metaclass, as well as the object base class
164
165=head1 SYNOPSIS
166
167 package MyApp::Moose;
168
169 use Moose ();
170 use Moose::Exporter;
171 use Moose::Util::MetaRole;
172
173 use MyApp::Role::Meta::Class;
174 use MyApp::Role::Meta::Method::Constructor;
175 use MyApp::Role::Object;
176
177 Moose::Exporter->setup_import_methods( also => 'Moose' );
178
179 sub init_meta {
180 shift;
181 my %args = @_;
182
183 Moose->init_meta(%args);
184
185 Moose::Util::MetaRole::apply_metaroles(
186 for => $args{for_class},
187 class_metaroles => {
188 class => => ['MyApp::Role::Meta::Class'],
189 constructor => ['MyApp::Role::Meta::Method::Constructor'],
190 },
191 );
192
193 Moose::Util::MetaRole::apply_base_class_roles(
194 for => $args{for_class},
195 roles => ['MyApp::Role::Object'],
196 );
197
198 return $args{for_class}->meta();
199 }
200
201=head1 DESCRIPTION
202
203This utility module is designed to help authors of Moose extensions
204write extensions that are able to cooperate with other Moose
205extensions. To do this, you must write your extensions as roles, which
206can then be dynamically applied to the caller's metaclasses.
207
208This module makes sure to preserve any existing superclasses and roles
209already set for the meta objects, which means that any number of
210extensions can apply roles in any order.
211
212=head1 USAGE
213
214B<It is very important that you only call this module's functions when
215your module is imported by the caller>. The process of applying roles
216to the metaclass reinitializes the metaclass object, which wipes out
217any existing attributes already defined. However, as long as you do
218this when your module is imported, the caller should not have any
219attributes defined yet.
220
221The easiest way to ensure that this happens is to use
222L<Moose::Exporter>, which can generate the appropriate C<init_meta>
223method for you, and make sure it is called when imported.
224
225=head1 FUNCTIONS
226
227This module provides two functions.
228
229=head2 apply_metaroles( ... )
230
231This function will apply roles to one or more metaclasses for the specified
232class. It will return a new metaclass object for the class or role passed in
233the "for" parameter.
234
235It accepts the following parameters:
236
237=over 4
238
239=item * for => $name
240
241This specifies the class or for which to alter the meta classes. This can be a
242package name, or an appropriate meta-object (a L<Moose::Meta::Class> or
243L<Moose::Meta::Role>).
244
245=item * class_metaroles => \%roles
246
247This is a hash reference specifying which metaroles will be applied to the
248class metaclass and its contained metaclasses and helper classes.
249
250Each key should in turn point to an array reference of role names.
251
252It accepts the following keys:
253
254=over 8
255
256=item class
257
258=item attribute
259
260=item method
261
262=item wrapped_method
263
264=item instance
265
266=item constructor
267
268=item destructor
269
270=item error
271
272=back
273
274=item * role_metaroles => \%roles
275
276This is a hash reference specifying which metaroles will be applied to the
277role metaclass and its contained metaclasses and helper classes.
278
279It accepts the following keys:
280
281=over 8
282
283=item role
284
285=item attribute
286
287=item method
288
289=item required_method
290
291=item conflicting_method
292
293=item application_to_class
294
295=item application_to_role
296
297=item application_to_instance
298
299=item application_role_summation
300
301=back
302
303=back
304
305=head2 apply_base_class_roles( for => $class, roles => \@roles )
306
307This function will apply the specified roles to the object's base class.
308
309=head1 BUGS
310
311See L<Moose/BUGS> for details on reporting bugs.
312
313=head1 AUTHOR
314
315Dave Rolsky E<lt>autarch@urth.orgE<gt>
316
317=head1 COPYRIGHT AND LICENSE
318
319Copyright 2009 by Infinity Interactive, Inc.
320
321L<http://www.iinteractive.com>
322
323This library is free software; you can redistribute it and/or modify
324it under the same terms as Perl itself.
325
326=cut