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;