← 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
StatementsExecuted 12 statements in 349µs
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
11122µs32µsApp::Cmd::Setup::::BEGIN@1.8 App::Cmd::Setup::BEGIN@1.8
11118µs270µsString::RewritePrefix::::BEGIN@11String::RewritePrefix::BEGIN@11
1116µs10µsApp::Cmd::Setup::::BEGIN@2.9 App::Cmd::Setup::BEGIN@2.9
1113µs3µsString::RewritePrefix::::BEGIN@7String::RewritePrefix::BEGIN@7
0000s0sString::RewritePrefix::::__ANON__[:57]String::RewritePrefix::__ANON__[:57]
0000s0sString::RewritePrefix::::_new_rewriterString::RewritePrefix::_new_rewriter
0000s0sString::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
1220µs243µ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
2238µs213µ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
3package String::RewritePrefix;
4{
52800ns $String::RewritePrefix::VERSION = '0.007';
6}
7238µs13µ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
1115µs1241µ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' ],
132246µs2281µs};
# spent 270µs making 1 call to String::RewritePrefix::BEGIN@11 # spent 11µs making 1 call to UNIVERSAL::VERSION
14
15
16sub rewrite {
17 my ($self, $arg, @rest) = @_;
18 return $self->_new_rewriter(rewrite => { prefixes => $arg })->(@rest);
19}
20
21sub _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
6012µs1;
61
62__END__