This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Add missing d_ctermid/HAS_CTERMID to Win32 canned configs
[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.
4ee9a43f 198 use re qw(Debug More);
fe759410 199 no re qw(Debug ALL); # Turn of all re debugging in this scope
4ee9a43f 200
de8c5301
YO
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.
a3621e74 207
3ffabb8c
GS
208(We use $^X in these examples because it's tainted by default.)
209
b3eb6a9b
GS
210=head1 DESCRIPTION
211
de8c5301
YO
212=head2 'taint' mode
213
b3eb6a9b
GS
214When C<use re 'taint'> is in effect, and a tainted string is the target
215of a regex, the regex memories (or values returned by the m// operator
e4d48cc9
GS
216in list context) are tainted. This feature is useful when regex operations
217on tainted data aren't meant to extract safe substrings, but to perform
218other transformations.
b3eb6a9b 219
de8c5301
YO
220=head2 'eval' mode
221
e4d48cc9 222When C<use re 'eval'> is in effect, a regex is allowed to contain
2cd61cdb 223C<(?{ ... })> zero-width assertions even if regular expression contains
ffbc6a93 224variable interpolation. That is normally disallowed, since it is a
2cd61cdb
IZ
225potential security risk. Note that this pragma is ignored when the regular
226expression is obtained from tainted data, i.e. evaluation is always
3c4b39be 227disallowed with tainted regular expressions. See L<perlre/(?{ code })>.
2cd61cdb 228
ffbc6a93 229For the purpose of this pragma, interpolation of precompiled regular
0a92e3a8
GS
230expressions (i.e., the result of C<qr//>) is I<not> considered variable
231interpolation. Thus:
2cd61cdb
IZ
232
233 /foo${pat}bar/
234
ffbc6a93 235I<is> allowed if $pat is a precompiled regular expression, even
2cd61cdb
IZ
236if $pat contains C<(?{ ... })> assertions.
237
de8c5301
YO
238=head2 'debug' mode
239
ffbc6a93 240When C<use re 'debug'> is in effect, perl emits debugging messages when
2cd61cdb
IZ
241compiling and using regular expressions. The output is the same as that
242obtained by running a C<-DDEBUGGING>-enabled perl interpreter with the
243B<-Dr> switch. It may be quite voluminous depending on the complexity
02ea72ae
IZ
244of the match. Using C<debugcolor> instead of C<debug> enables a
245form of output that can be used to get a colorful display on terminals
246that understand termcap color sequences. Set C<$ENV{PERL_RE_TC}> to a
247comma-separated list of C<termcap> properties to use for highlighting
ffbc6a93 248strings on/off, pre-point part on/off.
2cd61cdb
IZ
249See L<perldebug/"Debugging regular expressions"> for additional info.
250
de8c5301
YO
251As of 5.9.5 the directive C<use re 'debug'> and its equivalents are
252lexically scoped, as the other directives are. However they have both
253compile-time and run-time effects.
254
255See L<perlmodlib/Pragmatic Modules>.
256
257=head2 'Debug' mode
258
a3621e74
YO
259Similarly C<use re 'Debug'> produces debugging output, the difference
260being that it allows the fine tuning of what debugging output will be
be8e71aa
YO
261emitted. Options are divided into three groups, those related to
262compilation, those related to execution and those related to special
263purposes. The options are as follows:
264
265=over 4
266
267=item Compile related options
268
269=over 4
270
271=item COMPILE
272
273Turns on all compile related debug options.
274
275=item PARSE
276
277Turns on debug output related to the process of parsing the pattern.
278
279=item OPTIMISE
280
281Enables output related to the optimisation phase of compilation.
282
24b23f37 283=item TRIEC
be8e71aa
YO
284
285Detailed info about trie compilation.
286
287=item DUMP
288
289Dump the final program out after it is compiled and optimised.
290
be8e71aa
YO
291=back
292
293=item Execute related options
294
295=over 4
296
297=item EXECUTE
298
299Turns on all execute related debug options.
300
301=item MATCH
302
303Turns on debugging of the main matching loop.
304
24b23f37 305=item TRIEE
be8e71aa
YO
306
307Extra debugging of how tries execute.
308
309=item INTUIT
310
311Enable debugging of start point optimisations.
312
313=back
314
315=item Extra debugging options
316
317=over 4
318
319=item EXTRA
320
321Turns on all "extra" debugging options.
322
24b23f37
YO
323=item TRIEM
324
325Enable enhanced TRIE debugging. Enhances both TRIEE
326and TRIEC.
327
328=item STATE
329
4ee9a43f 330Enable debugging of states in the engine.
24b23f37
YO
331
332=item STACK
be8e71aa 333
24b23f37
YO
334Enable debugging of the recursion stack in the engine. Enabling
335or disabling this option automatically does the same for debugging
336states as well. This output from this can be quite large.
337
338=item OPTIMISEM
339
340Enable enhanced optimisation debugging and start point optimisations.
341Probably not useful except when debugging the regex engine itself.
342
343=item OFFSETS
344
345Dump offset information. This can be used to see how regops correlate
346to the pattern. Output format is
347
348 NODENUM:POSITION[LENGTH]
349
350Where 1 is the position of the first char in the string. Note that position
351can be 0, or larger than the actual length of the pattern, likewise length
352can be zero.
be8e71aa 353
24b23f37 354=item OFFSETSDBG
be8e71aa
YO
355
356Enable debugging of offsets information. This emits copious
fe759410 357amounts of trace information and doesn't mesh well with other
be8e71aa
YO
358debug options.
359
fe759410 360Almost definitely only useful to people hacking
be8e71aa
YO
361on the offsets part of the debug engine.
362
363=back
364
365=item Other useful flags
366
367These are useful shortcuts to save on the typing.
368
369=over 4
370
371=item ALL
372
373Enable all compile and execute options at once.
374
375=item All
376
fe759410 377Enable DUMP and all execute options. Equivalent to:
be8e71aa
YO
378
379 use re 'debug';
380
381=item MORE
382
383=item More
384
24b23f37 385Enable TRIEM and all execute compile and execute options.
be8e71aa 386
dba3f186 387=back
be8e71aa 388
dba3f186 389=back
a3621e74 390
1e2e3d02 391As of 5.9.5 the directive C<use re 'debug'> and its equivalents are
4ee9a43f 392lexically scoped, as the other directives are. However they have both
1e2e3d02 393compile-time and run-time effects.
b3eb6a9b 394
de8c5301 395=head2 Exportable Functions
b3eb6a9b 396
de8c5301 397As of perl 5.9.5 're' debug contains a number of utility functions that
4ee9a43f 398may be optionally exported into the caller's namespace. They are listed
de8c5301 399below.
b3eb6a9b 400
de8c5301 401=over 4
b3eb6a9b 402
de8c5301 403=item is_regexp($ref)
02ea72ae 404
de8c5301 405Returns true if the argument is a compiled regular expression as returned
4ee9a43f 406by C<qr//>, false if it is not.
02ea72ae 407
4ee9a43f
RGS
408This function will not be confused by overloading or blessing. In
409internals terms, this extracts the regexp pointer out of the
de8c5301 410PERL_MAGIC_qr structure so it it cannot be fooled.
894be9b7 411
de8c5301 412=item regexp_pattern($ref)
02ea72ae 413
4ee9a43f
RGS
414If the argument is a compiled regular expression as returned by C<qr//>,
415then this function returns the pattern.
be8e71aa 416
4ee9a43f
RGS
417In list context it returns a two element list, the first element
418containing the pattern and the second containing the modifiers used when
419the pattern was compiled.
be8e71aa 420
4ee9a43f 421 my ($pat, $mods) = regexp_pattern($ref);
a3621e74 422
4ee9a43f
RGS
423In scalar context it returns the same as perl would when strigifying a raw
424C<qr//> with the same pattern inside. If the argument is not a compiled
425reference then this routine returns false but defined in scalar context,
426and the empty list in list context. Thus the following
f9f4320a 427
de8c5301 428 if (regexp_pattern($ref) eq '(?i-xsm:foo)')
dba3f186 429
de8c5301 430will be warning free regardless of what $ref actually is.
380e0b81 431
4ee9a43f
RGS
432Like C<is_regexp> this function will not be confused by overloading
433or blessing of the object.
b3eb6a9b 434
de8c5301 435=back
b3eb6a9b 436
de8c5301 437=head1 SEE ALSO
b3eb6a9b 438
de8c5301
YO
439L<perlmodlib/Pragmatic Modules>.
440
441=cut