# Debugger for Perl 5.00x; perl5db.pl patch level:
-$VERSION = 1.07;
+$VERSION = 1.13;
$header = "perl5db.pl version $VERSION";
#
##################################################################
# Enhanced by ilya@math.ohio-state.edu (Ilya Zakharevich)
-# Latest version available: ftp://ftp.math.ohio-state.edu/pub/users/ilya/perl
# modified Perl debugger, to be run from Emacs in perldb-mode
# Ray Lischner (uunet!mntgfx!lisch) as of 5 Nov 1990
# Some additional words on internal work of debugger.
# `b load filename' implemented.
# `b postpone subr' implemented.
-# now only `q' exits debugger (overwriteable on $inhibit_exit).
+# now only `q' exits debugger (overwritable on $inhibit_exit).
# When restarting debugger breakpoints/actions persist.
# Buglet: When restarting debugger only one breakpoint/action per
# autoloaded function persists.
# new `inhibitExit' option.
# printing of a very long statement interruptible.
# Changes: 0.98: New command `m' for printing possible methods
-# 'l -' is a synonim for `-'.
+# 'l -' is a synonym for `-'.
# Cosmetic bugs in printing stack trace.
# `frame' & 8 to print "expanded args" in stack trace.
# Can list/break in imported subs.
# when completing a subroutine name (same for `l').
# Changes: 1.07: Many fixed by tchrist 13-March-2000
# BUG FIXES:
-# + Added bare mimimal security checks on perldb rc files, plus
+# + Added bare minimal security checks on perldb rc files, plus
# comments on what else is needed.
# + Fixed the ornaments that made "|h" completely unusable.
# They are not used in print_help if they will hurt. Strip pod
# + Fixed mis-formatting of help messages caused by ornaments
# to restore Larry's original formatting.
# + Fixed many other formatting errors. The code is still suboptimal,
-# and needs a lot of work at restructuing. It's also misindented
+# and needs a lot of work at restructuring. It's also misindented
# in many places.
# + Fixed bug where trying to look at an option like your pager
# shows "1".
# or else not caring about detailed status. This should really be
# unified into one place, too.
# + Fixed bug where invisible trailing whitespace on commands hoses you,
-# tricking Perl into thinking you wern't calling a debugger command!
+# tricking Perl into thinking you weren't calling a debugger command!
# + Fixed bug where leading whitespace on commands hoses you. (One
# suggests a leading semicolon or any other irrelevant non-whitespace
# to indicate literal Perl code.)
# + Added to and rearranged the help information.
# + Detected apparent misuse of { ... } to declare a block; this used
# to work but now is a command, and mysteriously gave no complaint.
-
+#
+# Changes: 1.08: Apr 25, 2001 Jon Eveland <jweveland@yahoo.com>
+# BUG FIX:
+# + This patch to perl5db.pl cleans up formatting issues on the help
+# summary (h h) screen in the debugger. Mostly columnar alignment
+# issues, plus converted the printed text to use all spaces, since
+# tabs don't seem to help much here.
+#
+# Changes: 1.09: May 19, 2001 Ilya Zakharevich <ilya@math.ohio-state.edu>
+# 0) Minor bugs corrected;
+# a) Support for auto-creation of new TTY window on startup, either
+# unconditionally, or if started as a kid of another debugger session;
+# b) New `O'ption CreateTTY
+# I<CreateTTY> bits control attempts to create a new TTY on events:
+# 1: on fork() 2: debugger is started inside debugger
+# 4: on startup
+# c) Code to auto-create a new TTY window on OS/2 (currently one one
+# extra window per session - need named pipes to have more...);
+# d) Simplified interface for custom createTTY functions (with a backward
+# compatibility hack); now returns the TTY name to use; return of ''
+# means that the function reset the I/O handles itself;
+# d') Better message on the semantic of custom createTTY function;
+# e) Convert the existing code to create a TTY into a custom createTTY
+# function;
+# f) Consistent support for TTY names of the form "TTYin,TTYout";
+# g) Switch line-tracing output too to the created TTY window;
+# h) make `b fork' DWIM with CORE::GLOBAL::fork;
+# i) High-level debugger API cmd_*():
+# cmd_b_load($filenamepart) # b load filenamepart
+# cmd_b_line($lineno [, $cond]) # b lineno [cond]
+# cmd_b_sub($sub [, $cond]) # b sub [cond]
+# cmd_stop() # Control-C
+# cmd_d($lineno) # d lineno
+# The cmd_*() API returns FALSE on failure; in this case it outputs
+# the error message to the debugging output.
+# j) Low-level debugger API
+# break_on_load($filename) # b load filename
+# @files = report_break_on_load() # List files with load-breakpoints
+# breakable_line_in_filename($name, $from [, $to])
+# # First breakable line in the
+# # range $from .. $to. $to defaults
+# # to $from, and may be less than $to
+# breakable_line($from [, $to]) # Same for the current file
+# break_on_filename_line($name, $lineno [, $cond])
+# # Set breakpoint,$cond defaults to 1
+# break_on_filename_line_range($name, $from, $to [, $cond])
+# # As above, on the first
+# # breakable line in range
+# break_on_line($lineno [, $cond]) # As above, in the current file
+# break_subroutine($sub [, $cond]) # break on the first breakable line
+# ($name, $from, $to) = subroutine_filename_lines($sub)
+# # The range of lines of the text
+# The low-level API returns TRUE on success, and die()s on failure.
+#
+# Changes: 1.10: May 23, 2001 Daniel Lewart <d-lewart@uiuc.edu>
+# BUG FIXES:
+# + 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;
setman();
&recallCommand("!") unless defined $prc;
&shellBang("!") unless defined $psh;
+sethelp();
$maxtrace = 400 unless defined $maxtrace;
$ini_pids = $ENV{PERLDB_PIDS};
if (defined $ENV{PERLDB_PIDS}) {
$term_pid = $$;
}
$pidprompt = '';
-*emacs = $slave_editor; # May be used in afterinit()...
+*emacs = $slave_editor if $slave_editor; # May be used in afterinit()...
if (-e "/dev/tty") { # this is the wrong metric!
$rcfile=".perldb";
$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;
create_IN_OUT(4);
} else {
if (defined $console) {
- my ($i, $o) = split $console, /,/;
+ my ($i, $o) = split /,/, $console;
$o = $i unless defined $o;
open(IN,"+<$i") || open(IN,"<$i") || open(IN,"<&STDIN");
open(OUT,"+>$o") || open(OUT,">$o") || open(OUT,">&STDERR")
$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') {
"package $package;"; # this won't let them modify, alas
local(*dbline) = $main::{'_<' . $filename};
$max = $#dbline;
- if (($stop,$action) = split(/\0/,$dbline{$line})) {
+ if ($dbline{$line} && (($stop,$action) = split(/\0/,$dbline{$line}))) {
if ($stop eq '1') {
$signal |= 1;
} elsif ($stop) {
$i = $end;
} else {
for (; $i <= $end; $i++) {
- ($stop,$action) = split(/\0/, $dbline{$i});
+ my ($stop,$action);
+ ($stop,$action) = split(/\0/, $dbline{$i}) if
+ $dbline{$i};
$arrow = ($i==$line
and $filename eq $filename_ini)
? '==>'
delete $ENV{PERLDB_PIDS}; # Restore ini state
$ENV{PERLDB_PIDS} = $ini_pids if defined $ini_pids;
#print "$^X, '-d', @flags, @script, ($slave_editor ? '-emacs' : ()), @ARGS";
- exec $^X, '-d', @flags, @script, ($slave_editor ? '-emacs' : ()), @ARGS;
+ exec($^X, '-d', @flags, @script, ($slave_editor ? '-emacs' : ()), @ARGS) ||
print $OUT "exec failed: $!\n";
last CMD; };
$cmd =~ /^T$/ && do {
$file .= '.pm', redo unless $file =~ /\./;
}
break_on_load($_) for @files;
- my @files = report_break_on_load;
+ @files = report_break_on_load;
print $OUT "Will stop on load of `@files'.\n";
}
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}) { $dbline{$i} =~ s/^[^\0]*/$cond/; }
+ else { $dbline{$i} = $cond; }
}
sub cmd_b_line {
eval { &DB::save };
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;
}
(my $name = $0) =~ s,^.*[/\\],,s;
if ( pipe $in1, $out1 and pipe $in2, $out2 and
# system P_SESSION will fail if there is another process
- # in the same session with a "dependent" asyncroneous child session.
- (($kpid = system 4, $^X, '-we', <<'ES', fileno $in1, fileno $out2, "Daughter Perl debugger $pids $name") >= 0 or warn "system P_SESSION: $!, $^E" and 0) # P_SESSION
+ # in the same session with a "dependent" asynchronous child session.
+ (($kpid = CORE::system 4, $^X, '-we', <<'ES', fileno $in1, fileno $out2, "Daughter Perl debugger $pids $name") >= 0 or warn "system P_SESSION: $!, $^E" and 0) # P_SESSION
use Term::ReadKey;
use OS2::Process;
EOP
print_help(<<EOP) if $why == 2;
I<#########> Daughter session, do not know how to change a B<TTY>. I<#########>
- This may be an asyncroneous session, so the parent debugger may be active.
+ This may be an asynchronous session, so the parent debugger may be active.
EOP
print_help(<<EOP) if $why != 4;
Since two debuggers fight for the same TTY, input is severely entangled.
} 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) {
$psh = $sh;
$psh =~ s/\\b$//;
$psh =~ s/\\(.)/$1/g;
- &sethelp;
$psh;
}
$prc = $rc;
$prc =~ s/\\b$//;
$prc =~ s/\\(.)/$1/g;
- &sethelp;
$prc;
}
}
sub sethelp {
- # XXX: make sure these are tabs between the command and explantion,
+ # XXX: make sure there are tabs between the command and explanation,
# or print_help will screw up your formatting if you have
# eeevil ornaments enabled. This is an insane mess.
B<>>B<>> I<expr> Add to the list of Perl commands to run after each prompt.
B<{> I<db_command> Define debugger command to run before each prompt.
B<{> ? List debugger commands to run before each prompt.
-B<<> I<expr> Define Perl command to run before each prompt.
B<{{> I<db_command> Add to the list of debugger commands to run before each prompt.
B<$prc> I<number> Redo a previous command (default previous command).
B<$prc> I<-number> Redo number'th-to-last command.
B<v> Show versions of loaded modules.
B<R> Pure-man-restart of debugger, some of debugger state
and command-line options may be lost.
- Currently the following setting are preserved:
+ Currently the following settings are preserved:
history, breakpoints and actions, debugger B<O>ptions
and the following command-line options: I<-w>, I<-I>, I<-e>.
I<bareStringify> Do not print the overload-stringified value;
Other options include:
I<PrintRet> affects printing of return value after B<r> command,
- I<frame> affects printing messages on entry and exit from subroutines.
- I<AutoTrace> affects printing messages on every possible breaking point.
- I<maxTraceLen> gives maximal length of evals/args listed in stack trace.
+ I<frame> affects printing messages on subroutine entry/exit.
+ I<AutoTrace> affects printing messages on possible breaking points.
+ I<maxTraceLen> gives max length of evals/args listed in stack trace.
I<ornaments> affects screen appearance of the command line.
I<CreateTTY> bits control attempts to create a new TTY on events:
1: on fork() 2: debugger is started inside debugger
Type `|h' for a paged display if this was too hard to read.
-"; # Fix balance of vi % matching: } }}
+"; # Fix balance of vi % matching: }}}}
# note: tabs in the following section are not-so-helpful
$summary = <<"END_SUM";
# ornaments: A pox on both their houses!
#
# A help command will have everything up to and including
- # the first tab sequence paddeed into a field 16 (or if indented 20)
- # wide. If it's wide than that, an extra space will be added.
+ # the first tab sequence padded into a field 16 (or if indented 20)
+ # wide. If it's wider than that, an extra space will be added.
s{
^ # only matters at start of line
( \040{4} | \t )* # some subcommands are indented
my $clean = $command;
$clean =~ s/[BI]<([^>]*)>/$1/g;
# replace with this whole string:
- (length($leadwhite) ? " " x 4 : "")
+ ($leadwhite ? " " x 4 : "")
. $command
- . ((" " x (16 + (length($leadwhite) ? 4 : 0) - length($clean))) || " ")
+ . ((" " x (16 + ($leadwhite ? 4 : 0) - length($clean))) || " ")
. $text;
}mgex;
local $SIG{__DIE__} = '';
eval { require Carp } if defined $^S; # If error/warning during compilation,
# require may be broken.
- warn(@_, "\nCannot print stack trace, load with -MCarp option to see stack"),
+ CORE::warn(@_, "\nCannot print stack trace, load with -MCarp option to see stack"),
return unless defined &Carp::longmess;
my ($mysingle,$mytrace) = ($single,$trace);
$single = 0; $trace = 0;
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;
}
$warnLevel = shift;
if ($warnLevel) {
$SIG{__WARN__} = \&DB::dbwarn;
- } else {
+ } elsif ($prevwarn) {
$SIG{__WARN__} = $prevwarn;
}
}
( $dieLevel == 1 ? " outside of evals" : ""), ".\n"
if $I_m_init;
print $OUT "Dump printed too.\n" if $dieLevel > 2;
- } else {
+ } elsif ($prevdie) {
$SIG{__DIE__} = $prevdie;
print $OUT "Default die handler restored.\n";
}
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
}
my $oldpath = $ENV{MANPATH};
$ENV{MANPATH} = $manpath if $manpath;
my $nopathopt = $^O =~ /dunno what goes here/;
- if (system($doccmd,
+ if (CORE::system($doccmd,
# I just *know* there are men without -M
(($manpath && !$nopathopt) ? ("-M", $manpath) : ()),
split ' ', $page) )
})
{
$page =~ s/^/perl/;
- system($doccmd,
+ CORE::system($doccmd,
(($manpath && !$nopathopt) ? ("-M", $manpath) : ()),
$page);
}
BEGIN {$^W = $ini_warn;} # Switch warnings back
-#use Carp; # This did break, left for debuggin
+#use Carp; # This did break, left for debugging
sub db_complete {
# Specific code for b c l V m f O, &blah, $blah, @blah, %blah
https://perl5.git.perl.org / perl5.git / blobdiff