X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2Fperl5db.pl;h=41430ac1885cd92eddd35da3127d98aaf61c917b;hb=3c32ced9076b91fe2c44bcada22c97a37d564b78;hp=50844d28f8e2fedaf2362ffd3a43250994566ed4;hpb=24eeb8341646e0edeebdd64b5f20fd4139f252ab;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/lib/perl5db.pl b/lib/perl5db.pl
index 50844d2..41430ac 100644
--- 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}) =~ ss\a$k\a(.*)\a$1) {
+				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;