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