From: Gurusamy Sarathy <gsar@cpan.org>
Date: Sun, 19 Mar 2000 03:59:29 +0000 (+0000)
Subject: fixes for alias handling in debugger (from Tom Christiansen)
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=3dcd9d33ba0f5c25b8e7a1285e47073c4ec85071;p=p5sagit%2Fp5-mst-13.2.git

fixes for alias handling in debugger (from Tom Christiansen)

p4raw-id: //depot/perl@5814
---

diff --git a/lib/perl5db.pl b/lib/perl5db.pl
index 50844d2..23fcb1c 100644
--- a/lib/perl5db.pl
+++ b/lib/perl5db.pl
@@ -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 =~ /^\|/) {
@@ -1716,7 +1745,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;