# Debugger for Perl 5.00x; perl5db.pl patch level:
-$VERSION = 1.10;
+$VERSION = 1.14;
$header = "perl5db.pl version $VERSION";
#
# + Fixed warnings generated by "perl -dWe 42"
# + Corrected spelling errors
# + Squeezed Help (h) output into 80 columns
-
+#
+# Changes: 1.11: May 24, 2001 David Dyck <dcd@tc.fluke.com>
+# + Made "x @INC" work like it used to
+#
+# 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;
$console = undef;
}
+ if ($^O eq 'NetWare') {
+ $console = undef;
+ }
+
# Around a bug:
if (defined $ENV{OS2_SHELL} and ($slave_editor or $ENV{WINDOWID})) { # In OS/2
$console = undef;
$OUT = \*OUT;
}
- select($OUT);
+ my $previous = select($OUT);
$| = 1; # for DB::OUT
- select(STDOUT);
+ select($previous);
$LINEINFO = $OUT unless defined $LINEINFO;
$lineinfo = $console unless defined $lineinfo;
- $| = 1; # for real STDOUT
-
$header =~ s/.Header: ([^,]+),v(\s+\S+\s+\S+).*$/$1$2/;
unless ($runnonstop) {
if ($term_pid eq '-1') {
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");
my $pl = '';
die "Line $i$filename_error not breakable.\n" if $dbline[$i] == 0;
$had_breakpoints{$filename} |= 1;
- $dbline{$i} =~ s/^[^\0]*/$cond/ if $dbline{$i};
+ if ($dbline{$i}) { $dbline{$i} =~ s/^[^\0]*/$cond/; }
+ else { $dbline{$i} = $cond; }
}
sub cmd_b_line {
my $at = $@;
local $saved[0]; # Preserve the old value of $@
eval { &DB::save };
- if (defined($at)) {
+ if ($at) {
print $OUT $at;
- } elsif ($onetimeDump eq 'dump') {
- dumpit($OUT, \@res);
- } elsif ($onetimeDump eq 'methods') {
- methods($res[0]);
+ } elsif ($onetimeDump) {
+ dumpit($OUT, \@res) if $onetimeDump eq 'dump';
+ methods($res[0]) if $onetimeDump eq 'methods';
}
@res;
}
}
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;
} else {
$val = $option{$opt};
}
+ $val = $default unless defined $val;
$val
}
# 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;
}
sub CvGV_name_or_bust {
my $in = shift;
return if $skipCvGV; # Backdoor to avoid problems if XS broken...
+ return unless ref $in;
$in = \&$in; # Hard reference...
eval {require Devel::Peek; 1} or return;
my $gv = Devel::Peek::CvGV($in) or return;
}
sub setman {
- $doccmd = $^O !~ /^(?:MSWin32|VMS|os2|dos|amigaos|riscos|MacOS)\z/s
+ $doccmd = $^O !~ /^(?:MSWin32|VMS|os2|dos|amigaos|riscos|MacOS|NetWare)\z/s
? "man" # O Happy Day!
: "perldoc"; # Alas, poor unfortunates
}
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;
https://perl5.git.perl.org / perl5.git / blobdiff