fix up B modules for PL_* changes

[p5sagit/p5-mst-13.2.git] / ext / re / re.pm

diff --git a/ext/re/re.pm b/ext/re/re.pm
index a033d97..7cea77d 100644 (file)
--- a/ext/re/re.pm
+++ b/ext/re/re.pm
@@ -23,9 +23,14 @@ re - Perl pragma to alter regular expression behaviour
        /foo${pat}bar/;            # disallowed (with or without -T switch)
     }
 
-    use re 'debug';
-    /^(.*)$/s;                    # output debugging info 
-                                  # during compile and run time
+    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
 
@@ -42,23 +47,28 @@ 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 expresssions.  See L<perlre/(?{ code })>.
 
-For the purpose of this pragma, interpolation of preexisting regular 
-expressions is I<not> considered a variable interpolation, thus
+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 preexisting regular expressions, even 
+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.
+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.
 
-I<The directive C<use re 'debug'> is not lexically scoped.>  It has 
-both compile-time and run-time effects.
+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>.
 
@@ -69,6 +79,23 @@ taint        => 0x00100000,
 eval   => 0x00200000,
 );
 
+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'; # can use us/ue later
+  my @props = split /,/, $props;
+
+
+  $ENV{TERMCAP_COLORS} = join "\t", map {$terminal->Tputs($_,1)} @props;
+ };
+
+ 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 {
     my $on = shift;
     my $bits = 0;
@@ -77,12 +104,11 @@ sub bits {
        Carp::carp("Useless use of \"re\" pragma");
     }
     foreach my $s (@_){
-      if ($s eq 'debug') {
-         eval <<'EOE';
-           use DynaLoader;
-           @ISA = ('DynaLoader');
-           bootstrap re;
-EOE
+      if ($s eq 'debug' or $s eq 'debugcolor') {
+         setcolor() if $s eq 'debugcolor';
+         require DynaLoader;
+         @ISA = ('DynaLoader');
+         bootstrap re;
          install() if $on;
          uninstall() unless $on;
          next;