← Index
NYTProf Performance Profile   « block view • line view • sub view »
For 05.Domain_and_Item.t
  Run on Tue May 4 17:21:41 2010
Reported on Tue May 4 17:22:21 2010

File /usr/local/lib/perl5/5.10.1/darwin-2level/re.pm
Statements Executed 41
Statement Execution Time 808µs
Subroutines — ordered by exclusive time
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
21122µs22µsre::::bitsre::bits
22217µs38µsre::::importre::import
11113µs16µsre::::BEGIN@4re::BEGIN@4
11112µs21µsre::::BEGIN@5re::BEGIN@5
0000s0sre::::_do_installre::_do_install
0000s0sre::::_load_unloadre::_load_unload
0000s0sre::::setcolorre::setcolor
0000s0sre::::unimportre::unimport
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments
Time
on line
Calls Time
in subs
Code
1package re;
2
3# pragma for controlling the regex engine
4320µs220µs
# spent 16µs (13+3) within re::BEGIN@4 which was called # once (13µs+3µs) by Moose::Util::TypeConstraints::BEGIN@572 at line 4
use strict;
# spent 16µs making 1 call to re::BEGIN@4 # spent 3µs making 1 call to strict::import
53686µs230µs
# spent 21µs (12+9) within re::BEGIN@5 which was called # once (12µs+9µs) by Moose::Util::TypeConstraints::BEGIN@572 at line 5
use warnings;
# spent 21µs making 1 call to re::BEGIN@5 # spent 9µs making 1 call to warnings::import
6
71500nsour $VERSION = "0.09";
817µsour @ISA = qw(Exporter);
91600nsmy @XS_FUNCTIONS = qw(regmust);
1012µsmy %XS_FUNCTIONS = map { $_ => 1 } @XS_FUNCTIONS;
1111µsour @EXPORT_OK = (@XS_FUNCTIONS,
12 qw(is_regexp regexp_pattern
13 regname regnames regnames_count));
1417µsour %EXPORT_OK = map { $_ => 1 } @EXPORT_OK;
15
16# *** WARNING *** WARNING *** WARNING *** WARNING *** WARNING ***
17#
18# If you modify these values see comment below!
19
201900nsmy %bitmask = (
21 taint => 0x00100000, # HINT_RE_TAINT
22 eval => 0x00200000, # HINT_RE_EVAL
23);
24
25# - File::Basename contains a literal for 'taint' as a fallback. If
26# taint is changed here, File::Basename must be updated as well.
27#
28# - ExtUtils::ParseXS uses a hardcoded
29# BEGIN { $^H |= 0x00200000 }
30# in it to allow re.xs to be built. So if 'eval' is changed here then
31# ExtUtils::ParseXS must be changed as well.
32#
33# *** WARNING *** WARNING *** WARNING *** WARNING *** WARNING ***
34
35sub 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
5315µsmy %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);
7511µs$flags{ALL} = -1 & ~($flags{OFFSETS}|$flags{OFFSETSDBG}|$flags{BUFFERS});
761600ns$flags{All} = $flags{all} = $flags{DUMP} | $flags{EXECUTE};
771300ns$flags{Extra} = $flags{EXECUTE} | $flags{COMPILE};
781600ns$flags{More} = $flags{MORE} = $flags{All} | $flags{TRIEC} | $flags{TRIEM} | $flags{STATE};
791500ns$flags{State} = $flags{DUMP} | $flags{EXECUTE} | $flags{STATE};
801400ns$flags{TRIE} = $flags{DUMP} | $flags{EXECUTE} | $flags{TRIEC};
81
821100nsmy $installed;
8310smy $installed_error;
84
85sub _do_install {
86 if ( ! defined($installed) ) {
87 require XSLoader;
88 $installed = eval { XSLoader::load('re', $VERSION) } || 0;
89 $installed_error = $@;
90 }
91}
92
93sub _load_unload {
94 my ($on)= @_;
95 if ($on) {
96 _do_install();
97 if ( ! $installed ) {
98 die "'re' not installed!? ($installed_error)";
99 } else {
100 # We call install() every time, as if we didn't, we wouldn't
101 # "see" any changes to the color environment var since
102 # the last time it was called.
103
104 # install() returns an integer, which if casted properly
105 # in C resolves to a structure containing the regex
106 # hooks. Setting it to a random integer will guarantee
107 # segfaults.
108 $^H{regcomp} = install();
109 }
110 } else {
111 delete $^H{regcomp};
112 }
113}
114
115
# spent 22µs within re::bits which was called 2 times, avg 11µs/call: # 2 times (22µs+0s) by re::import at line 171, avg 11µs/call
sub bits {
1161427µs my $on = shift;
117 my $bits = 0;
118 unless (@_) {
119 require Carp;
120 Carp::carp("Useless use of \"re\" pragma");
121 }
122 foreach my $idx (0..$#_){
123 my $s=$_[$idx];
124 if ($s eq 'Debug' or $s eq 'Debugcolor') {
125 setcolor() if $s =~/color/i;
126 ${^RE_DEBUG_FLAGS} = 0 unless defined ${^RE_DEBUG_FLAGS};
127 for my $idx ($idx+1..$#_) {
128 if ($flags{$_[$idx]}) {
129 if ($on) {
130 ${^RE_DEBUG_FLAGS} |= $flags{$_[$idx]};
131 } else {
132 ${^RE_DEBUG_FLAGS} &= ~ $flags{$_[$idx]};
133 }
134 } else {
135 require Carp;
136 Carp::carp("Unknown \"re\" Debug flag '$_[$idx]', possible flags: ",
137 join(", ",sort keys %flags ) );
138 }
139 }
140 _load_unload($on ? 1 : ${^RE_DEBUG_FLAGS});
141 last;
142 } elsif ($s eq 'debug' or $s eq 'debugcolor') {
143 setcolor() if $s =~/color/i;
144 _load_unload($on);
145 last;
146 } elsif (exists $bitmask{$s}) {
147 $bits |= $bitmask{$s};
148 } elsif ($XS_FUNCTIONS{$s}) {
149 _do_install();
150 if (! $installed) {
151 require Carp;
152 Carp::croak("\"re\" function '$s' not available");
153 }
154 require Exporter;
155 re->export_to_level(2, 're', $s);
156 } elsif ($EXPORT_OK{$s}) {
157 require Exporter;
158 re->export_to_level(2, 're', $s);
159 } else {
160 require Carp;
161 Carp::carp("Unknown \"re\" subpragma '$s' (known ones are: ",
162 join(', ', map {qq('$_')} 'debug', 'debugcolor', sort keys %bitmask),
163 ")");
164 }
165 }
166 $bits;
167}
168
169
# spent 38µs (17+22) within re::import which was called 2 times, avg 19µs/call: # once (10µs+15µs) by File::Basename::BEGIN@43 at line 46 of File/Basename.pm # once (7µs+7µs) by Moose::Util::TypeConstraints::BEGIN@572 at line 572 of Moose/Util/TypeConstraints.pm
sub import {
170412µs shift;
171 $^H |= bits(1, @_);
# spent 22µs making 2 calls to re::bits, avg 11µs/call
172}
173
174sub unimport {
175 shift;
176 $^H &= ~ bits(0, @_);
177}
178
179134µs1;
180
181__END__
182
183=head1 NAME
184
185re - Perl pragma to alter regular expression behaviour
186
187=head1 SYNOPSIS
188
189 use re 'taint';
190 ($x) = ($^X =~ /^(.*)$/s); # $x is tainted here
191
192 $pat = '(?{ $foo = 1 })';
193 use re 'eval';
194 /foo${pat}bar/; # won't fail (when not under -T switch)
195
196 {
197 no re 'taint'; # the default
198 ($x) = ($^X =~ /^(.*)$/s); # $x is not tainted here
199
200 no re 'eval'; # the default
201 /foo${pat}bar/; # disallowed (with or without -T switch)
202 }
203
204 use re 'debug'; # output debugging info during
205 /^(.*)$/s; # compile and run time
206
207
208 use re 'debugcolor'; # same as 'debug', but with colored output
209 ...
210
211 use re qw(Debug All); # Finer tuned debugging options.
212 use re qw(Debug More);
213 no re qw(Debug ALL); # Turn of all re debugging in this scope
214
215 use re qw(is_regexp regexp_pattern); # import utility functions
216 my ($pat,$mods)=regexp_pattern(qr/foo/i);
217 if (is_regexp($obj)) {
218 print "Got regexp: ",
219 scalar regexp_pattern($obj); # just as perl would stringify it
220 } # but no hassle with blessed re's.
221
222(We use $^X in these examples because it's tainted by default.)
223
224=head1 DESCRIPTION
225
226=head2 'taint' mode
227
228When C<use re 'taint'> is in effect, and a tainted string is the target
229of a regex, the regex memories (or values returned by the m// operator
230in list context) are tainted. This feature is useful when regex operations
231on tainted data aren't meant to extract safe substrings, but to perform
232other transformations.
233
234=head2 'eval' mode
235
236When C<use re 'eval'> is in effect, a regex is allowed to contain
237C<(?{ ... })> zero-width assertions even if regular expression contains
238variable interpolation. That is normally disallowed, since it is a
239potential security risk. Note that this pragma is ignored when the regular
240expression is obtained from tainted data, i.e. evaluation is always
241disallowed with tainted regular expressions. See L<perlre/(?{ code })>.
242
243For the purpose of this pragma, interpolation of precompiled regular
244expressions (i.e., the result of C<qr//>) is I<not> considered variable
245interpolation. Thus:
246
247 /foo${pat}bar/
248
249I<is> allowed if $pat is a precompiled regular expression, even
250if $pat contains C<(?{ ... })> assertions.
251
252=head2 'debug' mode
253
254When C<use re 'debug'> is in effect, perl emits debugging messages when
255compiling and using regular expressions. The output is the same as that
256obtained by running a C<-DDEBUGGING>-enabled perl interpreter with the
257B<-Dr> switch. It may be quite voluminous depending on the complexity
258of the match. Using C<debugcolor> instead of C<debug> enables a
259form of output that can be used to get a colorful display on terminals
260that understand termcap color sequences. Set C<$ENV{PERL_RE_TC}> to a
261comma-separated list of C<termcap> properties to use for highlighting
262strings on/off, pre-point part on/off.
263See L<perldebug/"Debugging regular expressions"> for additional info.
264
265As of 5.9.5 the directive C<use re 'debug'> and its equivalents are
266lexically scoped, as the other directives are. However they have both
267compile-time and run-time effects.
268
269See L<perlmodlib/Pragmatic Modules>.
270
271=head2 'Debug' mode
272
273Similarly C<use re 'Debug'> produces debugging output, the difference
274being that it allows the fine tuning of what debugging output will be
275emitted. Options are divided into three groups, those related to
276compilation, those related to execution and those related to special
277purposes. The options are as follows:
278
279=over 4
280
281=item Compile related options
282
283=over 4
284
285=item COMPILE
286
287Turns on all compile related debug options.
288
289=item PARSE
290
291Turns on debug output related to the process of parsing the pattern.
292
293=item OPTIMISE
294
295Enables output related to the optimisation phase of compilation.
296
297=item TRIEC
298
299Detailed info about trie compilation.
300
301=item DUMP
302
303Dump the final program out after it is compiled and optimised.
304
305=back
306
307=item Execute related options
308
309=over 4
310
311=item EXECUTE
312
313Turns on all execute related debug options.
314
315=item MATCH
316
317Turns on debugging of the main matching loop.
318
319=item TRIEE
320
321Extra debugging of how tries execute.
322
323=item INTUIT
324
325Enable debugging of start point optimisations.
326
327=back
328
329=item Extra debugging options
330
331=over 4
332
333=item EXTRA
334
335Turns on all "extra" debugging options.
336
337=item BUFFERS
338
339Enable debugging the capture buffer storage during match. Warning,
340this can potentially produce extremely large output.
341
342=item TRIEM
343
344Enable enhanced TRIE debugging. Enhances both TRIEE
345and TRIEC.
346
347=item STATE
348
349Enable debugging of states in the engine.
350
351=item STACK
352
353Enable debugging of the recursion stack in the engine. Enabling
354or disabling this option automatically does the same for debugging
355states as well. This output from this can be quite large.
356
357=item OPTIMISEM
358
359Enable enhanced optimisation debugging and start point optimisations.
360Probably not useful except when debugging the regex engine itself.
361
362=item OFFSETS
363
364Dump offset information. This can be used to see how regops correlate
365to the pattern. Output format is
366
367 NODENUM:POSITION[LENGTH]
368
369Where 1 is the position of the first char in the string. Note that position
370can be 0, or larger than the actual length of the pattern, likewise length
371can be zero.
372
373=item OFFSETSDBG
374
375Enable debugging of offsets information. This emits copious
376amounts of trace information and doesn't mesh well with other
377debug options.
378
379Almost definitely only useful to people hacking
380on the offsets part of the debug engine.
381
382=back
383
384=item Other useful flags
385
386These are useful shortcuts to save on the typing.
387
388=over 4
389
390=item ALL
391
392Enable all options at once except OFFSETS, OFFSETSDBG and BUFFERS
393
394=item All
395
396Enable DUMP and all execute options. Equivalent to:
397
398 use re 'debug';
399
400=item MORE
401
402=item More
403
404Enable TRIEM and all execute compile and execute options.
405
406=back
407
408=back
409
410As of 5.9.5 the directive C<use re 'debug'> and its equivalents are
411lexically scoped, as the other directives are. However they have both
412compile-time and run-time effects.
413
414=head2 Exportable Functions
415
416As of perl 5.9.5 're' debug contains a number of utility functions that
417may be optionally exported into the caller's namespace. They are listed
418below.
419
420=over 4
421
422=item is_regexp($ref)
423
424Returns true if the argument is a compiled regular expression as returned
425by C<qr//>, false if it is not.
426
427This function will not be confused by overloading or blessing. In
428internals terms, this extracts the regexp pointer out of the
429PERL_MAGIC_qr structure so it it cannot be fooled.
430
431=item regexp_pattern($ref)
432
433If the argument is a compiled regular expression as returned by C<qr//>,
434then this function returns the pattern.
435
436In list context it returns a two element list, the first element
437containing the pattern and the second containing the modifiers used when
438the pattern was compiled.
439
440 my ($pat, $mods) = regexp_pattern($ref);
441
442In scalar context it returns the same as perl would when strigifying a raw
443C<qr//> with the same pattern inside. If the argument is not a compiled
444reference then this routine returns false but defined in scalar context,
445and the empty list in list context. Thus the following
446
447 if (regexp_pattern($ref) eq '(?i-xsm:foo)')
448
449will be warning free regardless of what $ref actually is.
450
451Like C<is_regexp> this function will not be confused by overloading
452or blessing of the object.
453
454=item regmust($ref)
455
456If the argument is a compiled regular expression as returned by C<qr//>,
457then this function returns what the optimiser consiers to be the longest
458anchored fixed string and longest floating fixed string in the pattern.
459
460A I<fixed string> is defined as being a substring that must appear for the
461pattern to match. An I<anchored fixed string> is a fixed string that must
462appear at a particular offset from the beginning of the match. A I<floating
463fixed string> is defined as a fixed string that can appear at any point in
464a range of positions relative to the start of the match. For example,
465
466 my $qr = qr/here .* there/x;
467 my ($anchored, $floating) = regmust($qr);
468 print "anchored:'$anchored'\nfloating:'$floating'\n";
469
470results in
471
472 anchored:'here'
473 floating:'there'
474
475Because the C<here> is before the C<.*> in the pattern, its position
476can be determined exactly. That's not true, however, for the C<there>;
477it could appear at any point after where the anchored string appeared.
478Perl uses both for its optimisations, prefering the longer, or, if they are
479equal, the floating.
480
481B<NOTE:> This may not necessarily be the definitive longest anchored and
482floating string. This will be what the optimiser of the Perl that you
483are using thinks is the longest. If you believe that the result is wrong
484please report it via the L<perlbug> utility.
485
486=item regname($name,$all)
487
488Returns the contents of a named buffer of the last successful match. If
489$all is true, then returns an array ref containing one entry per buffer,
490otherwise returns the first defined buffer.
491
492=item regnames($all)
493
494Returns a list of all of the named buffers defined in the last successful
495match. If $all is true, then it returns all names defined, if not it returns
496only names which were involved in the match.
497
498=item regnames_count()
499
500Returns the number of distinct names defined in the pattern used
501for the last successful match.
502
503B<Note:> this result is always the actual number of distinct
504named buffers defined, it may not actually match that which is
505returned by C<regnames()> and related routines when those routines
506have not been called with the $all parameter set.
507
508=back
509
510=head1 SEE ALSO
511
512L<perlmodlib/Pragmatic Modules>.
513
514=cut