File::Spec 0.82 beta

[p5sagit/p5-mst-13.2.git] / lib / perl5db.pl

diff --git a/lib/perl5db.pl b/lib/perl5db.pl
index 50844d2..41430ac 100644 (file)
--- a/lib/perl5db.pl
+++ b/lib/perl5db.pl
@@ -34,7 +34,7 @@ $header = "perl5db.pl version $VERSION";
 # interpreter, though the values used by perl5db.pl have the form
 # "$break_condition\0$action". Values are magical in numeric context.
 #
-# The scalar ${'_<'.$filename} contains "_<$filename".
+# The scalar ${'_<'.$filename} contains $filename.
 #
 # Note that no subroutine call is possible until &DB::sub is defined
 # (for subroutines defined outside of the package DB). In fact the same is
@@ -273,13 +273,13 @@ $inhibit_exit = $option{PrintRet} = 1;
                 );
 
 # These guys may be defined in $ENV{PERL5DB} :
-$rl = 1 unless defined $rl;
-$warnLevel = 1 unless defined $warnLevel;
-$dieLevel = 1 unless defined $dieLevel;
-$signalLevel = 1 unless defined $signalLevel;
-$pre = [] unless defined $pre;
-$post = [] unless defined $post;
-$pretype = [] unless defined $pretype;
+$rl            = 1     unless defined $rl;
+$warnLevel     = 0     unless defined $warnLevel;
+$dieLevel      = 0     unless defined $dieLevel;
+$signalLevel   = 1     unless defined $signalLevel;
+$pre           = []    unless defined $pre;
+$post          = []    unless defined $post;
+$pretype       = []    unless defined $pretype;
 
 warnLevel($warnLevel);
 dieLevel($dieLevel);
@@ -604,16 +604,19 @@ EOP
                $cmd =~ /^$/ && ($cmd = $laststep);
                push(@hist,$cmd) if length($cmd) > 1;
              PIPE: {
+                   $cmd =~ s/^\s+//s;   # trim annoying leading whitespace
+                   $cmd =~ s/\s+$//s;   # trim annoying trailing whitespace
                    ($i) = split(/\s+/,$cmd);
-                   #eval "\$cmd =~ $alias{$i}", print $OUT $@ if $alias{$i};
                    if ($alias{$i}) { 
-                       print STDERR "ALIAS $cmd INTO ";
+                       # squelch the sigmangler
+                       local $SIG{__DIE__};
+                       local $SIG{__WARN__};
                        eval "\$cmd =~ $alias{$i}";
-                       print "$cmd\n";
-                       print $OUT $@;
+                       if ($@) {
+                           print $OUT "Couldn't evaluate `$i' alias: $@";
+                           next CMD;
+                       } 
                    }
-                   $cmd =~ s/^\s+//s;   # trim annoying leading whitespace
-                   $cmd =~ s/\s+$//s;   # trim annoying trailing whitespace
                    $cmd =~ /^q$/ && ($exiting = 1) && exit 0;
                    $cmd =~ /^h$/ && do {
                        print_help($help);
@@ -1211,6 +1214,9 @@ EOP
                        $inpat = $1;
                        $inpat =~ s:([^\\])/$:$1:;
                        if ($inpat ne "") {
+                           # squelch the sigmangler
+                           local $SIG{__DIE__};
+                           local $SIG{__WARN__};
                            eval '$inpat =~ m'."\a$inpat\a";    
                            if ($@ ne "") {
                                print $OUT "$@";
@@ -1240,9 +1246,12 @@ EOP
                        $inpat = $1;
                        $inpat =~ s:([^\\])\?$:$1:;
                        if ($inpat ne "") {
+                           # squelch the sigmangler
+                           local $SIG{__DIE__};
+                           local $SIG{__WARN__};
                            eval '$inpat =~ m'."\a$inpat\a";    
                            if ($@ ne "") {
-                               print $OUT "$@";
+                               print $OUT $@;
                                next CMD;
                            }
                            $pat = $inpat;
@@ -1308,19 +1317,39 @@ EOP
                        next CMD; };
                    $cmd =~ s/^p$/print {\$DB::OUT} \$_/;
                    $cmd =~ s/^p\b/print {\$DB::OUT} /;
-                   $cmd =~ /^=/ && do {
-                       if (local($k,$v) = ($cmd =~ /^=\s*(\S+)\s+(.*)/)) {
-                           $alias{$k}="s~$k~$v~";
-                           print $OUT "$k = $v\n";
-                       } elsif ($cmd =~ /^=\s*$/) {
-                           foreach $k (sort keys(%alias)) {
-                               if (($v = $alias{$k}) =~ s~^s\~$k\~(.*)\~$~$1~) {
-                                   print $OUT "$k = $v\n";
-                               } else {
+                   $cmd =~ s/^=\s*// && do {
+                       my @keys;
+                       if (length $cmd == 0) {
+                           @keys = sort keys %alias;
+                       } 
+                        elsif (my($k,$v) = ($cmd =~ /^(\S+)\s+(\S.*)/)) {
+                           # can't use $_ or kill //g state
+                           for my $x ($k, $v) { $x =~ s/\a/\\a/g }
+                           $alias{$k} = "s\a$k\a$v\a";
+                           # squelch the sigmangler
+                           local $SIG{__DIE__};
+                           local $SIG{__WARN__};
+                           unless (eval "sub { s\a$k\a$v\a }; 1") {
+                               print $OUT "Can't alias $k to $v: $@\n"; 
+                               delete $alias{$k};
+                               next CMD;
+                           } 
+                           @keys = ($k);
+                       } 
+                       else {
+                           @keys = ($cmd);
+                       } 
+                       for my $k (@keys) {
+                           if ((my $v = $alias{$k}) =~ s\as\a$k\a(.*)\a$\a1\a) {
+                               print $OUT "$k\t= $1\n";
+                           } 
+                           elsif (defined $alias{$k}) {
                                    print $OUT "$k\t$alias{$k}\n";
-                               };
-                           };
-                       };
+                           } 
+                           else {
+                               print "No alias for $k\n";
+                           } 
+                       }
                        next CMD; };
                    $cmd =~ /^\|\|?\s*[^|]/ && do {
                        if ($pager =~ /^\|/) {
@@ -1669,8 +1698,6 @@ sub unbalanced {
 }
 
 sub gets {
-    local($.);
-    #<IN>;
     &readline("cont: ");
 }
 
@@ -1716,7 +1743,7 @@ sub setterm {
            $| = 1;
            select($sel);
        } else {
-           eval "require Term::Rendezvous;" or die $@;
+           eval "require Term::Rendezvous;" or die;
            my $rv = $ENV{PERLDB_NOTTY} || "/tmp/perldbtty$$";
            my $term_rv = new Term::Rendezvous $rv;
            $IN = $term_rv->IN;
@@ -1775,6 +1802,7 @@ EOP
 }
 
 sub readline {
+  local $.;
   if (@typeahead) {
     my $left = @typeahead;
     my $got = shift @typeahead;