diff options
Diffstat (limited to 'gnu/usr.bin/perl/ext/re/re.pm')
| -rw-r--r-- | gnu/usr.bin/perl/ext/re/re.pm | 24 |
1 files changed, 11 insertions, 13 deletions
diff --git a/gnu/usr.bin/perl/ext/re/re.pm b/gnu/usr.bin/perl/ext/re/re.pm index 83e7dbafe56..3f142d9de48 100644 --- a/gnu/usr.bin/perl/ext/re/re.pm +++ b/gnu/usr.bin/perl/ext/re/re.pm @@ -41,11 +41,11 @@ 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 the regex contains -variable interpolation. This is normally disallowed, since it is a +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 })>. +disallowed with tainted regular expresssions. 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 @@ -74,6 +74,8 @@ 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, eval => 0x00200000, @@ -84,16 +86,13 @@ sub setcolor { require Term::Cap; my $terminal = Tgetent Term::Cap ({OSPEED => 9600}); # Avoid warning. - my $props = $ENV{PERL_RE_TC} || 'md,me,so,se'; # can use us/ue later + 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; - - $ENV{TERMCAP_COLORS} = join "\t", map {$terminal->Tputs($_,1)} @props; + $colors =~ s/\0//g; + $ENV{PERL_RE_COLORS} = $colors; }; - - not defined $ENV{TERMCAP_COLORS} or ($ENV{TERMCAP_COLORS} =~ tr/\t/\t/) >= 4 - or not defined $ENV{PERL_RE_TC} - or die "Not enough fields in \$ENV{PERL_RE_TC}=`$ENV{PERL_RE_TC}'"; } sub bits { @@ -106,9 +105,8 @@ sub bits { foreach my $s (@_){ if ($s eq 'debug' or $s eq 'debugcolor') { setcolor() if $s eq 'debugcolor'; - require DynaLoader; - @ISA = ('DynaLoader'); - bootstrap re; + require XSLoader; + XSLoader::load('re'); install() if $on; uninstall() unless $on; next; |