Profile of String/RewritePrefix.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/String/RewritePrefix.pm
Statements | Executed 12 statements in 349µs

Subroutines
Calls | P | F | Exclusive Time | Inclusive Time | Subroutine
--- | --- | --- | --- | --- | ---
1 | 1 | 1 | 22µs | 32µs | App::Cmd::Setup::::BEGIN@1.8 App::Cmd::Setup::BEGIN@1.8
1 | 1 | 1 | 18µs | 270µs | String::RewritePrefix::::BEGIN@11String::RewritePrefix::BEGIN@11
1 | 1 | 1 | 6µs | 10µs | App::Cmd::Setup::::BEGIN@2.9 App::Cmd::Setup::BEGIN@2.9
1 | 1 | 1 | 3µs | 3µs | String::RewritePrefix::::BEGIN@7String::RewritePrefix::BEGIN@7
0 | 0 | 0 | 0s | 0s | String::RewritePrefix::::__ANON__[:57]String::RewritePrefix::__ANON__[:57]
0 | 0 | 0 | 0s | 0s | String::RewritePrefix::::_new_rewriterString::RewritePrefix::_new_rewriter
0 | 0 | 0 | 0s | 0s | String::RewritePrefix::::rewriteString::RewritePrefix::rewrite

Call graph for these subroutines as a Graphviz dot language file.

Line | State ments | Time on line | Calls | Time in subs | Code
--- | --- | --- | --- | --- | ---
1 | 2 | 20µs | 2 | 43µs | # spent 32µs (22+11) within App::Cmd::Setup::BEGIN@1.8 which was called: # once (22µs+11µs) by App::Cmd::Setup::BEGIN@77 at line 1 use strict; # spent 32µs making 1 call to App::Cmd::Setup::BEGIN@1.8 # spent 11µs making 1 call to strict::import
2 | 2 | 38µs | 2 | 13µs | # spent 10µs (6+4) within App::Cmd::Setup::BEGIN@2.9 which was called: # once (6µs+4µs) by App::Cmd::Setup::BEGIN@77 at line 2 use warnings; # spent 10µs making 1 call to App::Cmd::Setup::BEGIN@2.9 # spent 4µs making 1 call to warnings::import
3 |  |  |  |  | package String::RewritePrefix;
4 |  |  |  |  | {
5 | 2 | 800ns |  |  | $String::RewritePrefix::VERSION = '0.007';
6 |  |  |  |  | }
7 | 2 | 38µs | 1 | 3µs | # spent 3µs within String::RewritePrefix::BEGIN@7 which was called: # once (3µs+0s) by App::Cmd::Setup::BEGIN@77 at line 7 use Carp (); # spent 3µs making 1 call to String::RewritePrefix::BEGIN@7
8 |  |  |  |  | # ABSTRACT: rewrite strings based on a set of known prefixes
9 |  |  |  |  |
10 |  |  |  |  | # 0.972 allows \'method_name' form -- rjbs, 2010-10-25
11 | 1 | 5µs | 1 | 241µs | # spent 270µs (18+252) within String::RewritePrefix::BEGIN@11 which was called: # once (18µs+252µs) by App::Cmd::Setup::BEGIN@77 at line 13 use Sub::Exporter 0.972 -setup => { # spent 241µs making 1 call to Sub::Exporter::__ANON__[Sub/Exporter.pm:337]
12 |  |  |  |  | exports => [ rewrite => \'_new_rewriter' ],
13 | 2 | 246µs | 2 | 281µs | }; # spent 270µs making 1 call to String::RewritePrefix::BEGIN@11 # spent 11µs making 1 call to UNIVERSAL::VERSION
14 |  |  |  |  |
15 |  |  |  |  |
16 |  |  |  |  | sub rewrite {
17 |  |  |  |  | my ($self, $arg, @rest) = @_;
18 |  |  |  |  | return $self->_new_rewriter(rewrite => { prefixes => $arg })->(@rest);
19 |  |  |  |  | }
20 |  |  |  |  |
21 |  |  |  |  | sub _new_rewriter {
22 |  |  |  |  | my ($self, $name, $arg) = @_;
23 |  |  |  |  | my $rewrites = $arg->{prefixes} || {};
24 |  |  |  |  |
25 |  |  |  |  | my @rewrites;
26 |  |  |  |  | for my $prefix (sort { length $b <=> length $a } keys %$rewrites) {
27 |  |  |  |  | push @rewrites, ($prefix, $rewrites->{$prefix});
28 |  |  |  |  | }
29 |  |  |  |  |
30 |  |  |  |  | return sub {
31 |  |  |  |  | my @result;
32 |  |  |  |  |
33 |  |  |  |  | Carp::cluck("string rewriter invoked in void context")
34 |  |  |  |  | unless defined wantarray;
35 |  |  |  |  |
36 |  |  |  |  | Carp::croak("attempt to rewrite multiple strings outside of list context")
37 |  |  |  |  | if @_ > 1 and ! wantarray;
38 |  |  |  |  |
39 |  |  |  |  | STRING: for my $str (@_) {
40 |  |  |  |  | for (my $i = 0; $i < @rewrites; $i += 2) {
41 |  |  |  |  | if (index($str, $rewrites[$i]) == 0) {
42 |  |  |  |  | if (ref $rewrites[$i+1]) {
43 |  |  |  |  | my $rest = substr $str, length($rewrites[$i]);
44 |  |  |  |  | my $str = $rewrites[ $i+1 ]->($rest);
45 |  |  |  |  | push @result, (defined $str ? $str : '') . $rest;
46 |  |  |  |  | } else {
47 |  |  |  |  | push @result, $rewrites[$i+1] . substr $str, length($rewrites[$i]);
48 |  |  |  |  | }
49 |  |  |  |  | next STRING;
50 |  |  |  |  | }
51 |  |  |  |  | }
52 |  |  |  |  |
53 |  |  |  |  | push @result, $str;
54 |  |  |  |  | }
55 |  |  |  |  |
56 |  |  |  |  | return wantarray ? @result : $result[0];
57 |  |  |  |  | };
58 |  |  |  |  | }
59 |  |  |  |  |
60 | 1 | 2µs |  |  | 1;
61 |  |  |  |  |
62 |  |  |  |  | __END__