Profile of re.pm

← Index
NYTProf Performance Profile «block view•line view•sub view»
For bin/dpath
Run on Tue Jun 5 15:30:18 2012
Reported on Tue Jun 5 15:30:38 2012

Filename | /home/ss5/perl5/perlbrew/perls/perl-5.14.1/lib/5.14.1/x86_64-linux-thread-multi/re.pm
Statements | Executed 32 statements in 6.10ms

Subroutines
Calls | P | F | Exclusive Time | Inclusive Time | Subroutine
--- | --- | --- | --- | --- | ---
1 | 1 | 1 | 63µs | 82µs | re::::BEGIN@4re::BEGIN@4
1 | 1 | 1 | 35µs | 35µs | re::::bitsre::bits
1 | 1 | 1 | 33µs | 67µs | re::::importre::import
1 | 1 | 1 | 31µs | 59µs | re::::BEGIN@5re::BEGIN@5
0 | 0 | 0 | 0s | 0s | re::::_load_unloadre::_load_unload
0 | 0 | 0 | 0s | 0s | re::::setcolorre::setcolor
0 | 0 | 0 | 0s | 0s | re::::unimportre::unimport

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

Line | State ments | Time on line | Calls | Time in subs | Code
--- | --- | --- | --- | --- | ---
1 |  |  |  |  | package re;
2 |  |  |  |  |
3 |  |  |  |  | # pragma for controlling the regexp engine
4 | 2 | 102µs | 2 | 100µs | # spent 82µs (63+18) within re::BEGIN@4 which was called: # once (63µs+18µs) by B::Deparse::BEGIN@3436 at line 4 use strict; # spent 82µs making 1 call to re::BEGIN@4 # spent 18µs making 1 call to strict::import
5 | 2 | 4.89ms | 2 | 86µs | # spent 59µs (31+28) within re::BEGIN@5 which was called: # once (31µs+28µs) by B::Deparse::BEGIN@3436 at line 5 use warnings; # spent 59µs making 1 call to re::BEGIN@5 # spent 28µs making 1 call to warnings::import
6 |  |  |  |  |
7 | 1 | 3µs |  |  | our $VERSION = "0.18";
8 | 1 | 31µs |  |  | our @ISA = qw(Exporter);
9 | 1 | 6µs |  |  | our @EXPORT_OK = ('regmust',
10 |  |  |  |  | qw(is_regexp regexp_pattern
11 |  |  |  |  | regname regnames regnames_count));
12 | 1 | 24µs |  |  | our %EXPORT_OK = map { $_ => 1 } @EXPORT_OK;
13 |  |  |  |  |
14 | 1 | 5µs |  |  | my %bitmask = (
15 |  |  |  |  | taint => 0x00100000, # HINT_RE_TAINT
16 |  |  |  |  | eval => 0x00200000, # HINT_RE_EVAL
17 |  |  |  |  | );
18 |  |  |  |  |
19 | 1 | 1µs |  |  | my $flags_hint = 0x02000000; # HINT_RE_FLAGS
20 | 1 | 600ns |  |  | my $PMMOD_SHIFT = 0;
21 | 1 | 21µs |  |  | my %reflags = (
22 |  |  |  |  | m => 1 << ($PMMOD_SHIFT + 0),
23 |  |  |  |  | s => 1 << ($PMMOD_SHIFT + 1),
24 |  |  |  |  | i => 1 << ($PMMOD_SHIFT + 2),
25 |  |  |  |  | x => 1 << ($PMMOD_SHIFT + 3),
26 |  |  |  |  | p => 1 << ($PMMOD_SHIFT + 4),
27 |  |  |  |  | # special cases:
28 |  |  |  |  | d => 0,
29 |  |  |  |  | l => 1,
30 |  |  |  |  | u => 2,
31 |  |  |  |  | a => 3,
32 |  |  |  |  | aa => 4,
33 |  |  |  |  | );
34 |  |  |  |  |
35 |  |  |  |  | sub setcolor {
36 |  |  |  |  | eval { # Ignore errors
37 |  |  |  |  | require Term::Cap;
38 |  |  |  |  |
39 |  |  |  |  | my $terminal = Tgetent Term::Cap ({OSPEED => 9600}); # Avoid warning.
40 |  |  |  |  | my $props = $ENV{PERL_RE_TC} || 'md,me,so,se,us,ue';
41 |  |  |  |  | my @props = split /,/, $props;
42 |  |  |  |  | my $colors = join "\t", map {$terminal->Tputs($_,1)} @props;
43 |  |  |  |  |
44 |  |  |  |  | $colors =~ s/\0//g;
45 |  |  |  |  | $ENV{PERL_RE_COLORS} = $colors;
46 |  |  |  |  | };
47 |  |  |  |  | if ($@) {
48 |  |  |  |  | $ENV{PERL_RE_COLORS} ||= qq'\t\t> <\t> <\t\t';
49 |  |  |  |  | }
50 |  |  |  |  |
51 |  |  |  |  | }
52 |  |  |  |  |
53 | 1 | 19µs |  |  | my %flags = (
54 |  |  |  |  | COMPILE => 0x0000FF,
55 |  |  |  |  | PARSE => 0x000001,
56 |  |  |  |  | OPTIMISE => 0x000002,
57 |  |  |  |  | TRIEC => 0x000004,
58 |  |  |  |  | DUMP => 0x000008,
59 |  |  |  |  | FLAGS => 0x000010,
60 |  |  |  |  |
61 |  |  |  |  | EXECUTE => 0x00FF00,
62 |  |  |  |  | INTUIT => 0x000100,
63 |  |  |  |  | MATCH => 0x000200,
64 |  |  |  |  | TRIEE => 0x000400,
65 |  |  |  |  |
66 |  |  |  |  | EXTRA => 0xFF0000,
67 |  |  |  |  | TRIEM => 0x010000,
68 |  |  |  |  | OFFSETS => 0x020000,
69 |  |  |  |  | OFFSETSDBG => 0x040000,
70 |  |  |  |  | STATE => 0x080000,
71 |  |  |  |  | OPTIMISEM => 0x100000,
72 |  |  |  |  | STACK => 0x280000,
73 |  |  |  |  | BUFFERS => 0x400000,
74 |  |  |  |  | GPOS => 0x800000,
75 |  |  |  |  | );
76 | 1 | 7µs |  |  | $flags{ALL} = -1 & ~($flags{OFFSETS}|$flags{OFFSETSDBG}|$flags{BUFFERS});
77 | 1 | 3µs |  |  | $flags{All} = $flags{all} = $flags{DUMP} | $flags{EXECUTE};
78 | 1 | 2µs |  |  | $flags{Extra} = $flags{EXECUTE} | $flags{COMPILE} | $flags{GPOS};
79 | 1 | 3µs |  |  | $flags{More} = $flags{MORE} = $flags{All} | $flags{TRIEC} | $flags{TRIEM} | $flags{STATE};
80 | 1 | 2µs |  |  | $flags{State} = $flags{DUMP} | $flags{EXECUTE} | $flags{STATE};
81 | 1 | 2µs |  |  | $flags{TRIE} = $flags{DUMP} | $flags{EXECUTE} | $flags{TRIEC};
82 |  |  |  |  |
83 | 3 | 814µs |  |  | if (defined &DynaLoader::boot_DynaLoader) {
84 |  |  |  |  | require XSLoader;
85 |  |  | 1 | 765µs | XSLoader::load(); # spent 765µs making 1 call to XSLoader::load
86 |  |  |  |  | }
87 |  |  |  |  | # else we're miniperl
88 |  |  |  |  | # We need to work for miniperl, because the XS toolchain uses Text::Wrap, which
89 |  |  |  |  | # uses re 'taint'.
90 |  |  |  |  |
91 |  |  |  |  | sub _load_unload {
92 |  |  |  |  | my ($on)= @_;
93 |  |  |  |  | if ($on) {
94 |  |  |  |  | # We call install() every time, as if we didn't, we wouldn't
95 |  |  |  |  | # "see" any changes to the color environment var since
96 |  |  |  |  | # the last time it was called.
97 |  |  |  |  |
98 |  |  |  |  | # install() returns an integer, which if casted properly
99 |  |  |  |  | # in C resolves to a structure containing the regexp
100 |  |  |  |  | # hooks. Setting it to a random integer will guarantee
101 |  |  |  |  | # segfaults.
102 |  |  |  |  | $^H{regcomp} = install();
103 |  |  |  |  | } else {
104 |  |  |  |  | delete $^H{regcomp};
105 |  |  |  |  | }
106 |  |  |  |  | }
107 |  |  |  |  |
108 |  |  |  |  | # spent 35µs within re::bits which was called: # once (35µs+0s) by re::import at line 219 sub bits {
109 | 5 | 29µs |  |  | my $on = shift;
110 |  |  |  |  | my $bits = 0;
111 |  |  |  |  | unless (@_) {
112 |  |  |  |  | require Carp;
113 |  |  |  |  | Carp::carp("Useless use of \"re\" pragma");
114 |  |  |  |  | }
115 |  |  |  |  | ARG:
116 |  |  |  |  | foreach my $idx (0..$#_){
117 | 2 | 16µs |  |  | my $s=$_[$idx];
118 |  |  |  |  | if ($s eq 'Debug' or $s eq 'Debugcolor') {
119 |  |  |  |  | setcolor() if $s =~/color/i;
120 |  |  |  |  | ${^RE_DEBUG_FLAGS} = 0 unless defined ${^RE_DEBUG_FLAGS};
121 |  |  |  |  | for my $idx ($idx+1..$#_) {
122 |  |  |  |  | if ($flags{$_[$idx]}) {
123 |  |  |  |  | if ($on) {
124 |  |  |  |  | ${^RE_DEBUG_FLAGS} |= $flags{$_[$idx]};
125 |  |  |  |  | } else {
126 |  |  |  |  | ${^RE_DEBUG_FLAGS} &= ~ $flags{$_[$idx]};
127 |  |  |  |  | }
128 |  |  |  |  | } else {
129 |  |  |  |  | require Carp;
130 |  |  |  |  | Carp::carp("Unknown \"re\" Debug flag '$_[$idx]', possible flags: ",
131 |  |  |  |  | join(", ",sort keys %flags ) );
132 |  |  |  |  | }
133 |  |  |  |  | }
134 |  |  |  |  | _load_unload($on ? 1 : ${^RE_DEBUG_FLAGS});
135 |  |  |  |  | last;
136 |  |  |  |  | } elsif ($s eq 'debug' or $s eq 'debugcolor') {
137 |  |  |  |  | setcolor() if $s =~/color/i;
138 |  |  |  |  | _load_unload($on);
139 |  |  |  |  | last;
140 |  |  |  |  | } elsif (exists $bitmask{$s}) {
141 |  |  |  |  | $bits |= $bitmask{$s};
142 |  |  |  |  | } elsif ($EXPORT_OK{$s}) {
143 |  |  |  |  | require Exporter;
144 |  |  |  |  | re->export_to_level(2, 're', $s);
145 |  |  |  |  | } elsif ($s =~ s/^\///) {
146 |  |  |  |  | my $reflags = $^H{reflags} || 0;
147 |  |  |  |  | my $seen_charset;
148 |  |  |  |  | while ($s =~ m/( . )/gx) {
149 |  |  |  |  | $_ = $1;
150 |  |  |  |  | if (/[adul]/) {
151 |  |  |  |  | # The 'a' may be repeated; hide this from the rest of the
152 |  |  |  |  | # code by counting and getting rid of all of them, then
153 |  |  |  |  | # changing to 'aa' if there is a repeat.
154 |  |  |  |  | if ($_ eq 'a') {
155 |  |  |  |  | my $sav_pos = pos $s;
156 |  |  |  |  | my $a_count = $s =~ s/a//g;
157 |  |  |  |  | pos $s = $sav_pos - 1; # -1 because got rid of the 'a'
158 |  |  |  |  | if ($a_count > 2) {
159 |  |  |  |  | require Carp;
160 |  |  |  |  | Carp::carp(
161 |  |  |  |  | qq 'The "a" flag may only appear a maximum of twice'
162 |  |  |  |  | );
163 |  |  |  |  | }
164 |  |  |  |  | elsif ($a_count == 2) {
165 |  |  |  |  | $_ = 'aa';
166 |  |  |  |  | }
167 |  |  |  |  | }
168 |  |  |  |  | if ($on) {
169 |  |  |  |  | if ($seen_charset) {
170 |  |  |  |  | require Carp;
171 |  |  |  |  | if ($seen_charset ne $_) {
172 |  |  |  |  | Carp::carp(
173 |  |  |  |  | qq 'The "$seen_charset" and "$_" flags '
174 |  |  |  |  | .qq 'are exclusive'
175 |  |  |  |  | );
176 |  |  |  |  | }
177 |  |  |  |  | else {
178 |  |  |  |  | Carp::carp(
179 |  |  |  |  | qq 'The "$seen_charset" flag may not appear '
180 |  |  |  |  | .qq 'twice'
181 |  |  |  |  | );
182 |  |  |  |  | }
183 |  |  |  |  | }
184 |  |  |  |  | $^H{reflags_charset} = $reflags{$_};
185 |  |  |  |  | $seen_charset = $_;
186 |  |  |  |  | }
187 |  |  |  |  | else {
188 |  |  |  |  | delete $^H{reflags_charset}
189 |  |  |  |  | if defined $^H{reflags_charset}
190 |  |  |  |  | && $^H{reflags_charset} == $reflags{$_};
191 |  |  |  |  | }
192 |  |  |  |  | } elsif (exists $reflags{$_}) {
193 |  |  |  |  | $on
194 |  |  |  |  | ? $reflags |= $reflags{$_}
195 |  |  |  |  | : ($reflags &= ~$reflags{$_});
196 |  |  |  |  | } else {
197 |  |  |  |  | require Carp;
198 |  |  |  |  | Carp::carp(
199 |  |  |  |  | qq'Unknown regular expression flag "$_"'
200 |  |  |  |  | );
201 |  |  |  |  | next ARG;
202 |  |  |  |  | }
203 |  |  |  |  | }
204 |  |  |  |  | ($^H{reflags} = $reflags or defined $^H{reflags_charset})
205 |  |  |  |  | ? $^H |= $flags_hint
206 |  |  |  |  | : ($^H &= ~$flags_hint);
207 |  |  |  |  | } else {
208 |  |  |  |  | require Carp;
209 |  |  |  |  | Carp::carp("Unknown \"re\" subpragma '$s' (known ones are: ",
210 |  |  |  |  | join(', ', map {qq('$_')} 'debug', 'debugcolor', sort keys %bitmask),
211 |  |  |  |  | ")");
212 |  |  |  |  | }
213 |  |  |  |  | }
214 |  |  |  |  | $bits;
215 |  |  |  |  | }
216 |  |  |  |  |
217 |  |  |  |  | # spent 67µs (33+35) within re::import which was called: # once (33µs+35µs) by B::Deparse::BEGIN@3436 at line 3436 of B/Deparse.pm sub import {
218 | 2 | 26µs |  |  | shift;
219 |  |  | 1 | 35µs | $^H |= bits(1, @_); # spent 35µs making 1 call to re::bits
220 |  |  |  |  | }
221 |  |  |  |  |
222 |  |  |  |  | sub unimport {
223 |  |  |  |  | shift;
224 |  |  |  |  | $^H &= ~ bits(0, @_);
225 |  |  |  |  | }
226 |  |  |  |  |
227 | 1 | 94µs |  |  | 1;
228 |  |  |  |  |
229 |  |  |  |  | __END__