3 our $VERSION = 0.06_01;
7 re - Perl pragma to alter regular expression behaviour
12 ($x) = ($^X =~ /^(.*)$/s); # $x is tainted here
14 $pat = '(?{ $foo = 1 })';
16 /foo${pat}bar/; # won't fail (when not under -T switch)
19 no re 'taint'; # the default
20 ($x) = ($^X =~ /^(.*)$/s); # $x is not tainted here
22 no re 'eval'; # the default
23 /foo${pat}bar/; # disallowed (with or without -T switch)
26 use re 'debug'; # NOT lexically scoped (as others are)
27 /^(.*)$/s; # output debugging info during
28 # compile and run time
30 use re 'debugcolor'; # same as 'debug', but with colored output
33 use re qw(Debug All); # Finer tuned debugging options.
34 use re qw(Debug More); # Similarly not lexically scoped.
35 no re qw(Debug ALL); # Turn of all re dugging and unload the module.
37 (We use $^X in these examples because it's tainted by default.)
41 When C<use re 'taint'> is in effect, and a tainted string is the target
42 of a regex, the regex memories (or values returned by the m// operator
43 in list context) are tainted. This feature is useful when regex operations
44 on tainted data aren't meant to extract safe substrings, but to perform
45 other transformations.
47 When C<use re 'eval'> is in effect, a regex is allowed to contain
48 C<(?{ ... })> zero-width assertions even if regular expression contains
49 variable interpolation. That is normally disallowed, since it is a
50 potential security risk. Note that this pragma is ignored when the regular
51 expression is obtained from tainted data, i.e. evaluation is always
52 disallowed with tainted regular expressions. See L<perlre/(?{ code })>.
54 For the purpose of this pragma, interpolation of precompiled regular
55 expressions (i.e., the result of C<qr//>) is I<not> considered variable
60 I<is> allowed if $pat is a precompiled regular expression, even
61 if $pat contains C<(?{ ... })> assertions.
63 When C<use re 'debug'> is in effect, perl emits debugging messages when
64 compiling and using regular expressions. The output is the same as that
65 obtained by running a C<-DDEBUGGING>-enabled perl interpreter with the
66 B<-Dr> switch. It may be quite voluminous depending on the complexity
67 of the match. Using C<debugcolor> instead of C<debug> enables a
68 form of output that can be used to get a colorful display on terminals
69 that understand termcap color sequences. Set C<$ENV{PERL_RE_TC}> to a
70 comma-separated list of C<termcap> properties to use for highlighting
71 strings on/off, pre-point part on/off.
72 See L<perldebug/"Debugging regular expressions"> for additional info.
74 Similarly C<use re 'Debug'> produces debugging output, the difference
75 being that it allows the fine tuning of what debugging output will be
76 emitted. Options are divided into three groups, those related to
77 compilation, those related to execution and those related to special
78 purposes. The options are as follows:
82 =item Compile related options
88 Turns on all compile related debug options.
92 Turns on debug output related to the process of parsing the pattern.
96 Enables output related to the optimisation phase of compilation.
100 Detailed info about trie compilation.
104 Dump the final program out after it is compiled and optimised.
108 Dump offset information. This can be used to see how regops correlate
109 to the pattern. Output format is
111 NODENUM:POSITION[LENGTH]
113 Where 1 is the position of the first char in the string. Note that position
114 can be 0, or larger than the actual length of the pattern, likewise length
119 =item Execute related options
125 Turns on all execute related debug options.
129 Turns on debugging of the main matching loop.
133 Extra debugging of how tries execute.
137 Enable debugging of start point optimisations.
141 =item Extra debugging options
147 Turns on all "extra" debugging options.
151 Enable enhanced TRIE debugging. Enhances both TRIE_EXECUTE
156 Enable debugging of offsets information. This emits copious
157 amounts of trace information and doesnt mesh well with other
160 Almost definately only useful to people hacking
161 on the offsets part of the debug engine.
165 =item Other useful flags
167 These are useful shortcuts to save on the typing.
173 Enable all compile and execute options at once.
177 Enable DUMP and all execute options. Equivelent to:
185 Enable TRIE_MORE and all execute compile and execute options.
191 The directive C<use re 'debug'> and its equivalents are I<not> lexically
192 scoped, as the other directives are. They have both compile-time and run-time
195 See L<perlmodlib/Pragmatic Modules>.
199 # N.B. File::Basename contains a literal for 'taint' as a fallback. If
200 # taint is changed here, File::Basename must be updated as well.
202 taint => 0x00100000, # HINT_RE_TAINT
203 eval => 0x00200000, # HINT_RE_EVAL
207 eval { # Ignore errors
210 my $terminal = Tgetent Term::Cap ({OSPEED => 9600}); # Avoid warning.
211 my $props = $ENV{PERL_RE_TC} || 'md,me,so,se,us,ue';
212 my @props = split /,/, $props;
213 my $colors = join "\t", map {$terminal->Tputs($_,1)} @props;
216 $ENV{PERL_RE_COLORS} = $colors;
219 $ENV{PERL_RE_COLORS}||=qq'\t\t> <\t> <\t\t'
227 OPTIMISE => 0x000002,
228 TRIE_COMPILE => 0x000004,
235 TRIE_EXECUTE => 0x000400,
238 TRIE_MORE => 0x010000,
239 OFFSETS_DEBUG => 0x020000,
243 $flags{All} = $flags{all} = $flags{DUMP} | $flags{EXECUTE};
244 $flags{More} = $flags{MORE} = $flags{All} | $flags{TRIE_MORE} | $flags{STATE};
245 $flags{State} = $flags{DUMP} | $flags{EXECUTE} | $flags{STATE};
246 $flags{TRIE} = $flags{DUMP} | $flags{EXECUTE} | $flags{TRIE_COMPILE};
248 my $installed =eval {
250 XSLoader::load('re');
257 die "'re' not installed!?" unless $installed;
258 #warn "installed: $installed\n";
259 install(); # allow for changes in colors
260 $^H{regcomp}= $installed;
272 foreach my $idx (0..$#_){
274 if ($s eq 'Debug' or $s eq 'Debugcolor') {
275 setcolor() if $s =~/color/i;
276 ${^RE_DEBUG_FLAGS} = 0 unless defined ${^RE_DEBUG_FLAGS};
277 for my $idx ($idx+1..$#_) {
278 if ($flags{$_[$idx]}) {
280 ${^RE_DEBUG_FLAGS} |= $flags{$_[$idx]};
282 ${^RE_DEBUG_FLAGS} &= ~ $flags{$_[$idx]};
286 Carp::carp("Unknown \"re\" Debug flag '$_[$idx]', possible flags: ",
287 join(", ",sort { $flags{$a} <=> $flags{$b} } keys %flags ) );
290 _load_unload($on ? 1 : ${^RE_DEBUG_FLAGS});
292 } elsif ($s eq 'debug' or $s eq 'debugcolor') {
293 setcolor() if $s =~/color/i;
295 } elsif (exists $bitmask{$s}) {
296 $bits |= $bitmask{$s};
299 Carp::carp("Unknown \"re\" subpragma '$s' (known ones are: ",
300 join(', ', map {qq('$_')} 'debug', 'debugcolor', sort keys %bitmask),
314 $^H &= ~ bits(0, @_);