Filename | /home/ss5/perl5/perlbrew/perls/perl-5.22.0/lib/site_perl/5.22.0/Regexp/Common.pm |
Statements | Executed 136 statements in 1.19ms |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
2 | 2 | 2 | 298µs | 403µs | import (recurses: max depth 1, inclusive time 21µs) | Regexp::Common::
2 | 2 | 1 | 43µs | 66µs | pattern | Regexp::Common::
2 | 1 | 1 | 22µs | 31µs | FETCH | Regexp::Common::
7 | 1 | 1 | 14µs | 14µs | CORE:regcomp (opcode) | Regexp::Common::
1 | 1 | 1 | 9µs | 9µs | BEGIN@3 | Regexp::Common::
1 | 1 | 1 | 7µs | 19µs | BEGIN@257 | Regexp::Common::Entry::
2 | 1 | 1 | 7µs | 9µs | new | Regexp::Common::
1 | 1 | 1 | 6µs | 24µs | BEGIN@163 | Regexp::Common::
1 | 1 | 1 | 6µs | 12µs | BEGIN@117 | Regexp::Common::
15 | 3 | 1 | 5µs | 5µs | CORE:match (opcode) | Regexp::Common::
4 | 2 | 1 | 5µs | 5µs | TIEHASH | Regexp::Common::
1 | 1 | 1 | 4µs | 11µs | BEGIN@60 | Regexp::Common::
1 | 1 | 1 | 4µs | 9µs | BEGIN@69 | Regexp::Common::
1 | 1 | 1 | 4µs | 34µs | BEGIN@19 | Regexp::Common::
2 | 1 | 1 | 4µs | 4µs | get_cache | Regexp::Common::
1 | 1 | 1 | 4µs | 7µs | BEGIN@18 | Regexp::Common::
1 | 1 | 1 | 4µs | 8µs | BEGIN@128 | Regexp::Common::
1 | 1 | 1 | 4µs | 5µs | BEGIN@4 | Regexp::Common::
1 | 1 | 1 | 3µs | 10µs | BEGIN@13 | Regexp::Common::
1 | 1 | 1 | 3µs | 3µs | BEGIN@6 | Regexp::Common::
1 | 1 | 1 | 1µs | 1µs | CORE:qr (opcode) | Regexp::Common::
2 | 1 | 1 | 800ns | 800ns | CORE:subst (opcode) | Regexp::Common::
0 | 0 | 0 | 0s | 0s | AUTOLOAD | Regexp::Common::
0 | 0 | 0 | 0s | 0s | DESTROY | Regexp::Common::
0 | 0 | 0 | 0s | 0s | __ANON__[:268] | Regexp::Common::Entry::
0 | 0 | 0 | 0s | 0s | _clone_with | Regexp::Common::Entry::
0 | 0 | 0 | 0s | 0s | __ANON__[:14] | Regexp::Common::
0 | 0 | 0 | 0s | 0s | __ANON__[:188] | Regexp::Common::
0 | 0 | 0 | 0s | 0s | __ANON__[:231] | Regexp::Common::
0 | 0 | 0 | 0s | 0s | _carp | Regexp::Common::
0 | 0 | 0 | 0s | 0s | _croak | Regexp::Common::
0 | 0 | 0 | 0s | 0s | _decache | Regexp::Common::
0 | 0 | 0 | 0s | 0s | croak_version | Regexp::Common::
0 | 0 | 0 | 0s | 0s | generic_match | Regexp::Common::
0 | 0 | 0 | 0s | 0s | generic_subs | Regexp::Common::
0 | 0 | 0 | 0s | 0s | matches | Regexp::Common::
0 | 0 | 0 | 0s | 0s | subs | Regexp::Common::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | package Regexp::Common; | ||||
2 | |||||
3 | 2 | 23µs | 1 | 9µs | # spent 9µs within Regexp::Common::BEGIN@3 which was called:
# once (9µs+0s) by SQL::SplitStatement::BEGIN@16 at line 3 # spent 9µs making 1 call to Regexp::Common::BEGIN@3 |
4 | 2 | 27µs | 2 | 7µs | # spent 5µs (4+2) within Regexp::Common::BEGIN@4 which was called:
# once (4µs+2µs) by SQL::SplitStatement::BEGIN@16 at line 4 # spent 5µs making 1 call to Regexp::Common::BEGIN@4
# spent 2µs making 1 call to strict::import |
5 | |||||
6 | # spent 3µs within Regexp::Common::BEGIN@6 which was called:
# once (3µs+0s) by SQL::SplitStatement::BEGIN@16 at line 16 | ||||
7 | # This makes sure 'use warnings' doesn't bomb out on 5.005_*; | ||||
8 | # warnings won't be enabled on those old versions though. | ||||
9 | # Since all other files use this file, we can use 'use warnings' | ||||
10 | # elsewhere as well, but *AFTER* 'use Regexp::Common'. | ||||
11 | 1 | 4µs | if ($] < 5.006) { | ||
12 | $INC {"warnings.pm"} = 1; | ||||
13 | 2 | 26µs | 2 | 16µs | # spent 10µs (3+6) within Regexp::Common::BEGIN@13 which was called:
# once (3µs+6µs) by SQL::SplitStatement::BEGIN@16 at line 13 # spent 10µs making 1 call to Regexp::Common::BEGIN@13
# spent 6µs making 1 call to strict::unimport |
14 | *{"warnings::unimport"} = sub {0}; | ||||
15 | } | ||||
16 | 1 | 12µs | 1 | 3µs | } # spent 3µs making 1 call to Regexp::Common::BEGIN@6 |
17 | |||||
18 | 2 | 14µs | 2 | 10µs | # spent 7µs (4+3) within Regexp::Common::BEGIN@18 which was called:
# once (4µs+3µs) by SQL::SplitStatement::BEGIN@16 at line 18 # spent 7µs making 1 call to Regexp::Common::BEGIN@18
# spent 3µs making 1 call to warnings::import |
19 | 2 | 113µs | 2 | 64µs | # spent 34µs (4+30) within Regexp::Common::BEGIN@19 which was called:
# once (4µs+30µs) by SQL::SplitStatement::BEGIN@16 at line 19 # spent 34µs making 1 call to Regexp::Common::BEGIN@19
# spent 30µs making 1 call to vars::import |
20 | |||||
21 | 1 | 300ns | $VERSION = '2013031301'; | ||
22 | |||||
23 | |||||
24 | sub _croak { | ||||
25 | require Carp; | ||||
26 | goto &Carp::croak; | ||||
27 | } | ||||
28 | |||||
29 | sub _carp { | ||||
30 | require Carp; | ||||
31 | goto &Carp::carp; | ||||
32 | } | ||||
33 | |||||
34 | # spent 9µs (7+2) within Regexp::Common::new which was called 2 times, avg 5µs/call:
# 2 times (7µs+2µs) by Regexp::Common::FETCH at line 48, avg 5µs/call | ||||
35 | 2 | 900ns | my ($class, @data) = @_; | ||
36 | 2 | 200ns | my %self; | ||
37 | 2 | 2µs | 2 | 2µs | tie %self, $class, @data; # spent 2µs making 2 calls to Regexp::Common::TIEHASH, avg 1µs/call |
38 | 2 | 3µs | return \%self; | ||
39 | } | ||||
40 | |||||
41 | sub TIEHASH { | ||||
42 | 4 | 2µs | my ($class, @data) = @_; | ||
43 | 4 | 9µs | bless \@data, $class; | ||
44 | } | ||||
45 | |||||
46 | # spent 31µs (22+9) within Regexp::Common::FETCH which was called 2 times, avg 16µs/call:
# 2 times (22µs+9µs) by DBIx::MultiStatementDo::BEGIN@11 at line 52 of SQL/SplitStatement.pm, avg 16µs/call | ||||
47 | 2 | 600ns | my ($self, $extra) = @_; | ||
48 | 2 | 21µs | 2 | 9µs | return bless ref($self)->new(@$self, $extra), ref($self); # spent 9µs making 2 calls to Regexp::Common::new, avg 5µs/call |
49 | } | ||||
50 | |||||
51 | 1 | 8µs | my %imports = map {$_ => "Regexp::Common::$_"} | ||
52 | qw /balanced CC comment delimited lingua list | ||||
53 | net number profanity SEN URI whitespace | ||||
54 | zip/; | ||||
55 | |||||
56 | # spent 403µs (298+105) within Regexp::Common::import which was called 2 times, avg 201µs/call:
# once (278µs+124µs) by SQL::SplitStatement::BEGIN@16 at line 16 of SQL/SplitStatement.pm
# once (20µs+-20µs) by Regexp::Common::delimited::BEGIN@3 at line 3 of Regexp/Common/delimited.pm | ||||
57 | 2 | 200ns | shift; # Shift off the class. | ||
58 | 2 | 4µs | 2 | 3µs | tie %RE, __PACKAGE__; # spent 3µs making 2 calls to Regexp::Common::TIEHASH, avg 1µs/call |
59 | { | ||||
60 | 4 | 43µs | 2 | 17µs | # spent 11µs (4+6) within Regexp::Common::BEGIN@60 which was called:
# once (4µs+6µs) by SQL::SplitStatement::BEGIN@16 at line 60 # spent 11µs making 1 call to Regexp::Common::BEGIN@60
# spent 6µs making 1 call to strict::unimport |
61 | 2 | 4µs | *{caller() . "::RE"} = \%RE; | ||
62 | } | ||||
63 | |||||
64 | 2 | 200ns | my $saw_import; | ||
65 | my $no_defaults; | ||||
66 | my %exclude; | ||||
67 | 6 | 9µs | 4 | 700ns | foreach my $entry (grep {!/^RE_/} @_) { # spent 700ns making 4 calls to Regexp::Common::CORE:match, avg 175ns/call |
68 | 4 | 800ns | if ($entry eq 'pattern') { | ||
69 | 2 | 142µs | 2 | 14µs | # spent 9µs (4+5) within Regexp::Common::BEGIN@69 which was called:
# once (4µs+5µs) by SQL::SplitStatement::BEGIN@16 at line 69 # spent 9µs making 1 call to Regexp::Common::BEGIN@69
# spent 5µs making 1 call to strict::unimport |
70 | 1 | 2µs | *{caller() . "::pattern"} = \&pattern; | ||
71 | 1 | 300ns | next; | ||
72 | } | ||||
73 | # This used to prevent $; from being set. We still recognize it, | ||||
74 | # but we won't do anything. | ||||
75 | 3 | 400ns | if ($entry eq 'clean') { | ||
76 | 1 | 0s | next; | ||
77 | } | ||||
78 | 2 | 100ns | if ($entry eq 'no_defaults') { | ||
79 | 1 | 100ns | $no_defaults ++; | ||
80 | 1 | 100ns | next; | ||
81 | } | ||||
82 | 1 | 400ns | if (my $module = $imports {$entry}) { | ||
83 | 1 | 200ns | $saw_import ++; | ||
84 | 1 | 14µs | eval "require $module;"; # spent 39µs executing statements in string eval | ||
85 | 1 | 100ns | die $@ if $@; | ||
86 | 1 | 400ns | next; | ||
87 | } | ||||
88 | if ($entry =~ /^!(.*)/ && $imports {$1}) { | ||||
89 | $exclude {$1} ++; | ||||
90 | next; | ||||
91 | } | ||||
92 | # As a last resort, try to load the argument. | ||||
93 | my $module = $entry =~ /^Regexp::Common/ | ||||
94 | ? $entry | ||||
95 | : "Regexp::Common::" . $entry; | ||||
96 | eval "require $module;"; | ||||
97 | die $@ if $@; | ||||
98 | } | ||||
99 | |||||
100 | 2 | 300ns | unless ($saw_import || $no_defaults) { | ||
101 | foreach my $module (values %imports) { | ||||
102 | next if $exclude {$module}; | ||||
103 | eval "require $module;"; | ||||
104 | die $@ if $@; | ||||
105 | } | ||||
106 | } | ||||
107 | |||||
108 | 2 | 300ns | my %exported; | ||
109 | 6 | 12µs | 4 | 200ns | foreach my $entry (grep {/^RE_/} @_) { # spent 200ns making 4 calls to Regexp::Common::CORE:match, avg 50ns/call |
110 | if ($entry =~ /^RE_(\w+_)?ALL$/) { | ||||
111 | my $m = defined $1 ? $1 : ""; | ||||
112 | my $re = qr /^RE_${m}.*$/; | ||||
113 | while (my ($sub, $interface) = each %sub_interface) { | ||||
114 | next if $exported {$sub}; | ||||
115 | next unless $sub =~ /$re/; | ||||
116 | { | ||||
117 | 2 | 39µs | 2 | 18µs | # spent 12µs (6+6) within Regexp::Common::BEGIN@117 which was called:
# once (6µs+6µs) by SQL::SplitStatement::BEGIN@16 at line 117 # spent 12µs making 1 call to Regexp::Common::BEGIN@117
# spent 6µs making 1 call to strict::unimport |
118 | *{caller() . "::$sub"} = $interface; | ||||
119 | } | ||||
120 | $exported {$sub} ++; | ||||
121 | } | ||||
122 | } | ||||
123 | else { | ||||
124 | next if $exported {$entry}; | ||||
125 | _croak "Can't export unknown subroutine &$entry" | ||||
126 | unless $sub_interface {$entry}; | ||||
127 | { | ||||
128 | 2 | 184µs | 2 | 13µs | # spent 8µs (4+5) within Regexp::Common::BEGIN@128 which was called:
# once (4µs+5µs) by SQL::SplitStatement::BEGIN@16 at line 128 # spent 8µs making 1 call to Regexp::Common::BEGIN@128
# spent 5µs making 1 call to strict::unimport |
129 | *{caller() . "::$entry"} = $sub_interface {$entry}; | ||||
130 | } | ||||
131 | $exported {$entry} ++; | ||||
132 | } | ||||
133 | } | ||||
134 | } | ||||
135 | |||||
136 | sub AUTOLOAD { _croak "Can't $AUTOLOAD" } | ||||
137 | |||||
138 | sub DESTROY {} | ||||
139 | |||||
140 | 1 | 200ns | my %cache; | ||
141 | |||||
142 | 1 | 5µs | 1 | 1µs | my $fpat = qr/^(-\w+)/; # spent 1µs making 1 call to Regexp::Common::CORE:qr |
143 | |||||
144 | sub _decache { | ||||
145 | my @args = @{tied %{$_[0]}}; | ||||
146 | my @nonflags = grep {!/$fpat/} @args; | ||||
147 | my $cache = get_cache(@nonflags); | ||||
148 | _croak "Can't create unknown regex: \$RE{" | ||||
149 | . join("}{",@args) . "}" | ||||
150 | unless exists $cache->{__VAL__}; | ||||
151 | _croak "Perl $] does not support the pattern " | ||||
152 | . "\$RE{" . join("}{",@args) | ||||
153 | . "}.\nYou need Perl $cache->{__VAL__}{version} or later" | ||||
154 | unless ($cache->{__VAL__}{version}||0) <= $]; | ||||
155 | my %flags = ( %{$cache->{__VAL__}{default}}, | ||||
156 | map { /$fpat\Q$;\E(.*)/ ? ($1 => $2) | ||||
157 | : /$fpat/ ? ($1 => undef) | ||||
158 | : () | ||||
159 | } @args); | ||||
160 | $cache->{__VAL__}->_clone_with(\@args, \%flags); | ||||
161 | } | ||||
162 | |||||
163 | 2 | 357µs | 2 | 42µs | # spent 24µs (6+18) within Regexp::Common::BEGIN@163 which was called:
# once (6µs+18µs) by SQL::SplitStatement::BEGIN@16 at line 163 # spent 24µs making 1 call to Regexp::Common::BEGIN@163
# spent 18µs making 1 call to overload::import |
164 | |||||
165 | |||||
166 | # spent 4µs within Regexp::Common::get_cache which was called 2 times, avg 2µs/call:
# 2 times (4µs+0s) by Regexp::Common::pattern at line 205, avg 2µs/call | ||||
167 | 2 | 500ns | my $cache = \%cache; | ||
168 | 2 | 600ns | foreach (@_) { | ||
169 | $cache = $cache->{$_} | ||||
170 | 2 | 2µs | || ($cache->{$_} = {}); | ||
171 | } | ||||
172 | 2 | 3µs | return $cache; | ||
173 | } | ||||
174 | |||||
175 | sub croak_version { | ||||
176 | my ($entry, @args) = @_; | ||||
177 | } | ||||
178 | |||||
179 | # spent 66µs (43+23) within Regexp::Common::pattern which was called 2 times, avg 33µs/call:
# once (28µs+19µs) by Regexp::Common::import at line 50 of Regexp/Common/delimited.pm
# once (14µs+4µs) by Regexp::Common::import at line 56 of Regexp/Common/delimited.pm | ||||
180 | 2 | 2µs | my %spec = @_; | ||
181 | _croak 'pattern() requires argument: name => [ @list ]' | ||||
182 | 2 | 1µs | unless $spec{name} && ref $spec{name} eq 'ARRAY'; | ||
183 | _croak 'pattern() requires argument: create => $sub_ref_or_string' | ||||
184 | 2 | 200ns | unless $spec{create}; | ||
185 | |||||
186 | 2 | 500ns | if (ref $spec{create} ne "CODE") { | ||
187 | my $fixed_str = "$spec{create}"; | ||||
188 | $spec{create} = sub { $fixed_str } | ||||
189 | } | ||||
190 | |||||
191 | 2 | 200ns | my @nonflags; | ||
192 | my %default; | ||||
193 | 2 | 1µs | foreach ( @{$spec{name}} ) { | ||
194 | 5 | 37µs | 14 | 18µs | if (/$fpat=(.*)/) { # spent 14µs making 7 calls to Regexp::Common::CORE:regcomp, avg 2µs/call
# spent 4µs making 7 calls to Regexp::Common::CORE:match, avg 571ns/call |
195 | $default{$1} = $2; | ||||
196 | } | ||||
197 | elsif (/$fpat\s*$/) { | ||||
198 | $default{$1} = undef; | ||||
199 | } | ||||
200 | else { | ||||
201 | 2 | 800ns | push @nonflags, $_; | ||
202 | } | ||||
203 | } | ||||
204 | |||||
205 | 2 | 1µs | 2 | 4µs | my $entry = get_cache(@nonflags); # spent 4µs making 2 calls to Regexp::Common::get_cache, avg 2µs/call |
206 | |||||
207 | 2 | 300ns | if ($entry->{__VAL__}) { | ||
208 | _carp "Overriding \$RE{" | ||||
209 | . join("}{",@nonflags) | ||||
210 | . "}"; | ||||
211 | } | ||||
212 | |||||
213 | $entry->{__VAL__} = bless { | ||||
214 | create => $spec{create}, | ||||
215 | match => $spec{match} || \&generic_match, | ||||
216 | subs => $spec{subs} || \&generic_subs, | ||||
217 | version => $spec{version}, | ||||
218 | 2 | 4µs | default => \%default, | ||
219 | }, 'Regexp::Common::Entry'; | ||||
220 | |||||
221 | 4 | 5µs | 2 | 800ns | foreach (@nonflags) {s/\W/X/g} # spent 800ns making 2 calls to Regexp::Common::CORE:subst, avg 400ns/call |
222 | 2 | 1µs | my $subname = "RE_" . join ("_", @nonflags); | ||
223 | $sub_interface{$subname} = sub { | ||||
224 | push @_ => undef if @_ % 2; | ||||
225 | my %flags = @_; | ||||
226 | my $pat = $spec{create}->($entry->{__VAL__}, | ||||
227 | {%default, %flags}, \@nonflags); | ||||
228 | if (exists $flags{-keep}) { $pat =~ s/\Q(?k:/(/g; } | ||||
229 | else { $pat =~ s/\Q(?k:/(?:/g; } | ||||
230 | return exists $flags {-i} ? qr /(?i:$pat)/ : qr/$pat/; | ||||
231 | 2 | 3µs | }; | ||
232 | |||||
233 | 2 | 4µs | return 1; | ||
234 | } | ||||
235 | |||||
236 | sub generic_match {$_ [1] =~ /$_[0]/} | ||||
237 | sub generic_subs {$_ [1] =~ s/$_[0]/$_[2]/} | ||||
238 | |||||
239 | sub matches { | ||||
240 | my ($self, $str) = @_; | ||||
241 | my $entry = $self -> _decache; | ||||
242 | $entry -> {match} -> ($entry, $str); | ||||
243 | } | ||||
244 | |||||
245 | sub subs { | ||||
246 | my ($self, $str, $newstr) = @_; | ||||
247 | my $entry = $self -> _decache; | ||||
248 | $entry -> {subs} -> ($entry, $str, $newstr); | ||||
249 | return $str; | ||||
250 | } | ||||
251 | |||||
252 | |||||
253 | package Regexp::Common::Entry; | ||||
254 | # use Carp; | ||||
255 | |||||
256 | use overload | ||||
257 | # spent 19µs (7+12) within Regexp::Common::Entry::BEGIN@257 which was called:
# once (7µs+12µs) by SQL::SplitStatement::BEGIN@16 at line 268 | ||||
258 | my ($self) = @_; | ||||
259 | my $pat = $self->{create}->($self, $self->{flags}, $self->{args}); | ||||
260 | if (exists $self->{flags}{-keep}) { | ||||
261 | $pat =~ s/\Q(?k:/(/g; | ||||
262 | } | ||||
263 | else { | ||||
264 | $pat =~ s/\Q(?k:/(?:/g; | ||||
265 | } | ||||
266 | if (exists $self->{flags}{-i}) { $pat = "(?i)$pat" } | ||||
267 | return $pat; | ||||
268 | 2 | 38µs | 2 | 31µs | }; # spent 19µs making 1 call to Regexp::Common::Entry::BEGIN@257
# spent 12µs making 1 call to overload::import |
269 | |||||
270 | sub _clone_with { | ||||
271 | my ($self, $args, $flags) = @_; | ||||
272 | bless { %$self, args=>$args, flags=>$flags }, ref $self; | ||||
273 | } | ||||
274 | |||||
275 | 1 | 4µs | 1; | ||
276 | |||||
277 | __END__ | ||||
# spent 5µs within Regexp::Common::CORE:match which was called 15 times, avg 327ns/call:
# 7 times (4µs+0s) by Regexp::Common::pattern at line 194, avg 571ns/call
# 4 times (700ns+0s) by Regexp::Common::import at line 67, avg 175ns/call
# 4 times (200ns+0s) by Regexp::Common::import at line 109, avg 50ns/call | |||||
# spent 1µs within Regexp::Common::CORE:qr which was called:
# once (1µs+0s) by SQL::SplitStatement::BEGIN@16 at line 142 | |||||
# spent 14µs within Regexp::Common::CORE:regcomp which was called 7 times, avg 2µs/call:
# 7 times (14µs+0s) by Regexp::Common::pattern at line 194, avg 2µs/call | |||||
# spent 800ns within Regexp::Common::CORE:subst which was called 2 times, avg 400ns/call:
# 2 times (800ns+0s) by Regexp::Common::pattern at line 221, avg 400ns/call |