Commit | Line | Data |
---|---|---|
b3eb6a9b GS |
1 | package re; |
2 | ||
56953603 IZ |
3 | $VERSION = 0.02; |
4 | ||
b3eb6a9b GS |
5 | =head1 NAME |
6 | ||
7 | re - Perl pragma to alter regular expression behaviour | |
8 | ||
9 | =head1 SYNOPSIS | |
10 | ||
e4d48cc9 GS |
11 | use re 'taint'; |
12 | ($x) = ($^X =~ /^(.*)$/s); # $x is tainted here | |
b3eb6a9b | 13 | |
e4d48cc9 GS |
14 | use re 'eval'; |
15 | /foo(?{ $foo = 1 })bar/; # won't fail (when not under -T switch) | |
16 | ||
17 | { | |
18 | no re 'taint'; # the default | |
19 | ($x) = ($^X =~ /^(.*)$/s); # $x is not tainted here | |
20 | ||
21 | no re 'eval'; # the default | |
22 | /foo(?{ $foo = 1 })bar/; # disallowed (with or without -T switch) | |
23 | } | |
b3eb6a9b GS |
24 | |
25 | =head1 DESCRIPTION | |
26 | ||
27 | When C<use re 'taint'> is in effect, and a tainted string is the target | |
28 | of a regex, the regex memories (or values returned by the m// operator | |
e4d48cc9 GS |
29 | in list context) are tainted. This feature is useful when regex operations |
30 | on tainted data aren't meant to extract safe substrings, but to perform | |
31 | other transformations. | |
b3eb6a9b | 32 | |
e4d48cc9 GS |
33 | When C<use re 'eval'> is in effect, a regex is allowed to contain |
34 | C<(?{ ... })> zero-width assertions (which may not be interpolated in | |
35 | the regex). That is normally disallowed, since it is a potential security | |
36 | risk. Note that this pragma is ignored when perl detects tainted data, | |
37 | i.e. evaluation is always disallowed with tainted data. See | |
38 | L<perlre/(?{ code })>. | |
b3eb6a9b GS |
39 | |
40 | See L<perlmodlib/Pragmatic Modules>. | |
41 | ||
42 | =cut | |
43 | ||
44 | my %bitmask = ( | |
e4d48cc9 GS |
45 | taint => 0x00100000, |
46 | eval => 0x00200000, | |
b3eb6a9b GS |
47 | ); |
48 | ||
49 | sub bits { | |
56953603 | 50 | my $on = shift; |
b3eb6a9b GS |
51 | my $bits = 0; |
52 | unless(@_) { | |
53 | require Carp; | |
54 | Carp::carp("Useless use of \"re\" pragma"); | |
55 | } | |
56953603 IZ |
56 | foreach my $s (@_){ |
57 | if ($s eq 'debug') { | |
58 | eval <<'EOE'; | |
59 | use DynaLoader; | |
60 | @ISA = ('DynaLoader'); | |
61 | bootstrap re; | |
62 | EOE | |
63 | install() if $on; | |
64 | uninstall() unless $on; | |
65 | next; | |
66 | } | |
67 | $bits |= $bitmask{$s} || 0; | |
68 | } | |
b3eb6a9b GS |
69 | $bits; |
70 | } | |
71 | ||
72 | sub import { | |
73 | shift; | |
56953603 | 74 | $^H |= bits(1,@_); |
b3eb6a9b GS |
75 | } |
76 | ||
77 | sub unimport { | |
78 | shift; | |
56953603 | 79 | $^H &= ~ bits(0,@_); |
b3eb6a9b GS |
80 | } |
81 | ||
82 | 1; |