diff options
Diffstat (limited to 'Master/tlpkg/installer/perllib/re.pm')
| -rw-r--r-- | Master/tlpkg/installer/perllib/re.pm | 134 |
1 files changed, 0 insertions, 134 deletions
diff --git a/Master/tlpkg/installer/perllib/re.pm b/Master/tlpkg/installer/perllib/re.pm deleted file mode 100644 index 6e9d1218ef0..00000000000 --- a/Master/tlpkg/installer/perllib/re.pm +++ /dev/null @@ -1,134 +0,0 @@ -package re; - -our $VERSION = 0.05; - -=head1 NAME - -re - Perl pragma to alter regular expression behaviour - -=head1 SYNOPSIS - - use re 'taint'; - ($x) = ($^X =~ /^(.*)$/s); # $x is tainted here - - $pat = '(?{ $foo = 1 })'; - use re 'eval'; - /foo${pat}bar/; # won't fail (when not under -T switch) - - { - no re 'taint'; # the default - ($x) = ($^X =~ /^(.*)$/s); # $x is not tainted here - - no re 'eval'; # the default - /foo${pat}bar/; # disallowed (with or without -T switch) - } - - use re 'debug'; # NOT lexically scoped (as others are) - /^(.*)$/s; # output debugging info during - # compile and run time - - use re 'debugcolor'; # same as 'debug', but with colored output - ... - -(We use $^X in these examples because it's tainted by default.) - -=head1 DESCRIPTION - -When C<use re 'taint'> is in effect, and a tainted string is the target -of a regex, the regex memories (or values returned by the m// operator -in list context) are tainted. This feature is useful when regex operations -on tainted data aren't meant to extract safe substrings, but to perform -other transformations. - -When C<use re 'eval'> is in effect, a regex is allowed to contain -C<(?{ ... })> zero-width assertions even if regular expression contains -variable interpolation. That is normally disallowed, since it is a -potential security risk. Note that this pragma is ignored when the regular -expression is obtained from tainted data, i.e. evaluation is always -disallowed with tainted regular expressions. See L<perlre/(?{ code })>. - -For the purpose of this pragma, interpolation of precompiled regular -expressions (i.e., the result of C<qr//>) is I<not> considered variable -interpolation. Thus: - - /foo${pat}bar/ - -I<is> allowed if $pat is a precompiled regular expression, even -if $pat contains C<(?{ ... })> assertions. - -When C<use re 'debug'> is in effect, perl emits debugging messages when -compiling and using regular expressions. The output is the same as that -obtained by running a C<-DDEBUGGING>-enabled perl interpreter with the -B<-Dr> switch. It may be quite voluminous depending on the complexity -of the match. Using C<debugcolor> instead of C<debug> enables a -form of output that can be used to get a colorful display on terminals -that understand termcap color sequences. Set C<$ENV{PERL_RE_TC}> to a -comma-separated list of C<termcap> properties to use for highlighting -strings on/off, pre-point part on/off. -See L<perldebug/"Debugging regular expressions"> for additional info. - -The directive C<use re 'debug'> is I<not lexically scoped>, as the -other directives are. It has both compile-time and run-time effects. - -See L<perlmodlib/Pragmatic Modules>. - -=cut - -# N.B. File::Basename contains a literal for 'taint' as a fallback. If -# taint is changed here, File::Basename must be updated as well. -my %bitmask = ( -taint => 0x00100000, # HINT_RE_TAINT -eval => 0x00200000, # HINT_RE_EVAL -); - -sub setcolor { - eval { # Ignore errors - require Term::Cap; - - my $terminal = Tgetent Term::Cap ({OSPEED => 9600}); # Avoid warning. - my $props = $ENV{PERL_RE_TC} || 'md,me,so,se,us,ue'; - my @props = split /,/, $props; - my $colors = join "\t", map {$terminal->Tputs($_,1)} @props; - - $colors =~ s/\0//g; - $ENV{PERL_RE_COLORS} = $colors; - }; -} - -sub bits { - my $on = shift; - my $bits = 0; - unless (@_) { - require Carp; - Carp::carp("Useless use of \"re\" pragma"); - } - foreach my $s (@_){ - if ($s eq 'debug' or $s eq 'debugcolor') { - setcolor() if $s eq 'debugcolor'; - require XSLoader; - XSLoader::load('re'); - install() if $on; - uninstall() unless $on; - next; - } - if (exists $bitmask{$s}) { - $bits |= $bitmask{$s}; - } else { - require Carp; - Carp::carp("Unknown \"re\" subpragma '$s' (known ones are: @{[join(', ', map {qq('$_')} 'debug', 'debugcolor', sort keys %bitmask)]})"); - } - } - $bits; -} - -sub import { - shift; - $^H |= bits(1, @_); -} - -sub unimport { - shift; - $^H &= ~ bits(0, @_); -} - -1; |