# Debugger for Perl 5.00x; perl5db.pl patch level:
-$VERSION = 1.12;
+$VERSION = 1.14;
$header = "perl5db.pl version $VERSION";
#
# Changes: 1.12: May 24, 2001 Daniel Lewart <d-lewart@uiuc.edu>
# + Fixed warnings generated by "O" (Show debugger options)
# + Fixed warnings generated by "p 42" (Print expression)
-
+# Changes: 1.13: Jun 19, 2001 Scott.L.Miller@compaq.com
+# + Added windowSize option
####################################################################
# Needed for the statement after exec():
recallCommand ShellBang pager tkRunning ornaments
signalLevel warnLevel dieLevel inhibit_exit
ImmediateStop bareStringify CreateTTY
- RemotePort);
+ RemotePort windowSize);
%optionVars = (
hashDepth => \$dumpvar::hashDepth,
maxTraceLen => \$maxtrace,
ImmediateStop => \$ImmediateStop,
RemotePort => \$remoteport,
+ windowSize => \$window,
);
%optionAction = (
# These guys may be defined in $ENV{PERL5DB} :
$rl = 1 unless defined $rl;
-$warnLevel = 0 unless defined $warnLevel;
-$dieLevel = 0 unless defined $dieLevel;
+$warnLevel = 1 unless defined $warnLevel;
+$dieLevel = 1 unless defined $dieLevel;
$signalLevel = 1 unless defined $signalLevel;
$pre = [] unless defined $pre;
$post = [] unless defined $post;
next CMD;
}
}
- $cmd =~ /^q$/ && ($fall_off_end = 1) && exit $?;
+ $cmd =~ /^q$/ && ($fall_off_end = 1) && clean_ENV() && exit $?;
$cmd =~ /^h$/ && do {
print_help($help);
next CMD; };
$i = $end;
} else {
for (; $i <= $end; $i++) {
+ my ($stop,$action);
($stop,$action) = split(/\0/, $dbline{$i}) if
$dbline{$i};
$arrow = ($i==$line
*dbline = $main::{'_<' . $file};
next unless %dbline or $postponed_file{$file};
(push @hard, $file), next
- if $file =~ /^\(eval \d+\)$/;
+ if $file =~ /^\(\w*eval/;
my @add;
@add = %{$postponed_file{$file}}
if $postponed_file{$file};
}
}
next CMD; };
+ $cmd =~ /^\@\s*(.*\S)/ && do {
+ if (open my $fh, $1) {
+ push @cmdfhs, $fh;
+ }
+ else {
+ &warn("Can't execute `$1': $!\n");
+ }
+ next CMD; };
$cmd =~ /^\|\|?\s*[^|]/ && do {
if ($pager =~ /^\|/) {
open(SAVEOUT,">&STDOUT") || &warn("Can't save STDOUT");
}
local $frame = 0;
local $doret = -2;
+ while (@cmdfhs) {
+ my $line = CORE::readline($cmdfhs[-1]);
+ defined $line ? (print $OUT ">> $line" and return $line)
+ : close pop @cmdfhs;
+ }
if (ref $OUT and UNIVERSAL::isa($OUT, 'IO::Socket::INET')) {
$OUT->write(join('', @_));
my $stuff;
# too dangerous to let intuitive usage overwrite important things
# defaultion should never be the default
my %opt_needs_val = map { ( $_ => 1 ) } qw{
- arrayDepth hashDepth LineInfo maxTraceLen ornaments
+ arrayDepth hashDepth LineInfo maxTraceLen ornaments windowSize
pager quote ReadLine recallCommand RemotePort ShellBang TTY
};
while (length) {
. ( $rc eq $sh ? "" : "
B<$psh> [I<cmd>] Run I<cmd> in subshell (forces \"\$SHELL -c 'cmd'\")." ) . "
See 'B<O> I<shellBang>' too.
+B<@>I<file> Execute I<file> containing debugger commands (may nest).
B<H> I<-number> Display last number commands (default all).
B<p> I<expr> Same as \"I<print {DB::OUT} expr>\" in current package.
B<|>I<dbcmd> Run debugger command, piping DB::OUT to current pager.
if ($dieLevel < 2) {
die @_ if $^S; # in eval propagate
}
- eval { require Carp } if defined $^S; # If error/warning during compilation,
+ # No need to check $^S, eval is much more robust nowadays
+ eval { require Carp }; #if defined $^S;# If error/warning during compilation,
# require may be broken.
die(@_, "\nCannot print stack trace, load with -MCarp option to see stack")
# inside DB::DB, but not in Carp).
my ($mysingle,$mytrace) = ($single,$trace);
$single = 0; $trace = 0;
- my $mess = Carp::longmess(@_);
+ my $mess = "@_";
+ {
+ package Carp; # Do not include us in the list
+ eval {
+ $mess = Carp::longmess(@_);
+ };
+ }
($single,$trace) = ($mysingle,$mytrace);
die $mess;
}
print $OUT "Use `q' to quit or `R' to restart. `h q' for details.\n"
}
+sub clean_ENV {
+ if (defined($ini_pids)) {
+ $ENV{PERLDB_PIDS} = $ini_pids;
+ } else {
+ delete($ENV{PERLDB_PIDS});
+ }
+}
+
END {
$finished = 1 if $inhibit_exit; # So that some keys may be disabled.
$fall_off_end = 1 unless $inhibit_exit;