← Index
NYTProf Performance Profile   « line view »
For script/ponapi
  Run on Wed Feb 10 15:51:26 2016
Reported on Thu Feb 11 09:43:09 2016

Filename/usr/local/share/perl/5.18.2/Sub/Exporter/Util.pm
StatementsExecuted 16 statements in 859µs
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
11114µs348µsSub::Exporter::Util::::BEGIN@198 Sub::Exporter::Util::BEGIN@198
11112µs24µsGetopt::Long::Descriptive::::BEGIN@1.18Getopt::Long::Descriptive::BEGIN@1.18
1117µs11µsGetopt::Long::Descriptive::::BEGIN@2.19Getopt::Long::Descriptive::BEGIN@2.19
1116µs16µsSub::Exporter::Util::::BEGIN@139 Sub::Exporter::Util::BEGIN@139
1113µs3µsSub::Exporter::Util::::BEGIN@9 Sub::Exporter::Util::BEGIN@9
1113µs3µsSub::Exporter::Util::::BEGIN@22 Sub::Exporter::Util::BEGIN@22
1112µs2µsSub::Exporter::Util::::BEGIN@10 Sub::Exporter::Util::BEGIN@10
0000s0sSub::Exporter::Util::::__ANON__[:123] Sub::Exporter::Util::__ANON__[:123]
0000s0sSub::Exporter::Util::::__ANON__[:159] Sub::Exporter::Util::__ANON__[:159]
0000s0sSub::Exporter::Util::::__ANON__[:18] Sub::Exporter::Util::__ANON__[:18]
0000s0sSub::Exporter::Util::::__ANON__[:195] Sub::Exporter::Util::__ANON__[:195]
0000s0sSub::Exporter::Util::::__ANON__[:19] Sub::Exporter::Util::__ANON__[:19]
0000s0sSub::Exporter::Util::::__ANON__[:54] Sub::Exporter::Util::__ANON__[:54]
0000s0sSub::Exporter::Util::::__ANON__[:55] Sub::Exporter::Util::__ANON__[:55]
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
1221µs236µs
# spent 24µs (12+12) within Getopt::Long::Descriptive::BEGIN@1.18 which was called: # once (12µs+12µs) by Getopt::Long::Descriptive::BEGIN@267 at line 1
use strict;
# spent 24µs making 1 call to Getopt::Long::Descriptive::BEGIN@1.18 # spent 12µs making 1 call to strict::import
2238µs214µs
# spent 11µs (7+4) within Getopt::Long::Descriptive::BEGIN@2.19 which was called: # once (7µs+4µs) by Getopt::Long::Descriptive::BEGIN@267 at line 2
use warnings;
# spent 11µs making 1 call to Getopt::Long::Descriptive::BEGIN@2.19 # spent 4µs making 1 call to warnings::import
3package Sub::Exporter::Util;
4{
52900ns $Sub::Exporter::Util::VERSION = '0.987';
6}
7# ABSTRACT: utilities to make Sub::Exporter easier
8
9218µs13µs
# spent 3µs within Sub::Exporter::Util::BEGIN@9 which was called: # once (3µs+0s) by Getopt::Long::Descriptive::BEGIN@267 at line 9
use Data::OptList ();
# spent 3µs making 1 call to Sub::Exporter::Util::BEGIN@9
10283µs12µs
# spent 2µs within Sub::Exporter::Util::BEGIN@10 which was called: # once (2µs+0s) by Getopt::Long::Descriptive::BEGIN@267 at line 10
use Params::Util ();
# spent 2µs making 1 call to Sub::Exporter::Util::BEGIN@10
11
12
13sub curry_method {
14 my $override_name = shift;
15 sub {
16 my ($class, $name) = @_;
17 $name = $override_name if defined $override_name;
18 sub { $class->$name(@_); };
19 }
20}
21
221351µs13µs
# spent 3µs within Sub::Exporter::Util::BEGIN@22 which was called: # once (3µs+0s) by Getopt::Long::Descriptive::BEGIN@267 at line 22
BEGIN { *curry_class = \&curry_method; }
# spent 3µs making 1 call to Sub::Exporter::Util::BEGIN@22
23
24
25sub curry_chain {
26 # In the future, we can make \%arg an optional prepend, like the "special"
27 # args to the default Sub::Exporter-generated import routine.
28 my (@opt_list) = @_;
29
30 my $pairs = Data::OptList::mkopt(\@opt_list, 'args', 'ARRAY');
31
32 sub {
33 my ($class) = @_;
34
35 sub {
36 my $next = $class;
37
38 for my $i (0 .. $#$pairs) {
39 my $pair = $pairs->[ $i ];
40
41 unless (Params::Util::_INVOCANT($next)) { ## no critic Private
42 my $str = defined $next ? "'$next'" : 'undef';
43 Carp::croak("can't call $pair->[0] on non-invocant $str")
44 }
45
46 my ($method, $args) = @$pair;
47
48 if ($i == $#$pairs) {
49 return $next->$method($args ? @$args : ());
50 } else {
51 $next = $next->$method($args ? @$args : ());
52 }
53 }
54 };
55 }
56}
57
58# =head2 name_map
59#
60# This utility returns an list to be used in specify export generators. For
61# example, the following:
62#
63# exports => {
64# name_map(
65# '_?_gen' => [ qw(fee fie) ],
66# '_make_?' => [ qw(foo bar) ],
67# ),
68# }
69#
70# is equivalent to:
71#
72# exports => {
73# name_map(
74# fee => \'_fee_gen',
75# fie => \'_fie_gen',
76# foo => \'_make_foo',
77# bar => \'_make_bar',
78# ),
79# }
80#
81# This can save a lot of typing, when providing many exports with similarly-named
82# generators.
83#
84# =cut
85#
86# sub name_map {
87# my (%groups) = @_;
88#
89# my %map;
90#
91# while (my ($template, $names) = each %groups) {
92# for my $name (@$names) {
93# (my $export = $template) =~ s/\?/$name/
94# or Carp::croak 'no ? found in name_map template';
95#
96# $map{ $name } = \$export;
97# }
98# }
99#
100# return %map;
101# }
102
103
104sub merge_col {
105 my (%groups) = @_;
106
107 my %merged;
108
109 while (my ($default_name, $group) = each %groups) {
110 while (my ($export_name, $gen) = each %$group) {
111 $merged{$export_name} = sub {
112 my ($class, $name, $arg, $col) = @_;
113
114 my $merged_arg = exists $col->{$default_name}
115 ? { %{ $col->{$default_name} }, %$arg }
116 : $arg;
117
118 if (Params::Util::_CODELIKE($gen)) { ## no critic Private
119 $gen->($class, $name, $merged_arg, $col);
120 } else {
121 $class->$$gen($name, $merged_arg, $col);
122 }
123 }
124 }
125 }
126
127 return %merged;
128}
129
130
131sub __mixin_class_for {
132 my ($class, $mix_into) = @_;
133 require Package::Generator;
134 my $mixin_class = Package::Generator->new_package({
135 base => "$class\:\:__mixin__",
136 });
137
138 ## no critic (ProhibitNoStrict)
1392316µs226µs
# spent 16µs (6+10) within Sub::Exporter::Util::BEGIN@139 which was called: # once (6µs+10µs) by Getopt::Long::Descriptive::BEGIN@267 at line 139
no strict 'refs';
# spent 16µs making 1 call to Sub::Exporter::Util::BEGIN@139 # spent 10µs making 1 call to strict::unimport
140 if (ref $mix_into) {
141 unshift @{"$mixin_class" . "::ISA"}, ref $mix_into;
142 } else {
143 unshift @{"$mix_into" . "::ISA"}, $mixin_class;
144 }
145 return $mixin_class;
146}
147
148sub mixin_installer {
149 sub {
150 my ($arg, $to_export) = @_;
151
152 my $mixin_class = __mixin_class_for($arg->{class}, $arg->{into});
153 bless $arg->{into} => $mixin_class if ref $arg->{into};
154
155 Sub::Exporter::default_installer(
156 { %$arg, into => $mixin_class },
157 $to_export,
158 );
159 };
160}
161
162sub mixin_exporter {
163 Carp::cluck "mixin_exporter is deprecated; use mixin_installer instead; it behaves identically";
164 return mixin_installer;
165}
166
167
168sub like {
169 sub {
170 my ($value, $arg) = @_;
171 Carp::croak "no regex supplied to regex group generator" unless $value;
172
173 # Oh, qr//, how you bother me! See the p5p thread from around now about
174 # fixing this problem... too bad it won't help me. -- rjbs, 2006-04-25
175 my @values = eval { $value->isa('Regexp') } ? ($value, undef)
176 : @$value;
177
178 while (my ($re, $opt) = splice @values, 0, 2) {
179 Carp::croak "given pattern for regex group generater is not a Regexp"
180 unless eval { $re->isa('Regexp') };
181 my @exports = keys %{ $arg->{config}->{exports} };
182 my @matching = grep { $_ =~ $re } @exports;
183
184 my %merge = $opt ? %$opt : ();
185 my $prefix = (delete $merge{-prefix}) || '';
186 my $suffix = (delete $merge{-suffix}) || '';
187
188 for my $name (@matching) {
189 my $as = $prefix . $name . $suffix;
190 push @{ $arg->{import_args} }, [ $name => { %merge, -as => $as } ];
191 }
192 }
193
194 1;
195 }
196}
197
19818µs1334µs
# spent 348µs (14+334) within Sub::Exporter::Util::BEGIN@198 which was called: # once (14µs+334µs) by Getopt::Long::Descriptive::BEGIN@267 at line 207
use Sub::Exporter -setup => {
# spent 334µs making 1 call to Sub::Exporter::__ANON__[Sub/Exporter.pm:337]
199 exports => [ qw(
200 like
201 name_map
202 merge_col
203 curry_method curry_class
204 curry_chain
205 mixin_installer mixin_exporter
206 ) ]
207121µs1348µs};
# spent 348µs making 1 call to Sub::Exporter::Util::BEGIN@198
208
20912µs1;
210
211__END__