ext/re/re.pm

   1 package re;
   2
   3 $VERSION = 0.02;
   4
   5 =head1 NAME
   6
   7 re - 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     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     }
  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
  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.
  32
  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 })>.
  39
  40 See L<perlmodlib/Pragmatic Modules>.
  41
  42 =cut
  43
  44 my %bitmask = (
  45 taint   => 0x00100000,
  46 eval    => 0x00200000,
  47 );
  48
  49 sub bits {
  50     my $on = shift;
  51     my $bits = 0;
  52     unless(@_) {
  53         require Carp;
  54         Carp::carp("Useless use of \"re\" pragma");
  55     }
  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     }
  69     $bits;
  70 }
  71
  72 sub import {
  73     shift;
  74     $^H |= bits(1,@_);
  75 }
  76
  77 sub unimport {
  78     shift;
  79     $^H &= ~ bits(0,@_);
  80 }
  81
  82 1;