← Index
NYTProf Performance Profile   « block view • line view • sub view »
For bin/hailo
  Run on Thu Oct 21 22:50:37 2010
Reported on Thu Oct 21 22:52:05 2010

Filename/home/hinrik/perl5/perlbrew/perls/perl-5.13.5/lib/site_perl/5.13.5/Sub/Exporter/Util.pm
StatementsExecuted 15 statements in 1.21ms
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
1112.31ms3.48msSub::Exporter::Util::::BEGIN@332 Sub::Exporter::Util::BEGIN@332
111626µs9.47msSub::Exporter::Util::::BEGIN@6 Sub::Exporter::Util::BEGIN@6
11128µs33µsGetopt::Long::Descriptive::::BEGIN@1.5Getopt::Long::Descriptive::BEGIN@1.5
11117µs27µsGetopt::Long::Descriptive::::BEGIN@2.6Getopt::Long::Descriptive::BEGIN@2.6
11111µs34µsSub::Exporter::Util::::BEGIN@252 Sub::Exporter::Util::BEGIN@252
1117µs7µsSub::Exporter::Util::::BEGIN@73 Sub::Exporter::Util::BEGIN@73
1116µs6µsSub::Exporter::Util::::BEGIN@7 Sub::Exporter::Util::BEGIN@7
0000s0sSub::Exporter::Util::::__ANON__[:135] Sub::Exporter::Util::__ANON__[:135]
0000s0sSub::Exporter::Util::::__ANON__[:136] Sub::Exporter::Util::__ANON__[:136]
0000s0sSub::Exporter::Util::::__ANON__[:220] Sub::Exporter::Util::__ANON__[:220]
0000s0sSub::Exporter::Util::::__ANON__[:272] Sub::Exporter::Util::__ANON__[:272]
0000s0sSub::Exporter::Util::::__ANON__[:329] Sub::Exporter::Util::__ANON__[:329]
0000s0sSub::Exporter::Util::::__ANON__[:69] Sub::Exporter::Util::__ANON__[:69]
0000s0sSub::Exporter::Util::::__ANON__[:70] Sub::Exporter::Util::__ANON__[:70]
0000s0sSub::Exporter::Util::::__mixin_class_for Sub::Exporter::Util::__mixin_class_for
0000s0sSub::Exporter::Util::::curry_chain Sub::Exporter::Util::curry_chain
0000s0sSub::Exporter::Util::::curry_method Sub::Exporter::Util::curry_method
0000s0sSub::Exporter::Util::::like Sub::Exporter::Util::like
0000s0sSub::Exporter::Util::::merge_col Sub::Exporter::Util::merge_col
0000s0sSub::Exporter::Util::::mixin_exporter Sub::Exporter::Util::mixin_exporter
0000s0sSub::Exporter::Util::::mixin_installer Sub::Exporter::Util::mixin_installer
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments
Time
on line
Calls Time
in subs
Code
1230µs238µs
# spent 33µs (28+5) within Getopt::Long::Descriptive::BEGIN@1.5 which was called: # once (28µs+5µs) by Getopt::Long::Descriptive::BEGIN@259 at line 1
use strict;
# spent 33µs making 1 call to Getopt::Long::Descriptive::BEGIN@1.5 # spent 5µs making 1 call to strict::import
2237µs236µs
# spent 27µs (17+9) within Getopt::Long::Descriptive::BEGIN@2.6 which was called: # once (17µs+9µs) by Getopt::Long::Descriptive::BEGIN@259 at line 2
use warnings;
# spent 27µs making 1 call to Getopt::Long::Descriptive::BEGIN@2.6 # spent 9µs making 1 call to warnings::import
3
4package Sub::Exporter::Util;
5
62131µs19.47ms
# spent 9.47ms (626µs+8.84) within Sub::Exporter::Util::BEGIN@6 which was called: # once (626µs+8.84ms) by Getopt::Long::Descriptive::BEGIN@259 at line 6
use Data::OptList ();
# spent 9.47ms making 1 call to Sub::Exporter::Util::BEGIN@6
72135µs16µs
# spent 6µs within Sub::Exporter::Util::BEGIN@7 which was called: # once (6µs+0s) by Getopt::Long::Descriptive::BEGIN@259 at line 7
use Params::Util ();
# spent 6µs making 1 call to Sub::Exporter::Util::BEGIN@7
8
9=head1 NAME
10
11Sub::Exporter::Util - utilities to make Sub::Exporter easier
12
13=head1 VERSION
14
15version 0.982
16
17=cut
18
1912µsour $VERSION = '0.982';
20
21=head1 DESCRIPTION
22
23This module provides a number of utility functions for performing common or
24useful operations when setting up a Sub::Exporter configuration. All of the
25utilites may be exported, but none are by default.
26
27=head1 THE UTILITIES
28
29=head2 curry_method
30
31 exports => {
32 some_method => curry_method,
33 }
34
35This utility returns a generator which will produce an invocant-curried version
36of a method. In other words, it will export a method call with the exporting
37class built in as the invocant.
38
39A module importing the code some the above example might do this:
40
41 use Some::Module qw(some_method);
42
43 my $x = some_method;
44
45This would be equivalent to:
46
47 use Some::Module;
48
49 my $x = Some::Module->some_method;
50
51If Some::Module is subclassed and the subclass's import method is called to
52import C<some_method>, the subclass will be curried in as the invocant.
53
54If an argument is provided for C<curry_method> it is used as the name of the
55curried method to export. This means you could export a Widget constructor
56like this:
57
58 exports => { widget => curry_method('new') }
59
60This utility may also be called as C<curry_class>, for backwards compatibility.
61
62=cut
63
64sub curry_method {
65 my $override_name = shift;
66 sub {
67 my ($class, $name) = @_;
68 $name = $override_name if defined $override_name;
69 sub { $class->$name(@_); };
70 }
71}
72
731373µs17µs
# spent 7µs within Sub::Exporter::Util::BEGIN@73 which was called: # once (7µs+0s) by Getopt::Long::Descriptive::BEGIN@259 at line 73
BEGIN { *curry_class = \&curry_method; }
# spent 7µs making 1 call to Sub::Exporter::Util::BEGIN@73
74
75=head2 curry_chain
76
77C<curry_chain> behaves like C<L</curry_method>>, but is meant for generating
78exports that will call several methods in succession.
79
80 exports => {
81 reticulate => curry_chain([
82 new => gather_data => analyze => [ detail => 100 ] => results
83 ]),
84 }
85
86If imported from Spliner, calling the C<reticulate> routine will be equivalent
87to:
88
89 Splinter->new->gather_data->analyze(detail => 100)->results;
90
91If any method returns something on which methods may not be called, the routine
92croaks.
93
94The arguments to C<curry_chain> form an optlist. The names are methods to be
95called and the arguments, if given, are arrayrefs to be dereferenced and passed
96as arguments to those methods. C<curry_chain> returns a generator like those
97expected by Sub::Exporter.
98
99B<Achtung!> at present, there is no way to pass arguments from the generated
100routine to the method calls. This will probably be solved in future revisions
101by allowing the opt list's values to be subroutines that will be called with
102the generated routine's stack.
103
104=cut
105
106sub curry_chain {
107 # In the future, we can make \%arg an optional prepend, like the "special"
108 # args to the default Sub::Exporter-generated import routine.
109 my (@opt_list) = @_;
110
111 my $pairs = Data::OptList::mkopt(\@opt_list, 'args', 'ARRAY');
112
113 sub {
114 my ($class) = @_;
115
116 sub {
117 my $next = $class;
118
119 for my $i (0 .. $#$pairs) {
120 my $pair = $pairs->[ $i ];
121
122 unless (Params::Util::_INVOCANT($next)) { ## no critic Private
123 my $str = defined $next ? "'$next'" : 'undef';
124 Carp::croak("can't call $pair->[0] on non-invocant $str")
125 }
126
127 my ($method, $args) = @$pair;
128
129 if ($i == $#$pairs) {
130 return $next->$method($args ? @$args : ());
131 } else {
132 $next = $next->$method($args ? @$args : ());
133 }
134 }
135 };
136 }
137}
138
139# =head2 name_map
140#
141# This utility returns an list to be used in specify export generators. For
142# example, the following:
143#
144# exports => {
145# name_map(
146# '_?_gen' => [ qw(fee fie) ],
147# '_make_?' => [ qw(foo bar) ],
148# ),
149# }
150#
151# is equivalent to:
152#
153# exports => {
154# name_map(
155# fee => \'_fee_gen',
156# fie => \'_fie_gen',
157# foo => \'_make_foo',
158# bar => \'_make_bar',
159# ),
160# }
161#
162# This can save a lot of typing, when providing many exports with similarly-named
163# generators.
164#
165# =cut
166#
167# sub name_map {
168# my (%groups) = @_;
169#
170# my %map;
171#
172# while (my ($template, $names) = each %groups) {
173# for my $name (@$names) {
174# (my $export = $template) =~ s/\?/$name/
175# or Carp::croak 'no ? found in name_map template';
176#
177# $map{ $name } = \$export;
178# }
179# }
180#
181# return %map;
182# }
183
184=head2 merge_col
185
186 exports => {
187 merge_col(defaults => {
188 twiddle => \'_twiddle_gen',
189 tweak => \&_tweak_gen,
190 }),
191 }
192
193This utility wraps the given generator in one that will merge the named
194collection into its args before calling it. This means that you can support a
195"default" collector in multipe exports without writing the code each time.
196
197You can specify as many pairs of collection names and generators as you like.
198
199=cut
200
201sub merge_col {
202 my (%groups) = @_;
203
204 my %merged;
205
206 while (my ($default_name, $group) = each %groups) {
207 while (my ($export_name, $gen) = each %$group) {
208 $merged{$export_name} = sub {
209 my ($class, $name, $arg, $col) = @_;
210
211 my $merged_arg = exists $col->{$default_name}
212 ? { %{ $col->{$default_name} }, %$arg }
213 : $arg;
214
215 if (Params::Util::_CODELIKE($gen)) { ## no critic Private
216 $gen->($class, $name, $merged_arg, $col);
217 } else {
218 $class->$$gen($name, $merged_arg, $col);
219 }
220 }
221 }
222 }
223
224 return %merged;
225}
226
227=head2 mixin_installer
228
229 use Sub::Exporter -setup => {
230 installer => Sub::Exporter::Util::mixin_installer,
231 exports => [ qw(foo bar baz) ],
232 };
233
234This utility returns an installer that will install into a superclass and
235adjust the ISA importing class to include the newly generated superclass.
236
237If the target of importing is an object, the hierarchy is reversed: the new
238class will be ISA the object's class, and the object will be reblessed.
239
240B<Prerequisites>: This utility requires that Package::Generator be installed.
241
242=cut
243
244sub __mixin_class_for {
245 my ($class, $mix_into) = @_;
246 require Package::Generator;
247 my $mixin_class = Package::Generator->new_package({
248 base => "$class\:\:__mixin__",
249 });
250
251 ## no critic (ProhibitNoStrict)
2522349µs258µs
# spent 34µs (11+24) within Sub::Exporter::Util::BEGIN@252 which was called: # once (11µs+24µs) by Getopt::Long::Descriptive::BEGIN@259 at line 252
no strict 'refs';
# spent 34µs making 1 call to Sub::Exporter::Util::BEGIN@252 # spent 24µs making 1 call to strict::unimport
253 if (ref $mix_into) {
254 unshift @{"$mixin_class" . "::ISA"}, ref $mix_into;
255 } else {
256 unshift @{"$mix_into" . "::ISA"}, $mixin_class;
257 }
258 return $mixin_class;
259}
260
261sub mixin_installer {
262 sub {
263 my ($arg, $to_export) = @_;
264
265 my $mixin_class = __mixin_class_for($arg->{class}, $arg->{into});
266 bless $arg->{into} => $mixin_class if ref $arg->{into};
267
268 Sub::Exporter::default_installer(
269 { %$arg, into => $mixin_class },
270 $to_export,
271 );
272 };
273}
274
275sub mixin_exporter {
276 Carp::cluck "mixin_exporter is deprecated; use mixin_installer instead; it behaves identically";
277 return mixin_installer;
278}
279
280=head2 like
281
282It's a collector that adds imports for anything like given regex.
283
284If you provide this configuration:
285
286 exports => [ qw(igrep imap islurp exhausted) ],
287 collectors => { -like => Sub::Exporter::Util::like },
288
289A user may import from your module like this:
290
291 use Your::Iterator -like => qr/^i/; # imports igre, imap, islurp
292
293or
294
295 use Your::Iterator -like => [ qr/^i/ => { -prefix => 'your_' } ];
296
297The group-like prefix and suffix arguments are respected; other arguments are
298passed on to the generators for matching exports.
299
300=cut
301
302sub like {
303 sub {
304 my ($value, $arg) = @_;
305 Carp::croak "no regex supplied to regex group generator" unless $value;
306
307 # Oh, qr//, how you bother me! See the p5p thread from around now about
308 # fixing this problem... too bad it won't help me. -- rjbs, 2006-04-25
309 my @values = eval { $value->isa('Regexp') } ? ($value, undef)
310 : @$value;
311
312 while (my ($re, $opt) = splice @values, 0, 2) {
313 Carp::croak "given pattern for regex group generater is not a Regexp"
314 unless eval { $re->isa('Regexp') };
315 my @exports = keys %{ $arg->{config}->{exports} };
316 my @matching = grep { $_ =~ $re } @exports;
317
318 my %merge = $opt ? %$opt : ();
319 my $prefix = (delete $merge{-prefix}) || '';
320 my $suffix = (delete $merge{-suffix}) || '';
321
322 for my $name (@matching) {
323 my $as = $prefix . $name . $suffix;
324 push @{ $arg->{import_args} }, [ $name => { %merge, -as => $as } ];
325 }
326 }
327
328 1;
329 }
330}
331
3321556µs
# spent 3.48ms (2.31+1.18) within Sub::Exporter::Util::BEGIN@332 which was called: # once (2.31ms+1.18ms) by Getopt::Long::Descriptive::BEGIN@259 at line 341
use Sub::Exporter -setup => {
# spent 556µs making 1 call to Sub::Exporter::__ANON__[Sub/Exporter.pm:756]
333 exports => [ qw(
334 like
335 name_map
336 merge_col
337 curry_method curry_class
338 curry_chain
339 mixin_installer mixin_exporter
340 ) ]
3412148µs13.48ms};
# spent 3.48ms making 1 call to Sub::Exporter::Util::BEGIN@332
342
343=head1 AUTHOR
344
345Ricardo SIGNES, C<< <rjbs@cpan.org> >>
346
347=head1 BUGS
348
349Please report any bugs or feature requests through the web interface at
350L<http://rt.cpan.org>. I will be notified, and then you'll automatically be
351notified of progress on your bug as I make changes.
352
353=head1 COPYRIGHT
354
355Copyright 2006-2007, Ricardo SIGNES. This program is free software; you can
356redistribute it and/or modify it under the same terms as Perl itself.
357
358=cut
359
36013µs1;