develooper Front page | perl.perl5.porters | Postings from March 2000

Fix for debugger alias bug

From:
Tom Christiansen
Date:
March 14, 2000 17:38
Subject:
Fix for debugger alias bug
Message ID:
4141.953084325@chthon
This is against the large patch.  Yes, it has ^G's in it.
And yes, there was detritus lying about that got cleaned up.
I hope that someone who uses aliases more can test this.

--tom

--- perl5db.pl-postpatch	Mon Mar 13 20:05:43 2000
+++ perl5db.pl	Tue Mar 14 18:36:12 2000
@@ -606,16 +606,19 @@
 		$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);
@@ -1213,6 +1216,9 @@
 			$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 "$@";
@@ -1242,9 +1248,12 @@
 			$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;
@@ -1310,19 +1319,39 @@
 			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 =~ /^\|/) {
@@ -1718,7 +1747,7 @@
 	    $| = 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;



nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About