← Index
NYTProf Performance Profile   « line view »
For /home/ss5/perl5/perlbrew/perls/perl-5.22.0/bin/benchmarkanything-storage
  Run on Mon Jan 29 16:55:34 2018
Reported on Mon Jan 29 16:57:07 2018

Filename/home/ss5/perl5/perlbrew/perls/perl-5.22.0/lib/site_perl/5.22.0/String/RewritePrefix.pm
StatementsExecuted 12 statements in 292µs
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
11112µs282µsString::RewritePrefix::::BEGIN@11String::RewritePrefix::BEGIN@11
1119µs11µsCHI::::BEGIN@1 CHI::BEGIN@1
1114µs18µsCHI::::BEGIN@2 CHI::BEGIN@2
1112µs2µ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
1215µs213µs
# spent 11µs (9+2) within CHI::BEGIN@1 which was called: # once (9µs+2µs) by CHI::BEGIN@6 at line 1
use strict;
# spent 11µs making 1 call to CHI::BEGIN@1 # spent 2µs making 1 call to strict::import
2240µs231µs
# spent 18µs (4+14) within CHI::BEGIN@2 which was called: # once (4µs+14µs) by CHI::BEGIN@6 at line 2
use warnings;
# spent 18µs making 1 call to CHI::BEGIN@2 # spent 14µs making 1 call to warnings::import
3package String::RewritePrefix;
4{
52600ns $String::RewritePrefix::VERSION = '0.007';
6}
7226µs12µs
# spent 2µs within String::RewritePrefix::BEGIN@7 which was called: # once (2µs+0s) by CHI::BEGIN@6 at line 7
use Carp ();
# spent 2µ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
1116µs1261µs
# spent 282µs (12+270) within String::RewritePrefix::BEGIN@11 which was called: # once (12µs+270µs) by CHI::BEGIN@6 at line 13
use Sub::Exporter 0.972 -setup => {
# spent 261µs making 1 call to Sub::Exporter::__ANON__[Sub/Exporter.pm:337]
12 exports => [ rewrite => \'_new_rewriter' ],
132201µs2291µs};
# spent 282µs making 1 call to String::RewritePrefix::BEGIN@11 # spent 9µ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__