Profile of Sub/Exporter/Util.pm

← 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
Statements | Executed 16 statements in 859µs

Subroutines
Calls | P | F | Exclusive Time | Inclusive Time | Subroutine
--- | --- | --- | --- | --- | ---
1 | 1 | 1 | 14µs | 348µs | Sub::Exporter::Util::::BEGIN@198 Sub::Exporter::Util::BEGIN@198
1 | 1 | 1 | 12µs | 24µs | Getopt::Long::Descriptive::::BEGIN@1.18Getopt::Long::Descriptive::BEGIN@1.18
1 | 1 | 1 | 7µs | 11µs | Getopt::Long::Descriptive::::BEGIN@2.19Getopt::Long::Descriptive::BEGIN@2.19
1 | 1 | 1 | 6µs | 16µs | Sub::Exporter::Util::::BEGIN@139 Sub::Exporter::Util::BEGIN@139
1 | 1 | 1 | 3µs | 3µs | Sub::Exporter::Util::::BEGIN@9 Sub::Exporter::Util::BEGIN@9
1 | 1 | 1 | 3µs | 3µs | Sub::Exporter::Util::::BEGIN@22 Sub::Exporter::Util::BEGIN@22
1 | 1 | 1 | 2µs | 2µs | Sub::Exporter::Util::::BEGIN@10 Sub::Exporter::Util::BEGIN@10
0 | 0 | 0 | 0s | 0s | Sub::Exporter::Util::::__ANON__[:123] Sub::Exporter::Util::__ANON__[:123]
0 | 0 | 0 | 0s | 0s | Sub::Exporter::Util::::__ANON__[:159] Sub::Exporter::Util::__ANON__[:159]
0 | 0 | 0 | 0s | 0s | Sub::Exporter::Util::::__ANON__[:18] Sub::Exporter::Util::__ANON__[:18]
0 | 0 | 0 | 0s | 0s | Sub::Exporter::Util::::__ANON__[:195] Sub::Exporter::Util::__ANON__[:195]
0 | 0 | 0 | 0s | 0s | Sub::Exporter::Util::::__ANON__[:19] Sub::Exporter::Util::__ANON__[:19]
0 | 0 | 0 | 0s | 0s | Sub::Exporter::Util::::__ANON__[:54] Sub::Exporter::Util::__ANON__[:54]
0 | 0 | 0 | 0s | 0s | Sub::Exporter::Util::::__ANON__[:55] Sub::Exporter::Util::__ANON__[:55]
0 | 0 | 0 | 0s | 0s | Sub::Exporter::Util::::__mixin_class_for Sub::Exporter::Util::__mixin_class_for
0 | 0 | 0 | 0s | 0s | Sub::Exporter::Util::::curry_chain Sub::Exporter::Util::curry_chain
0 | 0 | 0 | 0s | 0s | Sub::Exporter::Util::::curry_method Sub::Exporter::Util::curry_method
0 | 0 | 0 | 0s | 0s | Sub::Exporter::Util::::like Sub::Exporter::Util::like
0 | 0 | 0 | 0s | 0s | Sub::Exporter::Util::::merge_col Sub::Exporter::Util::merge_col
0 | 0 | 0 | 0s | 0s | Sub::Exporter::Util::::mixin_exporter Sub::Exporter::Util::mixin_exporter
0 | 0 | 0 | 0s | 0s | Sub::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
--- | --- | --- | --- | --- | ---
1 | 2 | 21µs | 2 | 36µ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
2 | 2 | 38µs | 2 | 14µ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
3 |  |  |  |  | package Sub::Exporter::Util;
4 |  |  |  |  | {
5 | 2 | 900ns |  |  | $Sub::Exporter::Util::VERSION = '0.987';
6 |  |  |  |  | }
7 |  |  |  |  | # ABSTRACT: utilities to make Sub::Exporter easier
8 |  |  |  |  |
9 | 2 | 18µs | 1 | 3µ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
10 | 2 | 83µs | 1 | 2µ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 |  |  |  |  |
13 |  |  |  |  | sub 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 |  |  |  |  |
22 | 1 | 351µs | 1 | 3µ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 |  |  |  |  |
25 |  |  |  |  | sub 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 |  |  |  |  |
104 |  |  |  |  | sub 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 |  |  |  |  |
131 |  |  |  |  | sub __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)
139 | 2 | 316µs | 2 | 26µ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 |  |  |  |  |
148 |  |  |  |  | sub 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 |  |  |  |  |
162 |  |  |  |  | sub mixin_exporter {
163 |  |  |  |  | Carp::cluck "mixin_exporter is deprecated; use mixin_installer instead; it behaves identically";
164 |  |  |  |  | return mixin_installer;
165 |  |  |  |  | }
166 |  |  |  |  |
167 |  |  |  |  |
168 |  |  |  |  | sub 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 |  |  |  |  |
198 | 1 | 8µs | 1 | 334µ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 |  |  |  |  | ) ]
207 | 1 | 21µs | 1 | 348µs | }; # spent 348µs making 1 call to Sub::Exporter::Util::BEGIN@198
208 |  |  |  |  |
209 | 1 | 2µs |  |  | 1;
210 |  |  |  |  |
211 |  |  |  |  | __END__