C<perl5db.pl> is the perl debugger. It is loaded automatically by Perl when
you invoke a script with C<perl -d>. This documentation tries to outline the
structure and services provided by C<perl5db.pl>, and to describe how you
can use them.
=head1 GENERAL NOTES
The debugger can look pretty forbidding to many Perl programmers. There are
a number of reasons for this, many stemming out of the debugger's history.
When the debugger was first written, Perl didn't have a lot of its nicer
features - no references, no lexical variables, no closures, no object-oriented
programming. So a lot of the things one would normally have done using such
features was done using global variables, globs and the C<local()> operator
in creative ways.
Some of these have survived into the current debugger; a few of the more
interesting and still-useful idioms are noted in this section, along with notes
on the comments themselves.
=head2 Why not use more lexicals?
Experienced Perl programmers will note that the debugger code tends to use
mostly package globals rather than lexically-scoped variables. This is done
to allow a significant amount of control of the debugger from outside the
debugger itself.
Unfortunately, though the variables are accessible, they're not well
documented, so it's generally been a decision that hasn't made a lot of
difference to most users. Where appropriate, comments have been added to
make variables more accessible and usable, with the understanding that these
i<are> debugger internals, and are therefore subject to change. Future
development should probably attempt to replace the globals with a well-defined
API, but for now, the variables are what we've got.
=head2 Automated variable stacking via C<local()>
As you may recall from reading C<perlfunc>, the C<local()> operator makes a
temporary copy of a variable in the current scope. When the scope ends, the
old copy is restored. This is often used in the debugger to handle the
automatic stacking of variables during recursive calls:
sub foo {
local $some_global++;
# Do some stuff, then ...
return;
}
What happens is that on entry to the subroutine, C<$some_global> is localized,
then altered. When the subroutine returns, Perl automatically undoes the
localization, restoring the previous value. Voila, automatic stack management.
The debugger uses this trick a I<lot>. Of particular note is C<DB::eval>,
which lets the debugger get control inside of C<eval>'ed code. The debugger
localizes a saved copy of C<$@> inside the subroutine, which allows it to
keep C<$@> safe until it C<DB::eval> returns, at which point the previous
value of C<$@> is restored. This makes it simple (well, I<simpler>) to keep
track of C<$@> inside C<eval>s which C<eval> other C<eval's>.
In any case, watch for this pattern. It occurs fairly often.
=head2 The C<^> trick
This is used to cleverly reverse the sense of a logical test depending on
the value of an auxiliary variable. For instance, the debugger's C<S>
(search for subroutines by pattern) allows you to negate the pattern
like this:
# Find all non-'foo' subs:
S !/foo/
Boolean algebra states that the truth table for XOR looks like this:
=over 4
=item * 0 ^ 0 = 0
(! not present and no match) --> false, don't print
=item * 0 ^ 1 = 1
(! not present and matches) --> true, print
=item * 1 ^ 0 = 1
(! present and no match) --> true, print
=item * 1 ^ 1 = 0
(! present and matches) --> false, don't print
=back
As you can see, the first pair applies when C<!> isn't supplied, and
the second pair applies when it isn't. The XOR simply allows us to
compact a more complicated if-then-elseif-else into a more elegant
(but perhaps overly clever) single test. After all, it needed this
explanation...
=head2 FLAGS, FLAGS, FLAGS
There is a certain C programming legacy in the debugger. Some variables,
such as C<$single>, C<$trace>, and C<$frame>, have "magical" values composed
of 1, 2, 4, etc. (powers of 2) OR'ed together. This allows several pieces
of state to be stored independently in a single scalar.
A test like
if ($scalar & 4) ...
is checking to see if the appropriate bit is on. Since each bit can be
"addressed" independently in this way, C<$scalar> is acting sort of like
an array of bits. Obviously, since the contents of C<$scalar> are just a
bit-pattern, we can save and restore it easily (it will just look like
a number).
The problem, is of course, that this tends to leave magic numbers scattered
all over your program whenever a bit is set, cleared, or checked. So why do
it?
=over 4
=item * First, doing an arithmetical or bitwise operation on a scalar is
just about the fastest thing you can do in Perl: C<use constant> actually
creates a subroutine call, and array hand hash lookups are much slower. Is
this over-optimization at the expense of readability? Possibly, but the
debugger accesses these variables a I<lot>. Any rewrite of the code will
probably have to benchmark alternate implementations and see which is the
best balance of readability and speed, and then document how it actually
works.
=item * Second, it's very easy to serialize a scalar number. This is done in
the restart code; the debugger state variables are saved in C<%ENV> and then
restored when the debugger is restarted. Having them be just numbers makes
this trivial.
=item * Third, some of these variables are being shared with the Perl core
smack in the middle of the interpreter's execution loop. It's much faster for
a C program (like the interpreter) to check a bit in a scalar than to access
several different variables (or a Perl array).
=back
=head2 What are those C<XXX> comments for?
Any comment containing C<XXX> means that the comment is either somewhat
speculative - it's not exactly clear what a given variable or chunk of
code is doing, or that it is incomplete - the basics may be clear, but the
subtleties are not completely documented.
Send in a patch if you can clear up, fill out, or clarify an C<XXX>.
=head1 DATA STRUCTURES MAINTAINED BY CORE
There are a number of special data structures provided to the debugger by
the Perl interpreter.
The array C<@{$main::{'_<'.$filename}}> (aliased locally to C<@dbline> via glob
assignment) contains the text from C<$filename>, with each element
corresponding to a single line of C<$filename>.
The hash C<%{'_<'.$filename}> (aliased locally to C<%dbline> via glob
assignment) contains breakpoints and actions. The keys are line numbers;
you can set individual values, but not the whole hash. The Perl interpreter
uses this hash to determine where breakpoints have been set. Any true value is
considered to be a breakpoint; C<perl5db.pl> uses "$break_condition\0$action".
Values are magical in numeric context: 1 if the line is breakable, 0 if not.
The scalar ${'_<'.$filename} contains $filename XXX What?
=head1 DEBUGGER STARTUP
When C<perl5db.pl> starts, it reads an rcfile (C<perl5db.ini> for
non-interactive sessions, C<.perldb> for interactive ones) that can set a number
of options. In addition, this file may define a subroutine C<&afterinit>
that will be executed (in the debugger's context) after the debugger has
initialized itself.
Next, it checks the C<PERLDB_OPTS> environment variable and treats its
contents as the argument of a debugger <C<o> command.
=head2 STARTUP-ONLY OPTIONS
The following options can only be specified at startup.
To set them in your rcfile, add a call to
C<&parse_options("optionName=new_value")>.
=over 4
=item * TTY
the TTY to use for debugging i/o.
=item * noTTY
if set, goes in NonStop mode. On interrupt, if TTY is not set,
uses the value of noTTY or "/tmp/perldbtty$$" to find TTY using
Term::Rendezvous. Current variant is to have the name of TTY in this
file.
=item * ReadLine
If false, a dummy ReadLine is used, so you can debug
ReadLine applications.
=item * NonStop
if true, no i/o is performed until interrupt.
=item * LineInfo
file or pipe to print line number info to. If it is a
pipe, a short "emacs like" message is used.
=item * RemotePort
host:port to connect to on remote host for remote debugging.
=back
=head3 SAMPLE RCFILE
&parse_options("NonStop=1 LineInfo=db.out");
sub afterinit { $trace = 1; }
The script will run without human intervention, putting trace
information into C<db.out>. (If you interrupt it, you had better
reset C<LineInfo> to something "interactive"!)
=head1 INTERNALS DESCRIPTION
=head2 DEBUGGER INTERFACE VARIABLES
Perl supplies the values for C<%sub>. It effectively inserts
a C<&DB'DB();> in front of each place that can have a
breakpoint. At each subroutine call, it calls C<&DB::sub> with
C<$DB::sub> set to the called subroutine. It also inserts a C<BEGIN
{require 'perl5db.pl'}> before the first line.
After each C<require>d file is compiled, but before it is executed, a
call to C<&DB::postponed($main::{'_<'.$filename})> is done. C<$filename>
is the expanded name of the C<require>d file (as found via C<%INC>).
=head3 IMPORTANT INTERNAL VARIABLES
=head4 C<$CreateTTY>
Used to control when the debugger will attempt to acquire another TTY to be
used for input.
=over
=item * 1 - on C<fork()>
=item * 2 - debugger is started inside debugger
=item * 4 - on startup
=back
=head4 C<$doret>
The value -2 indicates that no return value should be printed.
Any other positive value causes C<DB::sub> to print return values.
=head4 C<$evalarg>
The item to be eval'ed by C<DB::eval>. Used to prevent messing with the current
contents of C<@_> when C<DB::eval> is called.
=head4 C<$frame>
Determines what messages (if any) will get printed when a subroutine (or eval)
is entered or exited.
=over 4
=item * 0 - No enter/exit messages
=item * 1 - Print "entering" messages on subroutine entry
=item * 2 - Adds exit messages on subroutine exit. If no other flag is on, acts like 1+2.
=item * 4 - Extended messages: C<in|out> I<context>=I<fully-qualified sub name> from I<file>:I<line>>. If no other flag is on, acts like 1+4.
=item * 8 - Adds parameter information to messages, and overloaded stringify and tied FETCH is enabled on the printed arguments. Ignored if C<4> is not on.
=item * 16 - Adds C<I<context> return from I<subname>: I<value>> messages on subroutine/eval exit. Ignored if C<4> is is not on.
=back
To get everything, use C<$frame=30> (or C<o f-30> as a debugger command).
The debugger internally juggles the value of C<$frame> during execution to
protect external modules that the debugger uses from getting traced.
=head4 C<$level>
Tracks current debugger nesting level. Used to figure out how many
C<E<lt>E<gt>> pairs to surround the line number with when the debugger
outputs a prompt. Also used to help determine if the program has finished
during command parsing.
=head4 C<$onetimeDump>
Controls what (if anything) C<DB::eval()> will print after evaluating an
expression.
=over 4
=item * C<undef> - don't print anything
=item * C<dump> - use C<dumpvar.pl> to display the value returned
=item * C<methods> - print the methods callable on the first item returned
=back
=head4 C<$onetimeDumpDepth>
Controls how far down C<dumpvar.pl> will go before printing '...' while
dumping a structure. Numeric. If C<undef>, print all levels.
=head4 C<$signal>
Used to track whether or not an C<INT> signal has been detected. C<DB::DB()>,
which is called before every statement, checks this and puts the user into
command mode if it finds C<$signal> set to a true value.
=head4 C<$single>
Controls behavior during single-stepping. Stacked in C<@stack> on entry to
each subroutine; popped again at the end of each subroutine.
=over 4
=item * 0 - run continuously.
=item * 1 - single-step, go into subs. The 's' command.
=item * 2 - single-step, don't go into subs. The 'n' command.
=item * 4 - print current sub depth (turned on to force this when "too much
recursion" occurs.
=back
=head4 C<$trace>
Controls the output of trace information.
=over 4
=item * 1 - The C<t> command was entered to turn on tracing (every line executed is printed)
=item * 2 - watch expressions are active
=item * 4 - user defined a C<watchfunction()> in C<afterinit()>
=back
=head4 C<$slave_editor>
1 if C<LINEINFO> was directed to a pipe; 0 otherwise.
=head4 C<@cmdfhs>
Stack of filehandles that C<DB::readline()> will read commands from.
Manipulated by the debugger's C<source> command and C<DB::readline()> itself.
=head4 C<@dbline>
Local alias to the magical line array, C<@{$main::{'_<'.$filename}}> ,
supplied by the Perl interpreter to the debugger. Contains the source.
=head4 C<@old_watch>
Previous values of watch expressions. First set when the expression is
entered; reset whenever the watch expression changes.
=head4 C<@saved>
Saves important globals (C<$@>, C<$!>, C<$^E>, C<$,>, C<$/>, C<$\>, C<$^W>)
so that the debugger can substitute safe values while it's running, and
restore them when it returns control.
=head4 C<@stack>
Saves the current value of C<$single> on entry to a subroutine.
Manipulated by the C<c> command to turn off tracing in all subs above the
current one.
=head4 C<@to_watch>
The 'watch' expressions: to be evaluated before each line is executed.
=head4 C<@typeahead>
The typeahead buffer, used by C<DB::readline>.
=head4 C<%alias>
Command aliases. Stored as character strings to be substituted for a command
entered.
=head4 C<%break_on_load>
Keys are file names, values are 1 (break when this file is loaded) or undef
(don't break when it is loaded).
=head4 C<%dbline>
Keys are line numbers, values are "condition\0action". If used in numeric
context, values are 0 if not breakable, 1 if breakable, no matter what is
in the actual hash entry.
=head4 C<%had_breakpoints>
Keys are file names; values are bitfields:
=over 4
=item * 1 - file has a breakpoint in it.
=item * 2 - file has an action in it.
=back
A zero or undefined value means this file has neither.
=head4 C<%option>
Stores the debugger options. These are character string values.
=head4 C<%postponed>
Saves breakpoints for code that hasn't been compiled yet.
Keys are subroutine names, values are:
=over 4
=item * 'compile' - break when this sub is compiled
=item * 'break +0 if <condition>' - break (conditionally) at the start of this routine. The condition will be '1' if no condition was specified.
=back
=head4 C<%postponed_file>
This hash keeps track of breakpoints that need to be set for files that have
not yet been compiled. Keys are filenames; values are references to hashes.
Each of these hashes is keyed by line number, and its values are breakpoint
definitions ("condition\0action").
=head1 DEBUGGER INITIALIZATION
The debugger's initialization actually jumps all over the place inside this
package. This is because there are several BEGIN blocks (which of course
execute immediately) spread through the code. Why is that?
The debugger needs to be able to change some things and set some things up
before the debugger code is compiled; most notably, the C<$deep> variable that
C<DB::sub> uses to tell when a program has recursed deeply. In addition, the
debugger has to turn off warnings while the debugger code is compiled, but then
restore them to their original setting before the program being debugged begins
executing.
The first C<BEGIN> block simply turns off warnings by saving the current
setting of C<$^W> and then setting it to zero. The second one initializes
the debugger variables that are needed before the debugger begins executing.
The third one puts C<$^X> back to its former value.
We'll detail the second C<BEGIN> block later; just remember that if you need
to initialize something before the debugger starts really executing, that's
where it has to go.
=cut
package DB;
use IO::Handle;
# Debugger for Perl 5.00x; perl5db.pl patch level:
$VERSION = 1.25;
$header = "perl5db.pl version $VERSION";
=head1 DEBUGGER ROUTINES
=head2 C<DB::eval()>
This function replaces straight C<eval()> inside the debugger; it simplifies
the process of evaluating code in the user's context.
The code to be evaluated is passed via the package global variable
C<$DB::evalarg>; this is done to avoid fiddling with the contents of C<@_>.
We preserve the current settings of X<C<$trace>>, X<C<$single>>, and X<C<$^D>>;
add the X<C<$usercontext>> (that's the preserved values of C<$@>, C<$!>,
C<$^E>, C<$,>, C<$/>, C<$\>, and C<$^W>, grabbed when C<DB::DB> got control,
and the user's current package) and a add a newline before we do the C<eval()>.
This causes the proper context to be used when the eval is actually done.
Afterward, we restore C<$trace>, C<$single>, and C<$^D>.
Next we need to handle C<$@> without getting confused. We save C<$@> in a
local lexical, localize C<$saved[0]> (which is where C<save()> will put
C<$@>), and then call C<save()> to capture C<$@>, C<$!>, C<$^E>, C<$,>,
C<$/>, C<$\>, and C<$^W>) and set C<$,>, C<$/>, C<$\>, and C<$^W> to values
considered sane by the debugger. If there was an C<eval()> error, we print
it on the debugger's output. If X<C<$onetimedump>> is defined, we call
X<C<dumpit>> if it's set to 'dump', or X<C<methods>> if it's set to
'methods'. Setting it to something else causes the debugger to do the eval
but not print the result - handy if you want to do something else with it
(the "watch expressions" code does this to get the value of the watch
expression but not show it unless it matters).
In any case, we then return the list of output from C<eval> to the caller,
and unwinding restores the former version of C<$@> in C<@saved> as well
(the localization of C<$saved[0]> goes away at the end of this scope).
=head3 Parameters and variables influencing execution of DB::eval()
C<DB::eval> isn't parameterized in the standard way; this is to keep the
debugger's calls to C<DB::eval()> from mucking with C<@_>, among other things.
The variables listed below influence C<DB::eval()>'s execution directly.
=over 4
=item C<$evalarg> - the thing to actually be eval'ed
=item C<$trace> - Current state of execution tracing (see X<$trace>)
=item C<$single> - Current state of single-stepping (see X<$single>)
=item C<$onetimeDump> - what is to be displayed after the evaluation
=item C<$onetimeDumpDepth> - how deep C<dumpit()> should go when dumping results
=back
The following variables are altered by C<DB::eval()> during its execution. They
are "stacked" via C<local()>, enabling recursive calls to C<DB::eval()>.
=over 4
=item C<@res> - used to capture output from actual C<eval>.
=item C<$otrace> - saved value of C<$trace>.
=item C<$osingle> - saved value of C<$single>.
=item C<$od> - saved value of C<$^D>.
=item C<$saved[0]> - saved value of C<$@>.
=item $\ - for output of C<$@> if there is an evaluation error.
=back
=head3 The problem of lexicals
The context of C<DB::eval()> presents us with some problems. Obviously,
we want to be 'sandboxed' away from the debugger's internals when we do
the eval, but we need some way to control how punctuation variables and
debugger globals are used.
We can't use local, because the code inside C<DB::eval> can see localized
variables; and we can't use C<my> either for the same reason. The code
in this routine compromises and uses C<my>.
After this routine is over, we don't have user code executing in the debugger's
context, so we can use C<my> freely.
=cut
############################################## Begin lexical danger zone
# 'my' variables used here could leak into (that is, be visible in)
# the context that the code being evaluated is executing in. This means that
# the code could modify the debugger's variables.
#
# Fiddling with the debugger's context could be Bad. We insulate things as
# much as we can.
sub eval {
# 'my' would make it visible from user code
# but so does local! --tchrist
# Remember: this localizes @DB::res, not @main::res.
local @res;
{
# Try to keep the user code from messing with us. Save these so that
# even if the eval'ed code changes them, we can put them back again.
# Needed because the user could refer directly to the debugger's
# package globals (and any 'my' variables in this containing scope)
# inside the eval(), and we want to try to stay safe.
local $otrace = $trace;
local $osingle = $single;
local $od = $^D;
# Untaint the incoming eval() argument.
{ ($evalarg) = $evalarg =~ /(.*)/s; }
# $usercontext built in DB::DB near the comment
# "set up the context for DB::eval ..."
# Evaluate and save any results.
@res =
eval "$usercontext $evalarg;\n"; # '\n' for nice recursive debug
# Restore those old values.
$trace = $otrace;
$single = $osingle;
$^D = $od;
}
# Save the current value of $@, and preserve it in the debugger's copy
# of the saved precious globals.
my $at = $@;
# Since we're only saving $@, we only have to localize the array element
# that it will be stored in.
local $saved[0]; # Preserve the old value of $@
eval { &DB::save };
# Now see whether we need to report an error back to the user.
if ($at) {
local $\ = '';
print $OUT $at;
}
# Display as required by the caller. $onetimeDump and $onetimedumpDepth
# are package globals.
elsif ($onetimeDump) {
if ($onetimeDump eq 'dump') {
local $option{dumpDepth} = $onetimedumpDepth
if defined $onetimedumpDepth;
dumpit($OUT, \@res);
}
elsif ($onetimeDump eq 'methods') {
methods($res[0]);
}
} ## end elsif ($onetimeDump)
@res;
} ## end sub eval
############################################## End lexical danger zone
# After this point it is safe to introduce lexicals.
# The code being debugged will be executing in its own context, and
# can't see the inside of the debugger.
#
# However, one should not overdo it: leave as much control from outside as
# possible. If you make something a lexical, it's not going to be addressable
# from outside the debugger even if you know its name.
# This file is automatically included if you do perl -d.
# It's probably not useful to include this yourself.
#
# Before venturing further into these twisty passages, it is
# wise to read the perldebguts man page or risk the ire of dragons.
#
# (It should be noted that perldebguts will tell you a lot about
# the underlying mechanics of how the debugger interfaces into the
# Perl interpreter, but not a lot about the debugger itself. The new
# comments in this code try to address this problem.)
# Note that no subroutine call is possible until &DB::sub is defined
# (for subroutines defined outside of the package DB). In fact the same is
# true if $deep is not defined.
#
# $Log: perldb.pl,v $
# Enhanced by ilya@math.ohio-state.edu (Ilya Zakharevich)
# modified Perl debugger, to be run from Emacs in perldb-mode
# Ray Lischner (uunet!mntgfx!lisch) as of 5 Nov 1990
# Johan Vromans -- upgrade to 4.0 pl 10
# Ilya Zakharevich -- patches after 5.001 (and some before ;-)
# (We have made efforts to clarify the comments in the change log
# in other places; some of them may seem somewhat obscure as they
# were originally written, and explaining them away from the code
Now, we'll decide how the debugger is going to interact with the user.
If there's no TTY, we set the debugger to run non-stop; there's not going
to be anyone there to enter commands.
=cut
if ($notty) {
$runnonstop = 1;
}
=pod
If there is a TTY, we have to determine who it belongs to before we can
proceed. If this is a slave editor or graphical debugger (denoted by
the first command-line switch being '-emacs'), we shift this off and
set C<$rl> to 0 (XXX ostensibly to do straight reads).
=cut
else {
# Is Perl being run from a slave editor or graphical debugger?
# If so, don't use readline, and set $slave_editor = 1.
$slave_editor =
((defined $main::ARGV[0]) and ($main::ARGV[0] eq '-emacs'));
$rl = 0, shift (@main::ARGV) if $slave_editor;
#require Term::ReadLine;
=pod
We then determine what the console should be on various systems:
=over 4
=item * Cygwin - We use C<stdin> instead of a separate device.
=cut
if ($^O eq 'cygwin') {
# /dev/tty is binary. use stdin for textmode
undef $console;
}
=item * Unix - use C</dev/tty>.
=cut
elsif (-e "/dev/tty") {
$console = "/dev/tty";
}
=item * Windows or MSDOS - use C<con>.
=cut
elsif ($^O eq 'dos' or -e "con" or $^O eq 'MSWin32') {
$console = "con";
}
=item * MacOS - use C<Dev:Console:Perl Debug> if this is the MPW version; C<Dev:
Console> if not. (Note that Mac OS X returns 'darwin', not 'MacOS'. Also note that the debugger doesn't do anything special for 'darwin'. Maybe it should.)
=cut
elsif ($^O eq 'MacOS') {
if ($MacPerl::Version !~ /MPW/) {
$console =
"Dev:Console:Perl Debug"; # Separate window for application
}
else {
$console = "Dev:Console";
}
} ## end elsif ($^O eq 'MacOS')
=item * VMS - use C<sys$command>.
=cut
else {
# everything else is ...
$console = "sys\$command";
}
=pod
=back
Several other systems don't use a specific console. We C<undef $console>
for those (Windows using a slave editor/graphical debugger, NetWare, OS/2
with a slave editor, Epoc).
=cut
if (($^O eq 'MSWin32') and ($slave_editor or defined $ENV{EMACS})) {
# /dev/tty is binary. use stdin for textmode
$console = undef;
}
if ($^O eq 'NetWare') {
# /dev/tty is binary. use stdin for textmode
$console = undef;
}
# In OS/2, we need to use STDIN to get textmode too, even though
# it pretty much looks like Unix otherwise.
if (defined $ENV{OS2_SHELL} and ($slave_editor or $ENV{WINDOWID}))
{ # In OS/2
$console = undef;
}
# EPOC also falls into the 'got to use STDIN' camp.
if ($^O eq 'epoc') {
$console = undef;
}
=pod
If there is a TTY hanging around from a parent, we use that as the console.
=cut
$console = $tty if defined $tty;
=head2 SOCKET HANDLING
The debugger is capable of opening a socket and carrying out a debugging
session over the socket.
If C<RemotePort> was defined in the options, the debugger assumes that it
should try to start a debugging session on that port. It builds the socket
and then tries to connect the input and output filehandles to it.
=cut
# Handle socket stuff.
if (defined $remoteport) {
# If RemotePort was defined in the options, connect input and output
# to the socket.
require IO::Socket;
$OUT = new IO::Socket::INET(
Timeout => '10',
PeerAddr => $remoteport,
Proto => 'tcp',
);
if (!$OUT) { die "Unable to connect to remote host: $remoteport\n"; }
$IN = $OUT;
} ## end if (defined $remoteport)
=pod
If no C<RemotePort> was defined, and we want to create a TTY on startup,
this is probably a situation where multiple debuggers are running (for example,
a backticked command that starts up another debugger). We create a new IN and
OUT filehandle, and do the necessary mojo to create a new TTY if we know how
and if we can.
=cut
# Non-socket.
else {
# Two debuggers running (probably a system or a backtick that invokes
# the debugger itself under the running one). create a new IN and OUT
# filehandle, and do the necessary mojo to create a new tty if we
# know how, and we can.
create_IN_OUT(4) if $CreateTTY & 4;
if ($console) {
# If we have a console, check to see if there are separate ins and
# outs to open. (They are assumed identiical if not.)
my ($i, $o) = split /,/, $console;
$o = $i unless defined $o;
# read/write on in, or just read, or read on STDIN.
open(IN, "+<$i") ||
open(IN, "<$i") ||
open(IN, "<&STDIN");
# read/write/create/clobber out, or write/create/clobber out,
# or merge with STDERR, or merge with STDOUT.
open(OUT, "+>$o") ||
open(OUT, ">$o") ||
open(OUT, ">&STDERR") ||
open(OUT, ">&STDOUT"); # so we don't dongle stdout
} ## end if ($console)
elsif (not defined $console) {
# No console. Open STDIN.
open(IN, "<&STDIN");
# merge with STDERR, or with STDOUT.
open(OUT, ">&STDERR") ||
open(OUT, ">&STDOUT"); # so we don't dongle stdout
$console = 'STDIN/OUT';
} ## end elsif (not defined $console)
# Keep copies of the filehandles so that when the pager runs, it
# can close standard input without clobbering ours.
$IN = \*IN, $OUT = \*OUT if $console or not defined $console;
} ## end elsif (from if(defined $remoteport))
# Unbuffer DB::OUT. We need to see responses right away.
my $previous = select($OUT);
$| = 1; # for DB::OUT
select($previous);
# Line info goes to debugger output unless pointed elsewhere.
# Pointing elsewhere makes it possible for slave editors to
# keep track of file and position. We have both a filehandle
# and a I/O description to keep track of.
$LINEINFO = $OUT unless defined $LINEINFO;
$lineinfo = $console unless defined $lineinfo;
=pod
To finish initialization, we show the debugger greeting,
and then call the C<afterinit()> subroutine if there is one.
# Capture the line. If none, it's the current line.
$line = $1 || $dbline;
# If there's no condition, make it '1'.
$cond = length $2 ? $2 : '1';
# Break on line.
&cmd_b_line($line, $cond);
}
# Line didn't make sense.
else {
print "confused by line($line)?\n";
}
} ## end sub cmd_b
=head3 C<break_on_load> (API)
We want to break when this file is loaded. Mark this file in the
C<%break_on_load> hash, and note that it has a breakpoint in
C<%had_breakpoints>.
=cut
sub break_on_load {
my $file = shift;
$break_on_load{$file} = 1;
$had_breakpoints{$file} |= 1;
}
=head3 C<report_break_on_load> (API)
Gives us an array of filenames that are set to break on load. Note that
only files with break-on-load are in here, so simply showing the keys
suffices.
=cut
sub report_break_on_load {
sort keys %break_on_load;
}
=head3 C<cmd_b_load> (command)
We take the file passed in and try to find it in C<%INC> (which maps modules
to files they came from). We mark those files for break-on-load via
C<break_on_load> and then report that it was done.
=cut
sub cmd_b_load {
my $file = shift;
my @files;
# This is a block because that way we can use a redo inside it
# even without there being any looping structure at all outside it.
{
# Save short name and full path if found.
push @files, $file;
push @files, $::INC{$file} if $::INC{$file};
# Tack on .pm and do it again unless there was a '.' in the name
# already.
$file .= '.pm', redo unless $file =~ /\./;
}
# Do the real work here.
break_on_load($_) for @files;
# All the files that have break-on-load breakpoints.
@files = report_break_on_load;
# Normalize for the purposes of our printing this.
local $\ = '';
local $" = ' ';
print $OUT "Will stop on load of `@files'.\n";
} ## end sub cmd_b_load
=head3 C<$filename_error> (API package global)
Several of the functions we need to implement in the API need to work both
on the current file and on other files. We don't want to duplicate code, so
C<$filename_error> is used to contain the name of the file that's being
worked on (if it's not the current one).
We can now build functions in pairs: the basic function works on the current
file, and uses C<$filename_error> as part of its error message. Since this is
initialized to C<''>, no filename will appear when we are working on the
current file.
The second function is a wrapper which does the following:
=over 4
=item * Localizes C<$filename_error> and sets it to the name of the file to be processed.
=item * Localizes the C<*dbline> glob and reassigns it to point to the file we want to process.
=item * Calls the first function.
The first function works on the "current" (i.e., the one we changed to) file,
and prints C<$filename_error> in the error message (the name of the other file)
if it needs to. When the functions return, C<*dbline> is restored to point to the actual current file (the one we're executing in) and C<$filename_error> is
restored to C<''>. This restores everything to the way it was before the
second function was called at all.
See the comments in C<breakable_line> and C<breakable_line_in_file> for more
details.
=back
=cut
$filename_error = '';
=head3 breakable_line($from, $to) (API)
The subroutine decides whether or not a line in the current file is breakable.
It walks through C<@dbline> within the range of lines specified, looking for
the first line that is breakable.
If C<$to> is greater than C<$from>, the search moves forwards, finding the
first line I<after> C<$to> that's breakable, if there is one.
If C<$from> is greater than C<$to>, the search goes I<backwards>, finding the
first line I<before> C<$to> that's breakable, if there is one.
=cut
sub breakable_line {
my ($from, $to) = @_;
# $i is the start point. (Where are the FORTRAN programs of yesteryear?)
my $i = $from;
# If there are at least 2 arguments, we're trying to search a range.
if (@_ >= 2) {
# $delta is positive for a forward search, negative for a backward one.
my $delta = $from < $to ? +1 : -1;
# Keep us from running off the ends of the file.
my $limit = $delta > 0 ? $#dbline : 1;
# Clever test. If you're a mathematician, it's obvious why this
# test works. If not:
# If $delta is positive (going forward), $limit will be $#dbline.
# If $to is less than $limit, ($limit - $to) will be positive, times
# $delta of 1 (positive), so the result is > 0 and we should use $to
# as the stopping point.
#
# If $to is greater than $limit, ($limit - $to) is negative,
# times $delta of 1 (positive), so the result is < 0 and we should
# use $limit ($#dbline) as the stopping point.
#
# If $delta is negative (going backward), $limit will be 1.
# If $to is zero, ($limit - $to) will be 1, times $delta of -1
# (negative) so the result is > 0, and we use $to as the stopping
# point.
#
# If $to is less than zero, ($limit - $to) will be positive,
# times $delta of -1 (negative), so the result is not > 0, and
# we use $limit (1) as the stopping point.
#
# If $to is 1, ($limit - $to) will zero, times $delta of -1
# (negative), still giving zero; the result is not > 0, and
# we use $limit (1) as the stopping point.
#
# if $to is >1, ($limit - $to) will be negative, times $delta of -1
# (negative), giving a positive (>0) value, so we'll set $limit to
# $to.
$limit = $to if ($limit - $to) * $delta > 0;
# The real search loop.
# $i starts at $from (the point we want to start searching from).
# We move through @dbline in the appropriate direction (determined
# by $delta: either -1 (back) or +1 (ahead).
# We stay in as long as we haven't hit an executable line
# ($dbline[$i] == 0 means not executable) and we haven't reached
# the limit yet (test similar to the above).
$i += $delta while $dbline[$i] == 0 and ($limit - $i) * $delta > 0;
} ## end if (@_ >= 2)
# If $i points to a line that is executable, return that.
return $i unless $dbline[$i] == 0;
# Format the message and print it: no breakable lines in range.
my ($pl, $upto) = ('', '');
($pl, $upto) = ('s', "..$to") if @_ >= 2 and $from != $to;
# If there's a filename in filename_error, we'll see it.
# If not, not.
die "Line$pl $from$upto$filename_error not breakable\n";
# If the package has a $VERSION package global (as all good packages
# should!) decode it and save as partial message.
if (defined ${ $_ . '::VERSION' }) {
$version{$file} = "${ $_ . '::VERSION' } from ";
}
# Finish up the message with the file the package came from.
$version{$file} .= $INC{$file};
} ## end for (keys %INC)
# Hey, dumpit() formats a hash nicely, so why not use it?
dumpit($OUT, \%version);
} ## end sub list_modules
=head2 C<sethelp()>
Sets up the monster string used to format and print the help.
=head3 HELP MESSAGE FORMAT
The help message is a peculiar format unto itself; it mixes C<pod> 'ornaments'
(BE<lt>E<gt>, IE<gt>E<lt>) with tabs to come up with a format that's fairly
easy to parse and portable, but which still allows the help to be a little
nicer than just plain text.
Essentially, you define the command name (usually marked up with BE<gt>E<lt>
and IE<gt>E<lt>), followed by a tab, and then the descriptive text, ending in a newline. The descriptive text can also be marked up in the same way. If you
need to continue the descriptive text to another line, start that line with
just tabs and then enter the marked-up text.
If you are modifying the help text, I<be careful>. The help-string parser is
not very sophisticated, and if you don't follow these rules it will mangle the
help beyond hope until you fix the string.
=cut
sub sethelp {
# 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.
$help = "
Help is currently only available for the new 5.8 command set.
No help is available for the old command set.
We assume you know what you're doing if you switch to it.
B<T> Stack trace.
B<s> [I<expr>] Single step [in I<expr>].
B<n> [I<expr>] Next, steps over subroutine calls [in I<expr>].
<B<CR>> Repeat last B<n> or B<s> command.
B<r> Return from current subroutine.
B<c> [I<line>|I<sub>] Continue; optionally inserts a one-time-only breakpoint
at the specified position.
B<l> I<min>B<+>I<incr> List I<incr>+1 lines starting at I<min>.
B<l> I<min>B<->I<max> List lines I<min> through I<max>.
B<l> I<line> List single I<line>.
B<l> I<subname> List first window of lines from subroutine.
B<l> I<\$var> List first window of lines from subroutine referenced by I<\$var>.
B<l> List next window of lines.
B<-> List previous window of lines.
B<v> [I<line>] View window around I<line>.
B<.> Return to the executed line.
B<f> I<filename> Switch to viewing I<filename>. File must be already loaded.
I<filename> may be either the full name of the file, or a regular
expression matching the full file name:
B<f> I</home/me/foo.pl> and B<f> I<oo\\.> may access the same file.
Evals (with saved bodies) are considered to be filenames:
B<f> I<(eval 7)> and B<f> I<eval 7\\b> access the body of the 7th eval
(in the order of execution).
B</>I<pattern>B</> Search forwards for I<pattern>; final B</> is optional.
B<?>I<pattern>B<?> Search backwards for I<pattern>; final B<?> is optional.
B<L> [I<a|b|w>] List actions and or breakpoints and or watch-expressions.
B<S> [[B<!>]I<pattern>] List subroutine names [not] matching I<pattern>.
B<t> Toggle trace mode.
B<t> I<expr> Trace through execution of I<expr>.
B<b> Sets breakpoint on current line)
B<b> [I<line>] [I<condition>]
Set breakpoint; I<line> defaults to the current execution line;
I<condition> breaks if it evaluates to true, defaults to '1'.
B<b> I<subname> [I<condition>]
Set breakpoint at first line of subroutine.
B<b> I<\$var> Set breakpoint at first line of subroutine referenced by I<\$var>.
B<b> B<load> I<filename> Set breakpoint on 'require'ing the given file.
B<b> B<postpone> I<subname> [I<condition>]
Set breakpoint at first line of subroutine after
it is compiled.
B<b> B<compile> I<subname>
Stop after the subroutine is compiled.
B<B> [I<line>] Delete the breakpoint for I<line>.
B<B> I<*> Delete all breakpoints.
B<a> [I<line>] I<command>
Set an action to be done before the I<line> is executed;
I<line> defaults to the current execution line.
Sequence is: check for breakpoint/watchpoint, print line
if necessary, do action, prompt user if necessary,
execute line.
B<a> Does nothing
B<A> [I<line>] Delete the action for I<line>.
B<A> I<*> Delete all actions.
B<w> I<expr> Add a global watch-expression.
B<w> Does nothing
B<W> I<expr> Delete a global watch-expression.
B<W> I<*> Delete all watch-expressions.
B<V> [I<pkg> [I<vars>]] List some (default all) variables in package (default current).
Use B<~>I<pattern> and B<!>I<pattern> for positive and negative regexps.
B<X> [I<vars>] Same as \"B<V> I<currentpackage> [I<vars>]\".
B<x> I<expr> Evals expression in list context, dumps the result.
B<m> I<expr> Evals expression in list context, prints methods callable
on the first element of the result.
B<m> I<class> Prints methods callable via the given class.
B<M> Show versions of loaded modules.
B<i> I<class> Prints nested parents of given class.
B<y> [I<n> [I<Vars>]] List lexicals in higher scope <n>. Vars same as B<V>.
B<<> ? List Perl commands to run before each prompt.
B<<> I<expr> Define Perl command to run before each prompt.
B<<<> I<expr> Add to the list of Perl commands to run before each prompt.
B<< *> Delete the list of perl commands to run before each prompt.
B<>> ? List Perl commands to run after each prompt.
B<>> I<expr> Define Perl command to run after each prompt.
B<>>B<>> I<expr> Add to the list of Perl commands to run after each prompt.
B<>>B< *> Delete 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<{ *> Delete the list of debugger commands 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).
=head3 Scalar, array, and hash completion: partially qualified package
Much like the above, except we have to do a little more cleanup:
=cut
if ($text =~ /^[\$@%](.*)::(.*)/) { # symbols in a package
=pod
=over 4
=item * Determine the package that the symbol is in. Put it in C<::> (effectively C<main::>) if no package is specified.
=cut
$pack = ($1 eq 'main' ? '' : $1) . '::';
=pod
=item * Figure out the prefix vs. what needs completing.
=cut
$prefix = (substr $text, 0, 1) . $1 . '::';
$text = $2;
=pod
=item * Look through all the symbols in the package. C<grep> out all the possible hashes/arrays/scalars, and then C<grep> the possible matches out of those. C<map> the prefix onto all the possibilities.
=cut
my @out = map "$prefix$_", grep /^\Q$text/, grep /^_?[a-zA-Z]/,
keys %$pack;
=pod
=item * If there's only one hit, and it's a package qualifier, and it's not equal to the initial text, re-complete it using the symbol we actually found.
=cut
if (@out == 1 and $out[0] =~ /::$/ and $out[0] ne $itext) {
return db_complete($out[0], $line, $start);
}
# Return the list of possibles.
return sort @out;
} ## end if ($text =~ /^[\$@%](.*)::(.*)/)
=pod
=back
=head3 Symbol completion: current package or package C<main>.
=cut
if ($text =~ /^[\$@%]/) { # symbols (in $package + packages in main)
=pod
=over 4
=item * If it's C<main>, delete main to just get C<::> leading.
=item * We set the prefix to the item's sigil, and trim off the sigil to get the text to be completed.
=cut
$prefix = substr $text, 0, 1;
$text = substr $text, 1;
=pod
=item * If the package is C<::> (C<main>), create an empty list; if it's something else, create a list of all the packages known. Append whichever list to a list of all the possible symbols in the current package. C<grep> out the matches to the text entered so far, then C<map> the prefix back onto the symbols.
=cut
my @out = map "$prefix$_", grep /^\Q$text/,
(grep /^_?[a-zA-Z]/, keys %$pack),
($pack eq '::' ? () : (grep /::$/, keys %::));
=item * If there's only one hit, it's a package qualifier, and it's not equal to the initial text, recomplete using this symbol.
=back
=cut
if (@out == 1 and $out[0] =~ /::$/ and $out[0] ne $itext) {
return db_complete($out[0], $line, $start);
}
# Return the list of possibles.
return sort @out;
} ## end if ($text =~ /^[\$@%]/)
=head3 Options
We use C<option_val()> to look up the current value of the option. If there's
only a single value, we complete the command in such a way that it is a
complete command for setting the option in question. If there are multiple
possible values, we generate a command consisting of the option plus a trailing
question mark, which, if executed, will list the current value of the option.
=cut
my $cmd = ($CommandSet eq '580') ? 'o' : 'O';
if ((substr $line, 0, $start) =~ /^\|*$cmd\b.*\s$/) { # Options after space
# We look for the text to be matched in the list of possible options,
# and fetch the current value.
my @out = grep /^\Q$text/, @options;
my $val = option_val($out[0], undef);
# Set up a 'query option's value' command.
my $out = '? ';
if (not defined $val or $val =~ /[\n\r]/) {
# There's really nothing else we can do.
}
# We have a value. Create a proper option-setting command.
elsif ($val =~ /\s/) {
# XXX This may be an extraneous variable.
my $found;
# We'll want to quote the string (because of the embedded
# whtespace), but we want to make sure we don't end up with
# mismatched quote characters. We try several possibilities.
foreach $l (split //, qq/\"\'\#\|/) {
# If we didn't find this quote character in the value,
# quote it using this quote character.
$out = "$l$val$l ", last if (index $val, $l) == -1;
}
} ## end elsif ($val =~ /\s/)
# Don't need any quotes.
else {
$out = "=$val ";
}
# If there were multiple possible values, return '? ', which
# makes the command into a query command. If there was just one,
# have readline append that.
$rl_attribs->{completer_terminator_character} =
(@out == 1 ? $out : '? ');
# Return list of possibilities.
return sort @out;
} ## end if ((substr $line, 0, ...
=head3 Filename completion
For entering filenames. We simply call C<readline>'s C<filename_list()>
method with the completion text to get the possible completions.
=cut
return $term->filename_list($text); # filenames
} ## end sub db_complete
=head1 MISCELLANEOUS SUPPORT FUNCTIONS
Functions that possibly ought to be somewhere else.
=head2 end_report
Say we're done.
=cut
sub end_report {
local $\ = '';
print $OUT "Use `q' to quit or `R' to restart. `h q' for details.\n";
}
=head2 clean_ENV
If we have $ini_pids, save it in the environment; else remove it from the
environment. Used by the C<R> (restart) command.
=cut
sub clean_ENV {
if (defined($ini_pids)) {
$ENV{PERLDB_PIDS} = $ini_pids;
}
else {
delete($ENV{PERLDB_PIDS});
}
} ## end sub clean_ENV
=head1 END PROCESSING - THE C<END> BLOCK
Come here at the very end of processing. We want to go into a
loop where we allow the user to enter commands and interact with the
debugger, but we don't want anything else to execute.
First we set the C<$finished> variable, so that some commands that
shouldn't be run after the end of program quit working.
We then figure out whether we're truly done (as in the user entered a C<q>
command, or we finished execution while running nonstop). If we aren't,
we set C<$single> to 1 (causing the debugger to get control again).
We then call C<DB::fake::at_exit()>, which returns the C<Use 'q' to quit ...">
message and returns control to the debugger. Repeat.
When the user finally enters a C<q> command, C<$fall_off_end> is set to
1 and the C<END> block simply exits with C<$single> set to 0 (don't
break, run to completion.).
=cut
END {
$finished = 1 if $inhibit_exit; # So that some commands may be disabled.
$fall_off_end = 1 unless $inhibit_exit;
# Do not stop in at_exit() and destructors on exit:
$DB::single = !$fall_off_end && !$runnonstop;
DB::fake::at_exit() unless $fall_off_end or $runnonstop;
} ## end END
=head1 PRE-5.8 COMMANDS
Some of the commands changed function quite a bit in the 5.8 command
realignment, so much so that the old code had to be replaced completely.
Because we wanted to retain the option of being able to go back to the
former command set, we moved the old code off to this section.
There's an awful lot of duplicated code here. We've duplicated the
comments to keep things clear.
=head2 Null command
Does nothing. Used to 'turn off' commands.
=cut
sub cmd_pre580_null {
# do nothing...
}
=head2 Old C<a> command.
This version added actions if you supplied them, and deleted them
if you didn't.
=cut
sub cmd_pre580_a {
my $xcmd = shift;
my $cmd = shift;
# Argument supplied. Add the action.
if ($cmd =~ /^(\d*)\s*(.*)/) {
# If the line isn't there, use the current line.
$i = $1 || $line;
$j = $2;
# If there is an action ...
if (length $j) {
# ... but the line isn't breakable, skip it.
if ($dbline[$i] == 0) {
print $OUT "Line $i may not have an action.\n";
}
else {
# ... and the line is breakable:
# Mark that there's an action in this file.
$had_breakpoints{$filename} |= 2;
# Delete any current action.
$dbline{$i} =~ s/\0[^\0]*//;
# Add the new action, continuing the line as needed.
$dbline{$i} .= "\0" . action($j);
}
} ## end if (length $j)
# No action supplied.
else {
# Delete the action.
$dbline{$i} =~ s/\0[^\0]*//;
# Mark as having no break or action if nothing's left.
delete $dbline{$i} if $dbline{$i} eq '';
}
} ## end if ($cmd =~ /^(\d*)\s*(.*)/)
} ## end sub cmd_pre580_a
=head2 Old C<b> command
Add breakpoints.
=cut
sub cmd_pre580_b {
my $xcmd = shift;
my $cmd = shift;
my $dbline = shift;
# Break on load.
if ($cmd =~ /^load\b\s*(.*)/) {
my $file = $1;
$file =~ s/\s+$//;
&cmd_b_load($file);
}
# b compile|postpone <some sub> [<condition>]
# The interpreter actually traps this one for us; we just put the
