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

File /usr/local/lib/perl/5.10.0/Moose/Exporter.pm
Statements Executed 1703
Total Time 0.0082646 seconds
Subroutines — ordered by exclusive time
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
5611908µs2.06msMoose::Exporter::::__ANON__[:292]Moose::Exporter::__ANON__[:292]
5611763µs763µsMoose::Exporter::::_late_curry_wrapperMoose::Exporter::_late_curry_wrapper
888505µs44.3msMoose::Exporter::::__ANON__[:425]Moose::Exporter::__ANON__[:425]
211300µs646µsMoose::Exporter::::_make_sub_exporter_paramsMoose::Exporter::_make_sub_exporter_params
4511297µs297µsMoose::Exporter::::__ANON__[:222]Moose::Exporter::__ANON__[:222]
2721222µs222µsMoose::Exporter::::_sub_from_packageMoose::Exporter::_sub_from_package
211130µs2.93msMoose::Exporter::::build_import_methodsMoose::Exporter::build_import_methods
811102µs194µsMoose::Exporter::::_strip_traitsMoose::Exporter::_strip_traits
81191µs133µsMoose::Exporter::::_strip_metaclassMoose::Exporter::_strip_metaclass
81190µs90µsMoose::Exporter::::_make_wrapped_sub_with_metaMoose::Exporter::_make_wrapped_sub_with_meta
161182µs246µsMoose::Exporter::::__ANON__[:284]Moose::Exporter::__ANON__[:284]
81179µs119µsMoose::Exporter::::_strip_meta_nameMoose::Exporter::_strip_meta_name
81162µs62µsMoose::Exporter::::_get_callerMoose::Exporter::_get_caller
21159µs59µsMoose::Exporter::::_make_init_metaMoose::Exporter::_make_init_meta
151258µs58µsMoose::Exporter::::_flag_as_reexportMoose::Exporter::_flag_as_reexport(xsub)
22249µs2.98msMoose::Exporter::::setup_import_methodsMoose::Exporter::setup_import_methods
21138µs38µsMoose::Exporter::::_make_import_subMoose::Exporter::_make_import_sub
21124µs24µsMoose::Exporter::::_parse_trait_aliasesMoose::Exporter::_parse_trait_aliases
21124µs69µsMoose::Exporter::::_follow_alsoMoose::Exporter::_follow_also
22224µs80µsMoose::Exporter::::importMoose::Exporter::import
21124µs24µsMoose::Exporter::::_make_unimport_subMoose::Exporter::_make_unimport_sub
21119µs19µsMoose::Exporter::::_follow_also_realMoose::Exporter::_follow_also_real
0000s0sMoose::Exporter::::BEGINMoose::Exporter::BEGIN
0000s0sMoose::Exporter::::__ANON__[:152]Moose::Exporter::__ANON__[:152]
0000s0sMoose::Exporter::::__ANON__[:270]Moose::Exporter::__ANON__[:270]
0000s0sMoose::Exporter::::__ANON__[:301]Moose::Exporter::__ANON__[:301]
0000s0sMoose::Exporter::::__ANON__[:323]Moose::Exporter::__ANON__[:323]
0000s0sMoose::Exporter::::__ANON__[:429]Moose::Exporter::__ANON__[:429]
0000s0sMoose::Exporter::::__ANON__[:443]Moose::Exporter::__ANON__[:443]
0000s0sMoose::Exporter::::__ANON__[:455]Moose::Exporter::__ANON__[:455]
0000s0sMoose::Exporter::::__ANON__[:526]Moose::Exporter::__ANON__[:526]
0000s0sMoose::Exporter::::__ANON__[:612]Moose::Exporter::__ANON__[:612]
0000s0sMoose::Exporter::::_apply_meta_traitsMoose::Exporter::_apply_meta_traits
0000s0sMoose::Exporter::::_curry_wrapperMoose::Exporter::_curry_wrapper
0000s0sMoose::Exporter::::_make_wrapped_subMoose::Exporter::_make_wrapped_sub
0000s0sMoose::Exporter::::_remove_keywordsMoose::Exporter::_remove_keywords
LineStmts.Exclusive
Time
Avg.Code
1package Moose::Exporter;
2
3327µs9µsuse strict;
# spent 11µs making 1 call to strict::import
4361µs20µsuse warnings;
# spent 23µs making 1 call to warnings::import
5
61800ns800nsour $VERSION = '1.15';
71600ns600nsour $XS_VERSION = $VERSION;
8127µs27µs$VERSION = eval $VERSION;
91600ns600nsour $AUTHORITY = 'cpan:STEVAN';
10
11331µs10µsuse Class::MOP;
# spent 4µs making 1 call to import
12329µs10µsuse List::MoreUtils qw( first_index uniq );
# spent 48µs making 1 call to Exporter::import
13324µs8µsuse Moose::Deprecated;
143127µs42µsuse Moose::Util::MetaRole;
# spent 5µs making 1 call to import
15342µs14µsuse Scalar::Util qw(reftype);
# spent 55µs making 1 call to Exporter::import
16370µs23µsuse Sub::Exporter 0.980;
# spent 191µs making 1 call to Sub::Exporter::__ANON__[/usr/local/share/perl/5.10.0/Sub/Exporter.pm:756] # spent 26µs making 1 call to UNIVERSAL::VERSION
17324µs8µsuse Sub::Name qw(subname);
# spent 45µs making 1 call to Exporter::import
18
1931.14ms380µsuse XSLoader;
# spent 3µs making 1 call to import
20
211104µs104µsXSLoader::load( 'Moose', $XS_VERSION );
# spent 102µs making 1 call to XSLoader::load
22
231300ns300nsmy %EXPORT_SPEC;
24
25
# spent 2.98ms (49µs+2.93) within Moose::Exporter::setup_import_methods which was called 2 times, avg 1.49ms/call: # once (24µs+1.56ms) at line 42 of /usr/local/lib/perl/5.10.0/Moose/Util/TypeConstraints.pm # once (25µs+1.37ms) at line 122 of /usr/local/lib/perl/5.10.0/Moose.pm
sub setup_import_methods {
26644µs7µs my ( $class, %args ) = @_;
27
28 my $exporting_package = $args{exporting_package} ||= caller();
29
30 $class->build_import_methods(
# spent 2.93ms making 2 calls to Moose::Exporter::build_import_methods, avg 1.47ms/call
31 %args,
32 install => [qw(import unimport init_meta)]
33 );
34}
35
36
# spent 2.93ms (130µs+2.80) within Moose::Exporter::build_import_methods which was called 2 times, avg 1.47ms/call: # 2 times (130µs+2.80ms) by Moose::Exporter::setup_import_methods at line 30, avg 1.47ms/call
sub build_import_methods {
3730147µs5µs my ( $class, %args ) = @_;
38
39 my $exporting_package = $args{exporting_package} ||= caller();
40
41 $EXPORT_SPEC{$exporting_package} = \%args;
42
43 my @exports_from = $class->_follow_also($exporting_package);
# spent 69µs making 2 calls to Moose::Exporter::_follow_also, avg 34µs/call
44
45 my $export_recorder = {};
46 my $is_reexport = {};
47
48 my $exports = $class->_make_sub_exporter_params(
# spent 646µs making 2 calls to Moose::Exporter::_make_sub_exporter_params, avg 323µs/call
49 [ @exports_from, $exporting_package ],
50 $export_recorder,
51 $is_reexport,
52 );
53
54 my $exporter = Sub::Exporter::build_exporter(
# spent 1.36ms making 2 calls to Sub::Exporter::build_exporter, avg 679µs/call
55 {
56 exports => $exports,
57 groups => { default => [':all'] }
58 }
59 );
60
61 my %methods;
62 $methods{import} = $class->_make_import_sub(
# spent 38µs making 2 calls to Moose::Exporter::_make_import_sub, avg 19µs/call
63 $exporting_package,
64 $exporter,
65 \@exports_from,
66 $is_reexport
67 );
68
69 $methods{unimport} = $class->_make_unimport_sub(
# spent 24µs making 2 calls to Moose::Exporter::_make_unimport_sub, avg 12µs/call
70 $exporting_package,
71 $exports,
72 $export_recorder,
73 $is_reexport
74 );
75
76 $methods{init_meta} = $class->_make_init_meta(
# spent 59µs making 2 calls to Moose::Exporter::_make_init_meta, avg 29µs/call
77 $exporting_package,
78 \%args
79 );
80
81 my $package = Class::MOP::Package->initialize($exporting_package);
# spent 120µs making 2 calls to Class::MOP::Package::initialize, avg 60µs/call
82 for my $to_install ( @{ $args{install} || [] } ) {
831660µs4µs my $symbol = '&' . $to_install;
84 next
85 unless $methods{$to_install}
# spent 218µs making 4 calls to Class::MOP::Package::has_package_symbol, avg 55µs/call
86 && !$package->has_package_symbol($symbol);
87 $package->add_package_symbol( $symbol, $methods{$to_install} );
# spent 270µs making 4 calls to Class::MOP::Package::add_package_symbol, avg 68µs/call
88 }
89
90 return ( $methods{import}, $methods{unimport}, $methods{init_meta} );
91}
92
93{
9426µs3µs my $seen = {};
95
96
# spent 69µs (24+45) within Moose::Exporter::_follow_also which was called 2 times, avg 34µs/call: # 2 times (24µs+45µs) by Moose::Exporter::build_import_methods at line 43, avg 34µs/call
sub _follow_also {
97849µs6µs my $class = shift;
98 my $exporting_package = shift;
99
100 local %$seen = ( $exporting_package => 1 );
101
102 return uniq( _follow_also_real($exporting_package) );
# spent 26µs making 2 calls to List::MoreUtils::uniq, avg 13µs/call # spent 19µs making 2 calls to Moose::Exporter::_follow_also_real, avg 10µs/call
103 }
104
105
# spent 19µs within Moose::Exporter::_follow_also_real which was called 2 times, avg 10µs/call: # 2 times (19µs+0s) by Moose::Exporter::_follow_also at line 102, avg 10µs/call
sub _follow_also_real {
106812µs1µs my $exporting_package = shift;
107
108 if ( !exists $EXPORT_SPEC{$exporting_package} ) {
109 my $loaded = Class::MOP::is_class_loaded($exporting_package);
110
111 die "Package in also ($exporting_package) does not seem to "
112 . "use Moose::Exporter"
113 . ( $loaded ? "" : " (is it loaded?)" );
114 }
115
116 my $also = $EXPORT_SPEC{$exporting_package}{also};
117
118 return unless defined $also;
119
120 my @also = ref $also ? @{$also} : $also;
121
122 for my $package (@also) {
123 die
124 "Circular reference in 'also' parameter to Moose::Exporter between $exporting_package and $package"
125 if $seen->{$package};
126
127 $seen->{$package} = 1;
128 }
129
130 return @also, map { _follow_also_real($_) } @also;
131 }
132}
133
134
# spent 24µs within Moose::Exporter::_parse_trait_aliases which was called 2 times, avg 12µs/call: # 2 times (24µs+0s) by Moose::Exporter::_make_sub_exporter_params at line 196, avg 12µs/call
sub _parse_trait_aliases {
1351016µs2µs my $class = shift;
136 my ($package, $aliases) = @_;
137
138 my @ret;
139 for my $alias (@$aliases) {
140 my $name;
141 if (ref($alias)) {
142 reftype($alias) eq 'ARRAY'
143 or Moose->throw_error(reftype($alias) . " references are not "
144 . "valid arguments to the 'trait_aliases' "
145 . "option");
146
147 ($alias, $name) = @$alias;
148 }
149 else {
150 ($name = $alias) =~ s/.*:://;
151 }
152 push @ret, subname "${package}::${name}" => sub () { $alias };
153 }
154
155 return @ret;
156}
157
158
# spent 646µs (300+346) within Moose::Exporter::_make_sub_exporter_params which was called 2 times, avg 323µs/call: # 2 times (300µs+346µs) by Moose::Exporter::build_import_methods at line 48, avg 323µs/call
sub _make_sub_exporter_params {
1591414µs1µs my $class = shift;
160 my $packages = shift;
161 my $export_recorder = shift;
162 my $is_reexport = shift;
163
164 my %exports;
165
166 for my $package ( @{$packages} ) {
1671037µs4µs my $args = $EXPORT_SPEC{$package}
168 or die "The $package package does not use Moose::Exporter\n";
169
170 for my $name ( @{ $args->{with_meta} } ) {
1712498µs4µs my $sub = $class->_sub_from_package( $package, $name )
# spent 72µs making 8 calls to Moose::Exporter::_sub_from_package, avg 9µs/call
172 or next;
173
174 my $fq_name = $package . '::' . $name;
175
176 $exports{$name} = $class->_make_wrapped_sub_with_meta(
# spent 90µs making 8 calls to Moose::Exporter::_make_wrapped_sub_with_meta, avg 11µs/call
177 $fq_name,
178 $sub,
179 $export_recorder,
180 );
181 }
182
183 for my $name ( @{ $args->{with_caller} } ) {
184 my $sub = $class->_sub_from_package( $package, $name )
185 or next;
186
187 my $fq_name = $package . '::' . $name;
188
189 $exports{$name} = $class->_make_wrapped_sub(
190 $fq_name,
191 $sub,
192 $export_recorder,
193 );
194 }
195
196 my @extra_exports = $class->_parse_trait_aliases(
# spent 24µs making 2 calls to Moose::Exporter::_parse_trait_aliases, avg 12µs/call
197 $package, $args->{trait_aliases},
198 );
199 for my $name ( @{ $args->{as_is} }, @extra_exports ) {
20084145µs2µs my ( $sub, $coderef_name );
201
2024694µs2µs if ( ref $name ) {
203 $sub = $name;
204
205 my $coderef_pkg;
206 ( $coderef_pkg, $coderef_name )
# spent 10µs making 2 calls to Class::MOP::get_code_info, avg 5µs/call
207 = Class::MOP::get_code_info($name);
208
209 if ( $coderef_pkg ne $package ) {
210 $is_reexport->{$coderef_name} = 1;
211 }
212 }
213 else {
214 $sub = $class->_sub_from_package( $package, $name )
# spent 150µs making 19 calls to Moose::Exporter::_sub_from_package, avg 8µs/call
215 or next;
216
217 $coderef_name = $name;
218 }
219
220 $export_recorder->{$sub} = 1;
221
2224560µs1µs
# spent 297µs within Moose::Exporter::__ANON__[/usr/local/lib/perl/5.10.0/Moose/Exporter.pm:222] which was called 45 times, avg 7µs/call: # 45 times (297µs+0s) by Sub::Exporter::default_generator at line 856 of /usr/local/share/perl/5.10.0/Sub/Exporter.pm, avg 7µs/call
$exports{$coderef_name} = sub {$sub};
223 }
224 }
225
226 return \%exports;
227}
228
229
# spent 222µs within Moose::Exporter::_sub_from_package which was called 27 times, avg 8µs/call: # 19 times (150µs+0s) by Moose::Exporter::_make_sub_exporter_params at line 214, avg 8µs/call # 8 times (72µs+0s) by Moose::Exporter::_make_sub_exporter_params at line 171, avg 9µs/call
sub _sub_from_package {
230135106µs783ns my $sclass = shift;
231 my $package = shift;
232 my $name = shift;
233
2342759µs2µs my $sub = do {
2353946µs315µs no strict 'refs';
# spent 23µs making 1 call to strict::unimport
236 \&{ $package . '::' . $name };
237 };
238
239 return $sub if defined &$sub;
240
241 Carp::cluck "Trying to export undefined sub ${package}::${name}";
242
243 return;
244}
245
2461200ns200nsour $CALLER;
247
248sub _make_wrapped_sub {
249 my $self = shift;
250 my $fq_name = shift;
251 my $sub = shift;
252 my $export_recorder = shift;
253
254 # We need to set the package at import time, so that when
255 # package Foo imports has(), we capture "Foo" as the
256 # package. This lets other packages call Foo::has() and get
257 # the right package. This is done for backwards compatibility
258 # with existing production code, not because this is a good
259 # idea ;)
260 return sub {
261 my $caller = $CALLER;
262
263 my $wrapper = $self->_curry_wrapper( $sub, $fq_name, $caller );
264
265 my $sub = subname( $fq_name => $wrapper );
266
267 $export_recorder->{$sub} = 1;
268
269 return $sub;
270 };
271}
272
273
# spent 90µs within Moose::Exporter::_make_wrapped_sub_with_meta which was called 8 times, avg 11µs/call: # 8 times (90µs+0s) by Moose::Exporter::_make_sub_exporter_params at line 176, avg 11µs/call
sub _make_wrapped_sub_with_meta {
2744068µs2µs my $self = shift;
275 my $fq_name = shift;
276 my $sub = shift;
277 my $export_recorder = shift;
278
279
# spent 2.06ms (908µs+1.15) within Moose::Exporter::__ANON__[/usr/local/lib/perl/5.10.0/Moose/Exporter.pm:292] which was called 56 times, avg 37µs/call: # 56 times (908µs+1.15ms) by Sub::Exporter::default_generator at line 856 of /usr/local/share/perl/5.10.0/Sub/Exporter.pm, avg 37µs/call
return sub {
2802801.08ms4µs my $caller = $CALLER;
281
282 my $wrapper = $self->_late_curry_wrapper(
283 $sub, $fq_name,
2841676µs5µs
# spent 246µs (82+163) within Moose::Exporter::__ANON__[/usr/local/lib/perl/5.10.0/Moose/Exporter.pm:284] which was called 16 times, avg 15µs/call: # 16 times (82µs+163µs) by Moose::Exporter::_late_curry_wrapper or Moose::Exporter::__ANON__[/usr/local/lib/perl/5.10.0/Moose/Exporter.pm:323] at line 321, avg 15µs/call
sub { Class::MOP::class_of(shift) } => $caller
# spent 763µs making 56 calls to Moose::Exporter::_late_curry_wrapper, avg 14µs/call # spent 163µs making 16 calls to Class::MOP::class_of, avg 10µs/call
285 );
286
287 my $sub = subname( $fq_name => $wrapper );
# spent 384µs making 56 calls to Sub::Name::subname, avg 7µs/call
288
289 $export_recorder->{$sub} = 1;
290
291 return $sub;
292 };
293}
294
295sub _curry_wrapper {
296 my $class = shift;
297 my $sub = shift;
298 my $fq_name = shift;
299 my @extra = @_;
300
301 my $wrapper = sub { $sub->( @extra, @_ ) };
302 if ( my $proto = prototype $sub ) {
303
304 # XXX - Perl's prototype sucks. Use & to make set_prototype
305 # ignore the fact that we're passing "private variables"
306 &Scalar::Util::set_prototype( $wrapper, $proto );
307 }
308 return $wrapper;
309}
310
311
# spent 763µs within Moose::Exporter::_late_curry_wrapper which was called 56 times, avg 14µs/call: # 56 times (763µs+0s) by Moose::Exporter::_make_wrapped_sub_with_meta or Moose::Exporter::__ANON__[/usr/local/lib/perl/5.10.0/Moose/Exporter.pm:292] or Moose::Exporter::__ANON__[/usr/local/lib/perl/5.10.0/Moose/Exporter.pm:284] at line 284, avg 14µs/call
sub _late_curry_wrapper {
312448643µs1µs my $class = shift;
313 my $sub = shift;
314 my $fq_name = shift;
315 my $extra = shift;
316 my @ex_args = @_;
317
318 my $wrapper = sub {
319
320 # resolve curried arguments at runtime via this closure
32132180µs6µs my @curry = ( $extra->(@ex_args) );
# spent 246µs making 16 calls to Moose::Exporter::__ANON__[/usr/local/lib/perl/5.10.0/Moose/Exporter.pm:284], avg 15µs/call
322 return $sub->( @curry, @_ );
# spent 29.6ms making 4 calls to Moose::extends, avg 7.39ms/call # spent 20.6ms making 8 calls to Moose::has, avg 2.58ms/call # spent 2.70ms making 4 calls to Moose::override, avg 675µs/call
323 };
324
325 if ( my $proto = prototype $sub ) {
326
327 # XXX - Perl's prototype sucks. Use & to make set_prototype
328 # ignore the fact that we're passing "private variables"
329 &Scalar::Util::set_prototype( $wrapper, $proto );
330 }
331 return $wrapper;
332}
333
334
# spent 38µs within Moose::Exporter::_make_import_sub which was called 2 times, avg 19µs/call: # 2 times (38µs+0s) by Moose::Exporter::build_import_methods at line 62, avg 19µs/call
sub _make_import_sub {
3351229µs2µs shift;
336 my $exporting_package = shift;
337 my $exporter = shift;
338 my $exports_from = shift;
339 my $is_reexport = shift;
340
341
# spent 44.3ms (505µs+43.8) within Moose::Exporter::__ANON__[/usr/local/lib/perl/5.10.0/Moose/Exporter.pm:425] which was called 8 times, avg 5.54ms/call: # once (71µs+6.77ms) at line 5 of /home/tamil/util/marc-moose/lib/MARC/Moose/Record.pm # once (68µs+6.18ms) by MARC::Moose::Parser::BEGIN at line 5 of /home/tamil/util/marc-moose/lib/MARC/Moose/Parser.pm # once (70µs+5.83ms) at line 5 of /home/tamil/util/marc-moose/lib/MARC/Moose/Parser/Marcxml.pm # once (69µs+5.77ms) at line 5 of /home/tamil/util/marc-moose/lib/MARC/Moose/Field/Std.pm # once (68µs+5.72ms) at line 5 of /home/tamil/util/marc-moose/lib/MARC/Moose/Parser/MarcxmlSax.pm # once (52µs+5.63ms) by MARC::Moose::Field::BEGIN at line 5 of /home/tamil/util/marc-moose/lib/MARC/Moose/Field.pm # once (53µs+5.57ms) by MARC::Moose::Field::Control::BEGIN at line 5 of /home/tamil/util/marc-moose/lib/MARC/Moose/Field/Control.pm # once (54µs+2.31ms) at line 35 of /usr/local/lib/perl/5.10.0/Moose.pm
return sub {
342
343 # I think we could use Sub::Exporter's collector feature
344 # to do this, but that would be rather gross, since that
345 # feature isn't really designed to return a value to the
346 # caller of the exporter sub.
347 #
348 # Also, this makes sure we preserve backwards compat for
349 # _get_caller, so it always sees the arguments in the
350 # expected order.
351160537µs3µs my $traits;
352 ( $traits, @_ ) = _strip_traits(@_);
# spent 194µs making 8 calls to Moose::Exporter::_strip_traits, avg 24µs/call
353
354 my $metaclass;
355 ( $metaclass, @_ ) = _strip_metaclass(@_);
# spent 133µs making 8 calls to Moose::Exporter::_strip_metaclass, avg 17µs/call
356 $metaclass
357 = Moose::Util::resolve_metaclass_alias( 'Class' => $metaclass )
358 if defined $metaclass && length $metaclass;
359
360 my $meta_name;
361 ( $meta_name, @_ ) = _strip_meta_name(@_);
# spent 119µs making 8 calls to Moose::Exporter::_strip_meta_name, avg 15µs/call
362
363 # Normally we could look at $_[0], but in some weird cases
364 # (involving goto &Moose::import), $_[0] ends as something
365 # else (like Squirrel).
366 my $class = $exporting_package;
367
368 $CALLER = _get_caller(@_);
# spent 62µs making 8 calls to Moose::Exporter::_get_caller, avg 8µs/call
369
370 # this works because both pragmas set $^H (see perldoc
371 # perlvar) which affects the current compilation -
372 # i.e. the file who use'd us - which is why we don't need
373 # to do anything special to make it affect that file
374 # rather than this one (which is already compiled)
375
376 strict->import;
# spent 52µs making 8 calls to strict::import, avg 7µs/call
377 warnings->import;
# spent 175µs making 8 calls to warnings::import, avg 22µs/call
378
379 my $did_init_meta;
380866µs8µs for my $c ( grep { $_->can('init_meta') } $class, @{$exports_from} ) {
# spent 44µs making 8 calls to UNIVERSAL::can, avg 6µs/call
381
382 # init_meta can apply a role, which when loaded uses
383 # Moose::Exporter, which in turn sets $CALLER, so we need
384 # to protect against that.
3852159µs3µs local $CALLER = $CALLER;
386 $c->init_meta(
# spent 27.5ms making 7 calls to Moose::init_meta, avg 3.93ms/call
387 for_class => $CALLER,
388 metaclass => $metaclass,
389 meta_name => $meta_name,
390 );
391 $did_init_meta = 1;
392 }
393
394 if ( $did_init_meta && @{$traits} ) {
395
396 # The traits will use Moose::Role, which in turn uses
397 # Moose::Exporter, which in turn sets $CALLER, so we need
398 # to protect against that.
399 local $CALLER = $CALLER;
400 _apply_meta_traits( $CALLER, $traits );
401 }
402 elsif ( @{$traits} ) {
403 require Moose;
404 Moose->throw_error(
405 "Cannot provide traits when $class does not have an init_meta() method"
406 );
407 }
408
409 my ( undef, @args ) = @_;
410 my $extra = shift @args if ref $args[0] eq 'HASH';
411
412 $extra ||= {};
4131619µs1µs if ( !$extra->{into} ) {
414 $extra->{into_level} ||= 0;
415 $extra->{into_level}++;
416 }
417
418 $class->$exporter( $extra, @args );
# spent 15.4ms making 8 calls to Sub::Exporter::__ANON__[/usr/local/share/perl/5.10.0/Sub/Exporter.pm:756], avg 1.93ms/call
419
420 for my $name ( keys %{$is_reexport} ) {
421334µs11µs no strict 'refs';
# spent 21µs making 1 call to strict::unimport
4223797µs266µs no warnings 'once';
# spent 21µs making 1 call to warnings::unimport
42314110µs8µs _flag_as_reexport( \*{ join q{::}, $CALLER, $name } );
# spent 58µs making 14 calls to Moose::Exporter::_flag_as_reexport, avg 4µs/call
424 }
425 };
426}
427
428
# spent 194µs (102+92) within Moose::Exporter::_strip_traits which was called 8 times, avg 24µs/call: # 8 times (102µs+92µs) by Moose::Exporter::_make_import_sub or Moose::Exporter::__ANON__[/usr/local/lib/perl/5.10.0/Moose/Exporter.pm:425] at line 352, avg 24µs/call
sub _strip_traits {
42924164µs7µs my $idx = first_index { ( $_ || '' ) eq '-traits' } @_;
# spent 92µs making 8 calls to List::MoreUtils::firstidx, avg 11µs/call
430
431 return ( [], @_ ) unless $idx >= 0 && $#_ >= $idx + 1;
432
433 my $traits = $_[ $idx + 1 ];
434
435 splice @_, $idx, 2;
436
437 $traits = [$traits] unless ref $traits;
438
439 return ( $traits, @_ );
440}
441
442
# spent 133µs (91+43) within Moose::Exporter::_strip_metaclass which was called 8 times, avg 17µs/call: # 8 times (91µs+43µs) by Moose::Exporter::_make_import_sub or Moose::Exporter::__ANON__[/usr/local/lib/perl/5.10.0/Moose/Exporter.pm:425] at line 355, avg 17µs/call
sub _strip_metaclass {
44324104µs4µs my $idx = first_index { ( $_ || '' ) eq '-metaclass' } @_;
# spent 43µs making 8 calls to List::MoreUtils::firstidx, avg 5µs/call
444
445 return ( undef, @_ ) unless $idx >= 0 && $#_ >= $idx + 1;
446
447 my $metaclass = $_[ $idx + 1 ];
448
449 splice @_, $idx, 2;
450
451 return ( $metaclass, @_ );
452}
453
454
# spent 119µs (79+40) within Moose::Exporter::_strip_meta_name which was called 8 times, avg 15µs/call: # 8 times (79µs+40µs) by Moose::Exporter::_make_import_sub or Moose::Exporter::__ANON__[/usr/local/lib/perl/5.10.0/Moose/Exporter.pm:425] at line 361, avg 15µs/call
sub _strip_meta_name {
4552494µs4µs my $idx = first_index { ( $_ || '' ) eq '-meta_name' } @_;
# spent 40µs making 8 calls to List::MoreUtils::firstidx, avg 5µs/call
456
457 return ( 'meta', @_ ) unless $idx >= 0 && $#_ >= $idx + 1;
458
459 my $meta_name = $_[ $idx + 1 ];
460
461 splice @_, $idx, 2;
462
463 return ( $meta_name, @_ );
464}
465
466sub _apply_meta_traits {
467 my ( $class, $traits ) = @_;
468
469 return unless @{$traits};
470
471 my $meta = Class::MOP::class_of($class);
472
473 my $type = ( split /::/, ref $meta )[-1]
474 or Moose->throw_error(
475 'Cannot determine metaclass type for trait application . Meta isa '
476 . ref $meta );
477
478 my @resolved_traits = map {
479 ref $_
480 ? $_
481 : Moose::Util::resolve_metatrait_alias( $type => $_ )
482 } @$traits;
483
484 return unless @resolved_traits;
485
486 my %args = ( for => $class );
487
488 if ( $meta->isa('Moose::Meta::Role') ) {
489 $args{role_metaroles} = { role => \@resolved_traits };
490 }
491 else {
492 $args{class_metaroles} = { class => \@resolved_traits };
493 }
494
495 Moose::Util::MetaRole::apply_metaroles(%args);
496}
497
498
# spent 62µs within Moose::Exporter::_get_caller which was called 8 times, avg 8µs/call: # 8 times (62µs+0s) by Moose::Exporter::_make_import_sub or Moose::Exporter::__ANON__[/usr/local/lib/perl/5.10.0/Moose/Exporter.pm:425] at line 368, avg 8µs/call
sub _get_caller {
499
500 # 1 extra level because it's called by import so there's a layer
501 # of indirection
5021631µs2µs my $offset = 1;
503
504 return
505 ( ref $_[1] && defined $_[1]->{into} ) ? $_[1]->{into}
506 : ( ref $_[1] && defined $_[1]->{into_level} )
507 ? caller( $offset + $_[1]->{into_level} )
508 : caller($offset);
509}
510
511
# spent 24µs within Moose::Exporter::_make_unimport_sub which was called 2 times, avg 12µs/call: # 2 times (24µs+0s) by Moose::Exporter::build_import_methods at line 69, avg 12µs/call
sub _make_unimport_sub {
5121215µs1µs shift;
513 my $exporting_package = shift;
514 my $exports = shift;
515 my $export_recorder = shift;
516 my $is_reexport = shift;
517
518 return sub {
519 my $caller = scalar caller();
520 Moose::Exporter->_remove_keywords(
521 $caller,
522 [ keys %{$exports} ],
523 $export_recorder,
524 $is_reexport,
525 );
526 };
527}
528
529sub _remove_keywords {
530 shift;
531 my $package = shift;
532 my $keywords = shift;
533 my $recorded_exports = shift;
534 my $is_reexport = shift;
535
536369µs23µs no strict 'refs';
# spent 23µs making 1 call to strict::unimport
537
538 foreach my $name ( @{$keywords} ) {
539 if ( defined &{ $package . '::' . $name } ) {
540 my $sub = \&{ $package . '::' . $name };
541
542 # make sure it is from us
543 next unless $recorded_exports->{$sub};
544
545 if ( $is_reexport->{$name} ) {
5463413µs138µs no strict 'refs';
# spent 23µs making 1 call to strict::unimport
547 next
548 unless _export_is_flagged(
549 \*{ join q{::} => $package, $name } );
550 }
551
552 # and if it is from us, then undef the slot
553 delete ${ $package . '::' }{$name};
554 }
555 }
556}
557
558
# spent 59µs within Moose::Exporter::_make_init_meta which was called 2 times, avg 29µs/call: # 2 times (59µs+0s) by Moose::Exporter::build_import_methods at line 76, avg 29µs/call
sub _make_init_meta {
5591834µs2µs shift;
560 my $class = shift;
561 my $args = shift;
562
563 my %old_style_roles;
564 for my $role (
565 map {"${_}_roles"}
566 qw(
567 metaclass
568 attribute_metaclass
569 method_metaclass
570 wrapped_method_metaclass
571 instance_metaclass
572 constructor_class
573 destructor_class
574 error_class
575 )
576 ) {
5771613µs800ns $old_style_roles{$role} = $args->{$role}
578 if exists $args->{$role};
579 }
580
581 my %base_class_roles;
582 %base_class_roles = ( roles => $args->{base_class_roles} )
583 if exists $args->{base_class_roles};
584
585 my %new_style_roles = map { $_ => $args->{$_} }
586 grep { exists $args->{$_} } qw( class_metaroles role_metaroles );
587
588 return unless %new_style_roles || %old_style_roles || %base_class_roles;
589
590 return sub {
591 shift;
592 my %options = @_;
593
594 return unless Class::MOP::class_of( $options{for_class} );
595
596 if ( %new_style_roles || %old_style_roles ) {
597 Moose::Util::MetaRole::apply_metaroles(
598 for => $options{for_class},
599 %new_style_roles,
600 %old_style_roles,
601 );
602 }
603
604 Moose::Util::MetaRole::apply_base_class_roles(
605 for_class => $options{for_class},
606 %base_class_roles,
607 )
608 if Class::MOP::class_of( $options{for_class} )
609 ->isa('Moose::Meta::Class');
610
611 return Class::MOP::class_of( $options{for_class} );
612 };
613}
614
615
# spent 80µs (24+56) within Moose::Exporter::import which was called 2 times, avg 40µs/call: # once (14µs+31µs) at line 15 of /usr/local/lib/perl/5.10.0/Moose.pm # once (10µs+25µs) at line 7 of /usr/local/lib/perl/5.10.0/Moose/Util/TypeConstraints.pm
sub import {
616420µs5µs strict->import;
# spent 11µs making 2 calls to strict::import, avg 6µs/call
617 warnings->import;
# spent 45µs making 2 calls to warnings::import, avg 22µs/call
618}
619
62019µs9µs1;
621
622__END__
623
624=head1 NAME
625
626Moose::Exporter - make an import() and unimport() just like Moose.pm
627
628=head1 SYNOPSIS
629
630 package MyApp::Moose;
631
632 use Moose ();
633 use Moose::Exporter;
634
635 Moose::Exporter->setup_import_methods(
636 with_meta => [ 'has_rw', 'sugar2' ],
637 as_is => [ 'sugar3', \&Some::Random::thing ],
638 also => 'Moose',
639 );
640
641 sub has_rw {
642 my ( $meta, $name, %options ) = @_;
643 $meta->add_attribute(
644 $name,
645 is => 'rw',
646 %options,
647 );
648 }
649
650 # then later ...
651 package MyApp::User;
652
653 use MyApp::Moose;
654
655 has 'name';
656 has_rw 'size';
657 thing;
658
659 no MyApp::Moose;
660
661=head1 DESCRIPTION
662
663This module encapsulates the exporting of sugar functions in a
664C<Moose.pm>-like manner. It does this by building custom C<import>,
665C<unimport>, and C<init_meta> methods for your module, based on a spec you
666provide.
667
668It also lets you "stack" Moose-alike modules so you can export Moose's sugar
669as well as your own, along with sugar from any random C<MooseX> module, as
670long as they all use C<Moose::Exporter>. This feature exists to let you bundle
671a set of MooseX modules into a policy module that developers can use directly
672instead of using Moose itself.
673
674To simplify writing exporter modules, C<Moose::Exporter> also imports
675C<strict> and C<warnings> into your exporter module, as well as into
676modules that use it.
677
678=head1 METHODS
679
680This module provides two public methods:
681
682=over 4
683
684=item B<< Moose::Exporter->setup_import_methods(...) >>
685
686When you call this method, C<Moose::Exporter> builds custom C<import>,
687C<unimport>, and C<init_meta> methods for your module. The C<import> method
688will export the functions you specify, and can also re-export functions
689exported by some other module (like C<Moose.pm>).
690
691The C<unimport> method cleans the caller's namespace of all the exported
692functions. This includes any functions you re-export from other
693packages. However, if the consumer of your package also imports those
694functions from the original package, they will I<not> be cleaned.
695
696If you pass any parameters for L<Moose::Util::MetaRole>, this method will
697generate an C<init_meta> for you as well (see below for details). This
698C<init_meta> will call C<Moose::Util::MetaRole::apply_metaroles> and
699C<Moose::Util::MetaRole::apply_base_class_roles> as needed.
700
701Note that if any of these methods already exist, they will not be
702overridden, you will have to use C<build_import_methods> to get the
703coderef that would be installed.
704
705This method accepts the following parameters:
706
707=over 8
708
709=item * with_meta => [ ... ]
710
711This list of function I<names only> will be wrapped and then exported. The
712wrapper will pass the metaclass object for the caller as its first argument.
713
714Many sugar functions will need to use this metaclass object to do something to
715the calling package.
716
717=item * as_is => [ ... ]
718
719This list of function names or sub references will be exported as-is. You can
720identify a subroutine by reference, which is handy to re-export some other
721module's functions directly by reference (C<\&Some::Package::function>).
722
723If you do export some other package's function, this function will never be
724removed by the C<unimport> method. The reason for this is we cannot know if
725the caller I<also> explicitly imported the sub themselves, and therefore wants
726to keep it.
727
728=item * trait_aliases => [ ... ]
729
730This is a list of package names which should have shortened alias exported,
731similar to the functionality of L<aliased>. Each element in the list can be
732either a package name, in which case the export will be named as the last
733namespace component of the package, or an arrayref, whose first element is the
734package to alias to, and second element is the alias to export.
735
736=item * also => $name or \@names
737
738This is a list of modules which contain functions that the caller
739wants to export. These modules must also use C<Moose::Exporter>. The
740most common use case will be to export the functions from C<Moose.pm>.
741Functions specified by C<with_meta> or C<as_is> take precedence over
742functions exported by modules specified by C<also>, so that a module
743can selectively override functions exported by another module.
744
745C<Moose::Exporter> also makes sure all these functions get removed
746when C<unimport> is called.
747
748=back
749
750You can also provide parameters for C<Moose::Util::MetaRole::apply_metaroles>
751and C<Moose::Util::MetaRole::base_class_roles>. Specifically, valid parameters
752are "class_metaroles", "role_metaroles", and "base_class_roles".
753
754=item B<< Moose::Exporter->build_import_methods(...) >>
755
756Returns two or three code refs, one for C<import>, one for
757C<unimport>, and optionally one for C<init_meta>, if the appropriate
758options are passed in.
759
760Accepts the additional C<install> option, which accepts an arrayref of method
761names to install into your exporting package. The valid options are C<import>,
762C<unimport>, and C<init_meta>. Calling C<setup_import_methods> is equivalent
763to calling C<build_import_methods> with C<< install => [qw(import unimport
764init_meta)] >> except that it doesn't also return the methods.
765
766Used by C<setup_import_methods>.
767
768=back
769
770=head1 IMPORTING AND init_meta
771
772If you want to set an alternative base object class or metaclass class, see
773above for details on how this module can call L<Moose::Util::MetaRole> for
774you.
775
776If you want to do something that is not supported by this module, simply
777define an C<init_meta> method in your class. The C<import> method that
778C<Moose::Exporter> generates for you will call this method (if it exists). It
779will always pass the caller to this method via the C<for_class> parameter.
780
781Most of the time, your C<init_meta> method will probably just call C<<
782Moose->init_meta >> to do the real work:
783
784 sub init_meta {
785 shift; # our class name
786 return Moose->init_meta( @_, metaclass => 'My::Metaclass' );
787 }
788
789Keep in mind that C<build_import_methods> will return an C<init_meta>
790method for you, which you can also call from within your custom
791C<init_meta>:
792
793 my ( $import, $unimport, $init_meta ) =
794 Moose::Exporter->build_import_methods( ... );
795
796 sub import {
797 my $class = shift;
798
799 ...
800
801 $class->$import(...);
802
803 ...
804 }
805
806 sub unimport { goto &$unimport }
807
808 sub init_meta {
809 my $class = shift;
810
811 ...
812
813 $class->$init_meta(...);
814
815 ...
816 }
817
818=head1 METACLASS TRAITS
819
820The C<import> method generated by C<Moose::Exporter> will allow the
821user of your module to specify metaclass traits in a C<-traits>
822parameter passed as part of the import:
823
824 use Moose -traits => 'My::Meta::Trait';
825
826 use Moose -traits => [ 'My::Meta::Trait', 'My::Other::Trait' ];
827
828These traits will be applied to the caller's metaclass
829instance. Providing traits for an exporting class that does not create
830a metaclass for the caller is an error.
831
832=head1 BUGS
833
834See L<Moose/BUGS> for details on reporting bugs.
835
836=head1 AUTHOR
837
838Dave Rolsky E<lt>autarch@urth.orgE<gt>
839
840This is largely a reworking of code in Moose.pm originally written by
841Stevan Little and others.
842
843=head1 COPYRIGHT AND LICENSE
844
845Copyright 2009 by Infinity Interactive, Inc.
846
847L<http://www.iinteractive.com>
848
849This library is free software; you can redistribute it and/or modify
850it under the same terms as Perl itself.
851
852=cut
# spent 58µs within Moose::Exporter::_flag_as_reexport which was called 14 times, avg 4µs/call: # 14 times (58µs+0s) by Moose::Exporter::_make_import_sub or Moose::Exporter::__ANON__[/usr/local/lib/perl/5.10.0/Moose/Exporter.pm:425] at line 423 of /usr/local/lib/perl/5.10.0/Moose/Exporter.pm, avg 4µs/call
sub Moose::Exporter::_flag_as_reexport; # xsub