xref: /openbsd-src/gnu/usr.bin/perl/ext/re/re.pm (revision b2ea75c1b17e1a9a339660e7ed45cd24946b230e)
1package re;
2
3$VERSION = 0.02;
4
5=head1 NAME
6
7re - Perl pragma to alter regular expression behaviour
8
9=head1 SYNOPSIS
10
11    use re 'taint';
12    ($x) = ($^X =~ /^(.*)$/s);     # $x is tainted here
13
14    $pat = '(?{ $foo = 1 })';
15    use re 'eval';
16    /foo${pat}bar/;		   # won't fail (when not under -T switch)
17
18    {
19	no re 'taint';		   # the default
20	($x) = ($^X =~ /^(.*)$/s); # $x is not tainted here
21
22	no re 'eval';		   # the default
23	/foo${pat}bar/;		   # disallowed (with or without -T switch)
24    }
25
26    use re 'debug';		   # NOT lexically scoped (as others are)
27    /^(.*)$/s;			   # output debugging info during
28    				   #     compile and run time
29
30    use re 'debugcolor';	   # same as 'debug', but with colored output
31    ...
32
33(We use $^X in these examples because it's tainted by default.)
34
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
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.
42
43When C<use re 'eval'> is in effect, a regex is allowed to contain
44C<(?{ ... })> zero-width assertions even if regular expression contains
45variable interpolation.  That is normally disallowed, since it is a
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
50For the purpose of this pragma, interpolation of precompiled regular
51expressions (i.e., the result of C<qr//>) is I<not> considered variable
52interpolation.  Thus:
53
54    /foo${pat}bar/
55
56I<is> allowed if $pat is a precompiled regular expression, even
57if $pat contains C<(?{ ... })> assertions.
58
59When C<use re 'debug'> is in effect, perl emits debugging messages when
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
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
67strings on/off, pre-point part on/off.
68See L<perldebug/"Debugging regular expressions"> for additional info.
69
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.
72
73See L<perlmodlib/Pragmatic Modules>.
74
75=cut
76
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.
79my %bitmask = (
80taint	=> 0x00100000,
81eval	=> 0x00200000,
82);
83
84sub setcolor {
85 eval {				# Ignore errors
86  require Term::Cap;
87
88  my $terminal = Tgetent Term::Cap ({OSPEED => 9600}); # Avoid warning.
89  my $props = $ENV{PERL_RE_TC} || 'md,me,so,se,us,ue';
90  my @props = split /,/, $props;
91  my $colors = join "\t", map {$terminal->Tputs($_,1)} @props;
92
93  $colors =~ s/\0//g;
94  $ENV{PERL_RE_COLORS} = $colors;
95 };
96}
97
98sub bits {
99    my $on = shift;
100    my $bits = 0;
101    unless(@_) {
102	require Carp;
103	Carp::carp("Useless use of \"re\" pragma");
104    }
105    foreach my $s (@_){
106      if ($s eq 'debug' or $s eq 'debugcolor') {
107 	  setcolor() if $s eq 'debugcolor';
108	  require XSLoader;
109	  XSLoader::load('re');
110	  install() if $on;
111	  uninstall() unless $on;
112	  next;
113      }
114      $bits |= $bitmask{$s} || 0;
115    }
116    $bits;
117}
118
119sub import {
120    shift;
121    $^H |= bits(1,@_);
122}
123
124sub unimport {
125    shift;
126    $^H &= ~ bits(0,@_);
127}
128
1291;
130