This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
minor nit in binmode docs
[perl5.git] / ext / re / re.pm
CommitLineData
b3eb6a9b
GS
1package re;
2
de8c5301
YO
3# pragma for controlling the regex engine
4use strict;
5use warnings;
6
7our $VERSION = "0.06_03";
8our @ISA = qw(Exporter);
9our @EXPORT_OK = qw(is_regexp regexp_pattern);
10our %EXPORT_OK = map { $_ => 1 } @EXPORT_OK;
11
12# *** WARNING *** WARNING *** WARNING *** WARNING *** WARNING ***
13#
14# If you modify these values see comment below!
15
16my %bitmask = (
17 taint => 0x00100000, # HINT_RE_TAINT
18 eval => 0x00200000, # HINT_RE_EVAL
19);
20
21# - File::Basename contains a literal for 'taint' as a fallback. If
22# taint is changed here, File::Basename must be updated as well.
23#
24# - ExtUtils::ParseXS uses a hardcoded
25# BEGIN { $^H |= 0x00200000 }
26# in it to allow re.xs to be built. So if 'eval' is changed here then
27# ExtUtils::ParseXS must be changed as well.
28#
29# *** WARNING *** WARNING *** WARNING *** WARNING *** WARNING ***
30
31sub setcolor {
32 eval { # Ignore errors
33 require Term::Cap;
34
35 my $terminal = Tgetent Term::Cap ({OSPEED => 9600}); # Avoid warning.
36 my $props = $ENV{PERL_RE_TC} || 'md,me,so,se,us,ue';
37 my @props = split /,/, $props;
38 my $colors = join "\t", map {$terminal->Tputs($_,1)} @props;
39
40 $colors =~ s/\0//g;
41 $ENV{PERL_RE_COLORS} = $colors;
42 };
43 if ($@) {
44 $ENV{PERL_RE_COLORS} ||= qq'\t\t> <\t> <\t\t';
45 }
46
47}
48
49my %flags = (
50 COMPILE => 0x0000FF,
51 PARSE => 0x000001,
52 OPTIMISE => 0x000002,
53 TRIEC => 0x000004,
54 DUMP => 0x000008,
55
56 EXECUTE => 0x00FF00,
57 INTUIT => 0x000100,
58 MATCH => 0x000200,
59 TRIEE => 0x000400,
60
61 EXTRA => 0xFF0000,
62 TRIEM => 0x010000,
63 OFFSETS => 0x020000,
64 OFFSETSDBG => 0x040000,
65 STATE => 0x080000,
66 OPTIMISEM => 0x100000,
67 STACK => 0x280000,
68);
69$flags{ALL} = -1;
70$flags{All} = $flags{all} = $flags{DUMP} | $flags{EXECUTE};
71$flags{Extra} = $flags{EXECUTE} | $flags{COMPILE};
72$flags{More} = $flags{MORE} = $flags{All} | $flags{TRIEC} | $flags{TRIEM} | $flags{STATE};
73$flags{State} = $flags{DUMP} | $flags{EXECUTE} | $flags{STATE};
74$flags{TRIE} = $flags{DUMP} | $flags{EXECUTE} | $flags{TRIEC};
75
76my $installed;
77my $installed_error;
78
79sub _do_install {
80 if ( ! defined($installed) ) {
81 require XSLoader;
82 $installed = eval { XSLoader::load('re', $VERSION) } || 0;
83 $installed_error = $@;
84 }
85}
86
87sub _load_unload {
88 my ($on)= @_;
89 if ($on) {
90 _do_install();
91 if ( ! $installed ) {
92 die "'re' not installed!? ($installed_error)";
93 } else {
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 regex
100 # hooks. Setting it to a random integer will guarantee
101 # segfaults.
102 $^H{regcomp} = install();
103 }
104 } else {
105 delete $^H{regcomp};
106 }
107}
108
109sub bits {
110 my $on = shift;
111 my $bits = 0;
112 unless (@_) {
113 require Carp;
114 Carp::carp("Useless use of \"re\" pragma");
115 }
116 foreach my $idx (0..$#_){
117 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 } elsif (exists $bitmask{$s}) {
140 $bits |= $bitmask{$s};
141 } elsif ($EXPORT_OK{$s}) {
142 _do_install();
143 require Exporter;
144 re->export_to_level(2, 're', $s);
145 } else {
146 require Carp;
147 Carp::carp("Unknown \"re\" subpragma '$s' (known ones are: ",
148 join(', ', map {qq('$_')} 'debug', 'debugcolor', sort keys %bitmask),
149 ")");
150 }
151 }
152 $bits;
153}
154
155sub import {
156 shift;
157 $^H |= bits(1, @_);
158}
159
160sub unimport {
161 shift;
162 $^H &= ~ bits(0, @_);
163}
164
1651;
166
167__END__
56953603 168
b3eb6a9b
GS
169=head1 NAME
170
171re - Perl pragma to alter regular expression behaviour
172
173=head1 SYNOPSIS
174
e4d48cc9
GS
175 use re 'taint';
176 ($x) = ($^X =~ /^(.*)$/s); # $x is tainted here
b3eb6a9b 177
2cd61cdb 178 $pat = '(?{ $foo = 1 })';
e4d48cc9 179 use re 'eval';
2cd61cdb 180 /foo${pat}bar/; # won't fail (when not under -T switch)
e4d48cc9
GS
181
182 {
183 no re 'taint'; # the default
184 ($x) = ($^X =~ /^(.*)$/s); # $x is not tainted here
185
186 no re 'eval'; # the default
2cd61cdb 187 /foo${pat}bar/; # disallowed (with or without -T switch)
e4d48cc9 188 }
b3eb6a9b 189
1e2e3d02
YO
190 use re 'debug'; # output debugging info during
191 /^(.*)$/s; # compile and run time
192
2cd61cdb 193
02ea72ae
IZ
194 use re 'debugcolor'; # same as 'debug', but with colored output
195 ...
196
a3621e74 197 use re qw(Debug All); # Finer tuned debugging options.
1e2e3d02 198 use re qw(Debug More);
fe759410 199 no re qw(Debug ALL); # Turn of all re debugging in this scope
de8c5301
YO
200
201 use re qw(is_regexp regexp_pattern); # import utility functions
202 my ($pat,$mods)=regexp_pattern(qr/foo/i);
203 if (is_regexp($obj)) {
204 print "Got regexp: ",
205 scalar regexp_pattern($obj); # just as perl would stringify it
206 } # but no hassle with blessed re's.
207
a3621e74 208
3ffabb8c
GS
209(We use $^X in these examples because it's tainted by default.)
210
b3eb6a9b
GS
211=head1 DESCRIPTION
212
de8c5301
YO
213=head2 'taint' mode
214
b3eb6a9b
GS
215When C<use re 'taint'> is in effect, and a tainted string is the target
216of a regex, the regex memories (or values returned by the m// operator
e4d48cc9
GS
217in list context) are tainted. This feature is useful when regex operations
218on tainted data aren't meant to extract safe substrings, but to perform
219other transformations.
b3eb6a9b 220
de8c5301
YO
221=head2 'eval' mode
222
e4d48cc9 223When C<use re 'eval'> is in effect, a regex is allowed to contain
2cd61cdb 224C<(?{ ... })> zero-width assertions even if regular expression contains
ffbc6a93 225variable interpolation. That is normally disallowed, since it is a
2cd61cdb
IZ
226potential security risk. Note that this pragma is ignored when the regular
227expression is obtained from tainted data, i.e. evaluation is always
3c4b39be 228disallowed with tainted regular expressions. See L<perlre/(?{ code })>.
2cd61cdb 229
ffbc6a93 230For the purpose of this pragma, interpolation of precompiled regular
0a92e3a8
GS
231expressions (i.e., the result of C<qr//>) is I<not> considered variable
232interpolation. Thus:
2cd61cdb
IZ
233
234 /foo${pat}bar/
235
ffbc6a93 236I<is> allowed if $pat is a precompiled regular expression, even
2cd61cdb
IZ
237if $pat contains C<(?{ ... })> assertions.
238
de8c5301
YO
239=head2 'debug' mode
240
ffbc6a93 241When C<use re 'debug'> is in effect, perl emits debugging messages when
2cd61cdb
IZ
242compiling and using regular expressions. The output is the same as that
243obtained by running a C<-DDEBUGGING>-enabled perl interpreter with the
244B<-Dr> switch. It may be quite voluminous depending on the complexity
02ea72ae
IZ
245of the match. Using C<debugcolor> instead of C<debug> enables a
246form of output that can be used to get a colorful display on terminals
247that understand termcap color sequences. Set C<$ENV{PERL_RE_TC}> to a
248comma-separated list of C<termcap> properties to use for highlighting
ffbc6a93 249strings on/off, pre-point part on/off.
2cd61cdb
IZ
250See L<perldebug/"Debugging regular expressions"> for additional info.
251
de8c5301
YO
252As of 5.9.5 the directive C<use re 'debug'> and its equivalents are
253lexically scoped, as the other directives are. However they have both
254compile-time and run-time effects.
255
256See L<perlmodlib/Pragmatic Modules>.
257
258=head2 'Debug' mode
259
a3621e74
YO
260Similarly C<use re 'Debug'> produces debugging output, the difference
261being that it allows the fine tuning of what debugging output will be
be8e71aa
YO
262emitted. Options are divided into three groups, those related to
263compilation, those related to execution and those related to special
264purposes. The options are as follows:
265
266=over 4
267
268=item Compile related options
269
270=over 4
271
272=item COMPILE
273
274Turns on all compile related debug options.
275
276=item PARSE
277
278Turns on debug output related to the process of parsing the pattern.
279
280=item OPTIMISE
281
282Enables output related to the optimisation phase of compilation.
283
24b23f37 284=item TRIEC
be8e71aa
YO
285
286Detailed info about trie compilation.
287
288=item DUMP
289
290Dump the final program out after it is compiled and optimised.
291
be8e71aa
YO
292
293=back
294
295=item Execute related options
296
297=over 4
298
299=item EXECUTE
300
301Turns on all execute related debug options.
302
303=item MATCH
304
305Turns on debugging of the main matching loop.
306
24b23f37 307=item TRIEE
be8e71aa
YO
308
309Extra debugging of how tries execute.
310
311=item INTUIT
312
313Enable debugging of start point optimisations.
314
315=back
316
317=item Extra debugging options
318
319=over 4
320
321=item EXTRA
322
323Turns on all "extra" debugging options.
324
24b23f37
YO
325=item TRIEM
326
327Enable enhanced TRIE debugging. Enhances both TRIEE
328and TRIEC.
329
330=item STATE
331
332Enable debugging of states in the engine.
333
334=item STACK
be8e71aa 335
24b23f37
YO
336Enable debugging of the recursion stack in the engine. Enabling
337or disabling this option automatically does the same for debugging
338states as well. This output from this can be quite large.
339
340=item OPTIMISEM
341
342Enable enhanced optimisation debugging and start point optimisations.
343Probably not useful except when debugging the regex engine itself.
344
345=item OFFSETS
346
347Dump offset information. This can be used to see how regops correlate
348to the pattern. Output format is
349
350 NODENUM:POSITION[LENGTH]
351
352Where 1 is the position of the first char in the string. Note that position
353can be 0, or larger than the actual length of the pattern, likewise length
354can be zero.
be8e71aa 355
24b23f37 356=item OFFSETSDBG
be8e71aa
YO
357
358Enable debugging of offsets information. This emits copious
fe759410 359amounts of trace information and doesn't mesh well with other
be8e71aa
YO
360debug options.
361
fe759410 362Almost definitely only useful to people hacking
be8e71aa
YO
363on the offsets part of the debug engine.
364
365=back
366
367=item Other useful flags
368
369These are useful shortcuts to save on the typing.
370
371=over 4
372
373=item ALL
374
375Enable all compile and execute options at once.
376
377=item All
378
fe759410 379Enable DUMP and all execute options. Equivalent to:
be8e71aa
YO
380
381 use re 'debug';
382
383=item MORE
384
385=item More
386
24b23f37 387Enable TRIEM and all execute compile and execute options.
be8e71aa 388
dba3f186 389=back
be8e71aa 390
dba3f186 391=back
a3621e74 392
1e2e3d02
YO
393As of 5.9.5 the directive C<use re 'debug'> and its equivalents are
394lexically scoped, as the other directives are. However they have both
395compile-time and run-time effects.
b3eb6a9b 396
de8c5301 397=head2 Exportable Functions
b3eb6a9b 398
de8c5301
YO
399As of perl 5.9.5 're' debug contains a number of utility functions that
400may be optionally exported into the callers namespace. They are listed
401below.
b3eb6a9b 402
de8c5301 403=over 4
b3eb6a9b 404
de8c5301 405=item is_regexp($ref)
02ea72ae 406
de8c5301
YO
407Returns true if the argument is a compiled regular expression as returned
408by C<qr//>, false if it is not.
02ea72ae 409
de8c5301
YO
410This function will not be confused by overloading or blessing. In
411internals terms this extracts the regexp pointer out of the
412PERL_MAGIC_qr structure so it it cannot be fooled.
894be9b7 413
de8c5301 414=item regexp_pattern($ref)
02ea72ae 415
de8c5301
YO
416If the argument is a compiled regular expression as returned by C<qr//>
417then this function returns the pattern.
be8e71aa 418
de8c5301
YO
419In list context it returns a two element list, the first element
420containing the pattern and the second containing the modifiers used when
421the pattern was compiled.
be8e71aa 422
de8c5301 423 my ($pat,$mods)=regexp_pattern($ref);
a3621e74 424
de8c5301
YO
425In scalar context it returns the same as perl would when strigifying a
426raw qr// with the same pattern inside. If the argument is not a
427compiled reference then this routine returns false but defined in scalar
428context, and the empty list in list context. Thus the following
f9f4320a 429
de8c5301 430 if (regexp_pattern($ref) eq '(?i-xsm:foo)')
dba3f186 431
de8c5301 432will be warning free regardless of what $ref actually is.
380e0b81 433
de8c5301
YO
434Like c<is_regexp> this function will not be confused by overloading
435or blessing of the object.
b3eb6a9b 436
de8c5301 437=back
b3eb6a9b 438
de8c5301 439=head1 SEE ALSO
b3eb6a9b 440
de8c5301
YO
441L<perlmodlib/Pragmatic Modules>.
442
443=cut