Socket::my_inet_aton() tweak
[p5sagit/p5-mst-13.2.git] / ext / re / re.pm
CommitLineData
b3eb6a9b 1package re;
2
d6a466d7 3our $VERSION = 0.03;
56953603 4
b3eb6a9b 5=head1 NAME
6
7re - Perl pragma to alter regular expression behaviour
8
9=head1 SYNOPSIS
10
e4d48cc9 11 use re 'taint';
12 ($x) = ($^X =~ /^(.*)$/s); # $x is tainted here
b3eb6a9b 13
2cd61cdb 14 $pat = '(?{ $foo = 1 })';
e4d48cc9 15 use re 'eval';
2cd61cdb 16 /foo${pat}bar/; # won't fail (when not under -T switch)
e4d48cc9 17
18 {
19 no re 'taint'; # the default
20 ($x) = ($^X =~ /^(.*)$/s); # $x is not tainted here
21
22 no re 'eval'; # the default
2cd61cdb 23 /foo${pat}bar/; # disallowed (with or without -T switch)
e4d48cc9 24 }
b3eb6a9b 25
0a92e3a8 26 use re 'debug'; # NOT lexically scoped (as others are)
27 /^(.*)$/s; # output debugging info during
28 # compile and run time
2cd61cdb 29
02ea72ae 30 use re 'debugcolor'; # same as 'debug', but with colored output
31 ...
32
3ffabb8c 33(We use $^X in these examples because it's tainted by default.)
34
b3eb6a9b 35=head1 DESCRIPTION
36
37When C<use re 'taint'> is in effect, and a tainted string is the target
38of a regex, the regex memories (or values returned by the m// operator
e4d48cc9 39in list context) are tainted. This feature is useful when regex operations
40on tainted data aren't meant to extract safe substrings, but to perform
41other transformations.
b3eb6a9b 42
e4d48cc9 43When C<use re 'eval'> is in effect, a regex is allowed to contain
2cd61cdb 44C<(?{ ... })> zero-width assertions even if regular expression contains
ffbc6a93 45variable interpolation. That is normally disallowed, since it is a
2cd61cdb 46potential security risk. Note that this pragma is ignored when the regular
47expression is obtained from tainted data, i.e. evaluation is always
48disallowed with tainted regular expresssions. See L<perlre/(?{ code })>.
49
ffbc6a93 50For the purpose of this pragma, interpolation of precompiled regular
0a92e3a8 51expressions (i.e., the result of C<qr//>) is I<not> considered variable
52interpolation. Thus:
2cd61cdb 53
54 /foo${pat}bar/
55
ffbc6a93 56I<is> allowed if $pat is a precompiled regular expression, even
2cd61cdb 57if $pat contains C<(?{ ... })> assertions.
58
ffbc6a93 59When C<use re 'debug'> is in effect, perl emits debugging messages when
2cd61cdb 60compiling and using regular expressions. The output is the same as that
61obtained by running a C<-DDEBUGGING>-enabled perl interpreter with the
62B<-Dr> switch. It may be quite voluminous depending on the complexity
02ea72ae 63of the match. Using C<debugcolor> instead of C<debug> enables a
64form of output that can be used to get a colorful display on terminals
65that understand termcap color sequences. Set C<$ENV{PERL_RE_TC}> to a
66comma-separated list of C<termcap> properties to use for highlighting
ffbc6a93 67strings on/off, pre-point part on/off.
2cd61cdb 68See L<perldebug/"Debugging regular expressions"> for additional info.
69
0a92e3a8 70The directive C<use re 'debug'> is I<not lexically scoped>, as the
71other directives are. It has both compile-time and run-time effects.
b3eb6a9b 72
73See L<perlmodlib/Pragmatic Modules>.
74
75=cut
76
918c0b2d 77# N.B. File::Basename contains a literal for 'taint' as a fallback. If
78# taint is changed here, File::Basename must be updated as well.
b3eb6a9b 79my %bitmask = (
ffbc6a93 80taint => 0x00100000,
81eval => 0x00200000,
b3eb6a9b 82);
83
02ea72ae 84sub setcolor {
85 eval { # Ignore errors
86 require Term::Cap;
87
88 my $terminal = Tgetent Term::Cap ({OSPEED => 9600}); # Avoid warning.
8d300b32 89 my $props = $ENV{PERL_RE_TC} || 'md,me,so,se,us,ue';
02ea72ae 90 my @props = split /,/, $props;
c712d376 91 my $colors = join "\t", map {$terminal->Tputs($_,1)} @props;
02ea72ae 92
c712d376 93 $colors =~ s/\0//g;
94 $ENV{PERL_RE_COLORS} = $colors;
02ea72ae 95 };
02ea72ae 96}
97
b3eb6a9b 98sub bits {
56953603 99 my $on = shift;
b3eb6a9b 100 my $bits = 0;
2570cdf1 101 unless (@_) {
b3eb6a9b 102 require Carp;
103 Carp::carp("Useless use of \"re\" pragma");
104 }
56953603 105 foreach my $s (@_){
02ea72ae 106 if ($s eq 'debug' or $s eq 'debugcolor') {
107 setcolor() if $s eq 'debugcolor';
9426adcd 108 require XSLoader;
109 XSLoader::load('re');
56953603 110 install() if $on;
111 uninstall() unless $on;
112 next;
113 }
2570cdf1 114 if (exists $bitmask{$s}) {
115 $bits |= $bitmask{$s};
116 } else {
117 require Carp;
118 Carp::carp("Unknown \"re\" subpragma '$s' (known ones are: @{[join(', ', map {qq('$_')} sort keys %bitmask)]})");
119 }
56953603 120 }
b3eb6a9b 121 $bits;
122}
123
124sub import {
125 shift;
2570cdf1 126 $^H |= bits(1, @_);
b3eb6a9b 127}
128
129sub unimport {
130 shift;
2570cdf1 131 $^H &= ~ bits(0, @_);
b3eb6a9b 132}
133
1341;