← 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:11 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 {
26211µs5µs my ( $class, %args ) = @_;
27
2827µs3µs my $exporting_package = $args{exporting_package} ||= caller();
29
30226µs13µs $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 {
37211µs5µs my ( $class, %args ) = @_;
38
3923µs1µs my $exporting_package = $args{exporting_package} ||= caller();
40
4123µs2µs $EXPORT_SPEC{$exporting_package} = \%args;
42
43215µs7µs my @exports_from = $class->_follow_also($exporting_package);
# spent 69µs making 2 calls to Moose::Exporter::_follow_also, avg 34µs/call
44
4522µs1µs my $export_recorder = {};
4621µs650ns my $is_reexport = {};
47
48216µs8µs 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
54221µs11µs 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
612700ns350ns my %methods;
62217µs8µs $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
69214µs7µs $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
76218µs9µs $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
81214µs7µs my $package = Class::MOP::Package->initialize($exporting_package);
# spent 120µs making 2 calls to Class::MOP::Package::initialize, avg 60µs/call
8226µs3µs for my $to_install ( @{ $args{install} || [] } ) {
8366µs917ns my $symbol = '&' . $to_install;
84 next
85633µs6µs 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);
87420µs5µs $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
9027µs3µs 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 {
9722µs1µs my $class = shift;
9822µs750ns my $exporting_package = shift;
99
10025µs3µs local %$seen = ( $exporting_package => 1 );
101
102240µs20µs 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 {
10622µs1µs my $exporting_package = shift;
107
10822µs1µs 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
11623µs1µs my $also = $EXPORT_SPEC{$exporting_package}{also};
117
11824µs2µs 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 {
13522µs1µs my $class = shift;
13627µs3µs my ($package, $aliases) = @_;
137
1382900ns450ns my @ret;
13923µs2µs 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
15523µs2µs 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 {
15922µs1µs my $class = shift;
16022µs800ns my $packages = shift;
16121µs650ns my $export_recorder = shift;
16221µs500ns my $is_reexport = shift;
163
1642800ns400ns my %exports;
165
16624µs2µs for my $package ( @{$packages} ) {
16722µs1µs my $args = $EXPORT_SPEC{$package}
168 or die "The $package package does not use Moose::Exporter\n";
169
17025µs2µs for my $name ( @{ $args->{with_meta} } ) {
171841µs5µ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
17485µs638ns my $fq_name = $package . '::' . $name;
175
176852µs6µs $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
18325µs2µs 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
196218µs9µs 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 );
19927µs3µs for my $name ( @{ $args->{as_is} }, @extra_exports ) {
200216µs295ns my ( $sub, $coderef_name );
201
2022114µs667ns if ( ref $name ) {
2032700ns350ns $sub = $name;
204
2052600ns300ns my $coderef_pkg;
206214µs7µs ( $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
20923µs2µs if ( $coderef_pkg ne $package ) {
210 $is_reexport->{$coderef_name} = 1;
211 }
212 }
213 else {
2141969µs4µs $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
217197µs379ns $coderef_name = $name;
218 }
219
2202150µs2µs $export_recorder->{$sub} = 1;
221
22266135µs2µ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
22623µs2µs 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 {
2302713µs467ns my $sclass = shift;
2312710µs378ns my $package = shift;
2322710µs374ns my $name = shift;
233
2342721µs778ns my $sub = do {
2353946µs315µs no strict 'refs';
# spent 23µs making 1 call to strict::unimport
2362759µs2µs \&{ $package . '::' . $name };
237 };
238
2392752µs2µs 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 {
27485µs638ns my $self = shift;
27584µs562ns my $fq_name = shift;
27683µs412ns my $sub = shift;
27783µs388ns 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 {
2805641µs732ns my $caller = $CALLER;
281
282 my $wrapper = $self->_late_curry_wrapper(
283 $sub, $fq_name,
28472479µs7µ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
28756430µs8µs my $sub = subname( $fq_name => $wrapper );
# spent 384µs making 56 calls to Sub::Name::subname, avg 7µs/call
288
28956137µs2µs $export_recorder->{$sub} = 1;
290
2915667µs1µs return $sub;
292852µs7µs };
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 {
3125631µs552ns my $class = shift;
3135634µs612ns my $sub = shift;
3145678µs1µs my $fq_name = shift;
3155619µs332ns my $extra = shift;
3165695µs2µs my @ex_args = @_;
317
318 my $wrapper = sub {
319
320 # resolve curried arguments at runtime via this closure
3211683µs5µ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
3221697µs6µs 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
32356229µs4µs };
324
3255680µs1µs 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 }
3315679µs1µs 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 {
33521µs550ns shift;
33622µs1µs my $exporting_package = shift;
33721µs650ns my $exporter = shift;
33821µs550ns my $exports_from = shift;
33922µs750ns 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.
35183µs400ns my $traits;
352858µs7µs ( $traits, @_ ) = _strip_traits(@_);
# spent 194µs making 8 calls to Moose::Exporter::_strip_traits, avg 24µs/call
353
35484µs462ns my $metaclass;
355852µs6µs ( $metaclass, @_ ) = _strip_metaclass(@_);
# spent 133µs making 8 calls to Moose::Exporter::_strip_metaclass, avg 17µs/call
35684µs550ns $metaclass
357 = Moose::Util::resolve_metaclass_alias( 'Class' => $metaclass )
358 if defined $metaclass && length $metaclass;
359
36083µs325ns my $meta_name;
361850µs6µs ( $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).
36686µs762ns my $class = $exporting_package;
367
368847µs6µs $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
376849µs6µs strict->import;
# spent 52µs making 8 calls to strict::import, avg 7µs/call
377845µs6µs warnings->import;
# spent 175µs making 8 calls to warnings::import, avg 22µs/call
378
37983µs412ns my $did_init_meta;
3801692µs6µ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.
38579µs1µs local $CALLER = $CALLER;
386737µs5µs $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 );
391714µs2µs $did_init_meta = 1;
392 }
393
394810µs1µs 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
409813µs2µs my ( undef, @args ) = @_;
41087µs937ns my $extra = shift @args if ref $args[0] eq 'HASH';
411
41286µs713ns $extra ||= {};
413810µs1µs if ( !$extra->{into} ) {
414812µs1µs $extra->{into_level} ||= 0;
41587µs887ns $extra->{into_level}++;
416 }
417
418876µs9µs $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
420864µs8µs 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 }
425222µs11µs };
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 {
42916140µs9µs my $idx = first_index { ( $_ || '' ) eq '-traits' } @_;
# spent 92µs making 8 calls to List::MoreUtils::firstidx, avg 11µs/call
430
431824µs3µs 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 {
4431686µs5µs my $idx = first_index { ( $_ || '' ) eq '-metaclass' } @_;
# spent 43µs making 8 calls to List::MoreUtils::firstidx, avg 5µs/call
444
445818µs2µs 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 {
4551675µs5µs my $idx = first_index { ( $_ || '' ) eq '-meta_name' } @_;
# spent 40µs making 8 calls to List::MoreUtils::firstidx, avg 5µs/call
456
457819µs2µs 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
50286µs775ns my $offset = 1;
503
504 return
505825µs3µs ( 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 {
5122900ns450ns shift;
51322µs950ns my $exporting_package = shift;
51421µs650ns my $exports = shift;
5152800ns400ns my $export_recorder = shift;
5162900ns450ns 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 );
526210µs5µs };
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 {
55921µs600ns shift;
56022µs900ns my $class = shift;
56121µs600ns my $args = shift;
562
5632700ns350ns my %old_style_roles;
564216µs8µs 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
5812500ns250ns my %base_class_roles;
58222µs800ns %base_class_roles = ( roles => $args->{base_class_roles} )
583 if exists $args->{base_class_roles};
584
585 my %new_style_roles = map { $_ => $args->{$_} }
58626µs3µs grep { exists $args->{$_} } qw( class_metaroles role_metaroles );
587
58825µs2µs 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 {
616210µs5µs strict->import;
# spent 11µs making 2 calls to strict::import, avg 6µs/call
617210µs5µs 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