Initial Commit
This commit is contained in:
Riley Schneider
802
database/perl/lib/DB.pm
Normal file
802
database/perl/lib/DB.pm
Normal file
@@ -0,0 +1,802 @@
|
||||
#
|
||||
# Documentation is at the __END__
|
||||
#
|
||||
|
||||
package DB;
|
||||
|
||||
# "private" globals
|
||||
|
||||
my ($running, $ready, $deep, $usrctxt, $evalarg,
|
||||
@stack, @saved, @skippkg, @clients);
|
||||
my $preeval = {};
|
||||
my $posteval = {};
|
||||
my $ineval = {};
|
||||
|
||||
####
|
||||
#
|
||||
# Globals - must be defined at startup so that clients can refer to
|
||||
# them right after a C<require DB;>
|
||||
#
|
||||
####
|
||||
|
||||
BEGIN {
|
||||
|
||||
# these are hardcoded in perl source (some are magical)
|
||||
|
||||
$DB::sub = ''; # name of current subroutine
|
||||
%DB::sub = (); # "filename:fromline-toline" for every known sub
|
||||
$DB::single = 0; # single-step flag (set it to 1 to enable stops in BEGIN/use)
|
||||
$DB::signal = 0; # signal flag (will cause a stop at the next line)
|
||||
$DB::trace = 0; # are we tracing through subroutine calls?
|
||||
@DB::args = (); # arguments of current subroutine or @ARGV array
|
||||
@DB::dbline = (); # list of lines in currently loaded file
|
||||
%DB::dbline = (); # actions in current file (keyed by line number)
|
||||
@DB::ret = (); # return value of last sub executed in list context
|
||||
$DB::ret = ''; # return value of last sub executed in scalar context
|
||||
|
||||
# other "public" globals
|
||||
|
||||
$DB::package = ''; # current package space
|
||||
$DB::filename = ''; # current filename
|
||||
$DB::subname = ''; # currently executing sub (fully qualified name)
|
||||
$DB::lineno = ''; # current line number
|
||||
|
||||
$DB::VERSION = $DB::VERSION = '1.08';
|
||||
|
||||
# initialize private globals to avoid warnings
|
||||
|
||||
$running = 1; # are we running, or are we stopped?
|
||||
@stack = (0);
|
||||
@clients = ();
|
||||
$deep = 1000;
|
||||
$ready = 0;
|
||||
@saved = ();
|
||||
@skippkg = ();
|
||||
$usrctxt = '';
|
||||
$evalarg = '';
|
||||
}
|
||||
|
||||
####
|
||||
# entry point for all subroutine calls
|
||||
#
|
||||
sub sub {
|
||||
push(@stack, $DB::single);
|
||||
$DB::single &= 1;
|
||||
$DB::single |= 4 if $#stack == $deep;
|
||||
if ($DB::sub eq 'DESTROY' or substr($DB::sub, -9) eq '::DESTROY' or not defined wantarray) {
|
||||
&$DB::sub;
|
||||
$DB::single |= pop(@stack);
|
||||
$DB::ret = undef;
|
||||
}
|
||||
elsif (wantarray) {
|
||||
@DB::ret = &$DB::sub;
|
||||
$DB::single |= pop(@stack);
|
||||
@DB::ret;
|
||||
}
|
||||
else {
|
||||
$DB::ret = &$DB::sub;
|
||||
$DB::single |= pop(@stack);
|
||||
$DB::ret;
|
||||
}
|
||||
}
|
||||
|
||||
####
|
||||
# this is called by perl for every statement
|
||||
#
|
||||
sub DB {
|
||||
return unless $ready;
|
||||
&save;
|
||||
($DB::package, $DB::filename, $DB::lineno) = caller;
|
||||
|
||||
return if @skippkg and grep { $_ eq $DB::package } @skippkg;
|
||||
|
||||
$usrctxt = "package $DB::package;"; # this won't let them modify, alas
|
||||
local(*DB::dbline) = "::_<$DB::filename";
|
||||
|
||||
my ($stop, $action);
|
||||
if (($stop,$action) = split(/\0/,$DB::dbline{$DB::lineno})) {
|
||||
if ($stop eq '1') {
|
||||
$DB::signal |= 1;
|
||||
}
|
||||
else {
|
||||
$stop = 0 unless $stop; # avoid un_init warning
|
||||
$evalarg = "\$DB::signal |= do { $stop; }"; &eval;
|
||||
$DB::dbline{$DB::lineno} =~ s/;9($|\0)/$1/; # clear any temp breakpt
|
||||
}
|
||||
}
|
||||
if ($DB::single || $DB::trace || $DB::signal) {
|
||||
$DB::subname = ($DB::sub =~ /\'|::/) ? $DB::sub : "${DB::package}::$DB::sub"; #';
|
||||
DB->loadfile($DB::filename, $DB::lineno);
|
||||
}
|
||||
$evalarg = $action, &eval if $action;
|
||||
if ($DB::single || $DB::signal) {
|
||||
_outputall($#stack . " levels deep in subroutine calls.\n") if $DB::single & 4;
|
||||
$DB::single = 0;
|
||||
$DB::signal = 0;
|
||||
$running = 0;
|
||||
|
||||
&eval if ($evalarg = DB->prestop);
|
||||
my $c;
|
||||
for $c (@clients) {
|
||||
# perform any client-specific prestop actions
|
||||
&eval if ($evalarg = $c->cprestop);
|
||||
|
||||
# Now sit in an event loop until something sets $running
|
||||
do {
|
||||
$c->idle; # call client event loop; must not block
|
||||
if ($running == 2) { # client wants something eval-ed
|
||||
&eval if ($evalarg = $c->evalcode);
|
||||
$running = 0;
|
||||
}
|
||||
} until $running;
|
||||
|
||||
# perform any client-specific poststop actions
|
||||
&eval if ($evalarg = $c->cpoststop);
|
||||
}
|
||||
&eval if ($evalarg = DB->poststop);
|
||||
}
|
||||
($@, $!, $,, $/, $\, $^W) = @saved;
|
||||
();
|
||||
}
|
||||
|
||||
####
|
||||
# this takes its argument via $evalarg to preserve current @_
|
||||
#
|
||||
sub eval {
|
||||
($@, $!, $,, $/, $\, $^W) = @saved;
|
||||
eval "$usrctxt $evalarg; &DB::save";
|
||||
_outputall($@) if $@;
|
||||
}
|
||||
|
||||
###############################################################################
|
||||
# no compile-time subroutine call allowed before this point #
|
||||
###############################################################################
|
||||
|
||||
use strict; # this can run only after DB() and sub() are defined
|
||||
|
||||
sub save {
|
||||
@saved = ($@, $!, $,, $/, $\, $^W);
|
||||
$, = ""; $/ = "\n"; $\ = ""; $^W = 0;
|
||||
}
|
||||
|
||||
sub catch {
|
||||
for (@clients) { $_->awaken; }
|
||||
$DB::signal = 1;
|
||||
$ready = 1;
|
||||
}
|
||||
|
||||
####
|
||||
#
|
||||
# Client callable (read inheritable) methods defined after this point
|
||||
#
|
||||
####
|
||||
|
||||
sub register {
|
||||
my $s = shift;
|
||||
$s = _clientname($s) if ref($s);
|
||||
push @clients, $s;
|
||||
}
|
||||
|
||||
sub done {
|
||||
my $s = shift;
|
||||
$s = _clientname($s) if ref($s);
|
||||
@clients = grep {$_ ne $s} @clients;
|
||||
$s->cleanup;
|
||||
# $running = 3 unless @clients;
|
||||
exit(0) unless @clients;
|
||||
}
|
||||
|
||||
sub _clientname {
|
||||
my $name = shift;
|
||||
"$name" =~ /^(.+)=[A-Z]+\(.+\)$/;
|
||||
return $1;
|
||||
}
|
||||
|
||||
sub next {
|
||||
my $s = shift;
|
||||
$DB::single = 2;
|
||||
$running = 1;
|
||||
}
|
||||
|
||||
sub step {
|
||||
my $s = shift;
|
||||
$DB::single = 1;
|
||||
$running = 1;
|
||||
}
|
||||
|
||||
sub cont {
|
||||
my $s = shift;
|
||||
my $i = shift;
|
||||
$s->set_tbreak($i) if $i;
|
||||
for ($i = 0; $i <= $#stack;) {
|
||||
$stack[$i++] &= ~1;
|
||||
}
|
||||
$DB::single = 0;
|
||||
$running = 1;
|
||||
}
|
||||
|
||||
####
|
||||
# XXX caller must experimentally determine $i (since it depends
|
||||
# on how many client call frames are between this call and the DB call).
|
||||
# Such is life.
|
||||
#
|
||||
sub ret {
|
||||
my $s = shift;
|
||||
my $i = shift; # how many levels to get to DB sub
|
||||
$i = 0 unless defined $i;
|
||||
$stack[$#stack-$i] |= 1;
|
||||
$DB::single = 0;
|
||||
$running = 1;
|
||||
}
|
||||
|
||||
####
|
||||
# XXX caller must experimentally determine $start (since it depends
|
||||
# on how many client call frames are between this call and the DB call).
|
||||
# Such is life.
|
||||
#
|
||||
sub backtrace {
|
||||
my $self = shift;
|
||||
my $start = shift;
|
||||
my($p,$f,$l,$s,$h,$w,$e,$r,$a, @a, @ret,$i);
|
||||
$start = 1 unless $start;
|
||||
for ($i = $start; ($p,$f,$l,$s,$h,$w,$e,$r) = caller($i); $i++) {
|
||||
@a = @DB::args;
|
||||
for (@a) {
|
||||
s/'/\\'/g;
|
||||
s/([^\0]*)/'$1'/ unless /^-?[\d.]+$/;
|
||||
require 'meta_notation.pm';
|
||||
$_ = _meta_notation($_) if /[[:^print:]]/a;
|
||||
}
|
||||
$w = $w ? '@ = ' : '$ = ';
|
||||
$a = $h ? '(' . join(', ', @a) . ')' : '';
|
||||
$e =~ s/\n\s*\;\s*\Z// if $e;
|
||||
$e =~ s/[\\\']/\\$1/g if $e;
|
||||
if ($r) {
|
||||
$s = "require '$e'";
|
||||
} elsif (defined $r) {
|
||||
$s = "eval '$e'";
|
||||
} elsif ($s eq '(eval)') {
|
||||
$s = "eval {...}";
|
||||
}
|
||||
$f = "file '$f'" unless $f eq '-e';
|
||||
push @ret, "$w&$s$a from $f line $l";
|
||||
last if $DB::signal;
|
||||
}
|
||||
return @ret;
|
||||
}
|
||||
|
||||
sub _outputall {
|
||||
my $c;
|
||||
for $c (@clients) {
|
||||
$c->output(@_);
|
||||
}
|
||||
}
|
||||
|
||||
sub trace_toggle {
|
||||
my $s = shift;
|
||||
$DB::trace = !$DB::trace;
|
||||
}
|
||||
|
||||
|
||||
####
|
||||
# without args: returns all defined subroutine names
|
||||
# with subname args: returns a listref [file, start, end]
|
||||
#
|
||||
sub subs {
|
||||
my $s = shift;
|
||||
if (@_) {
|
||||
my(@ret) = ();
|
||||
while (@_) {
|
||||
my $name = shift;
|
||||
push @ret, [$DB::sub{$name} =~ /^(.*)\:(\d+)-(\d+)$/]
|
||||
if exists $DB::sub{$name};
|
||||
}
|
||||
return @ret;
|
||||
}
|
||||
return keys %DB::sub;
|
||||
}
|
||||
|
||||
####
|
||||
# first argument is a filename whose subs will be returned
|
||||
# if a filename is not supplied, all subs in the current
|
||||
# filename are returned.
|
||||
#
|
||||
sub filesubs {
|
||||
my $s = shift;
|
||||
my $fname = shift;
|
||||
$fname = $DB::filename unless $fname;
|
||||
return grep { $DB::sub{$_} =~ /^$fname/ } keys %DB::sub;
|
||||
}
|
||||
|
||||
####
|
||||
# returns a list of all filenames that DB knows about
|
||||
#
|
||||
sub files {
|
||||
my $s = shift;
|
||||
my(@f) = grep(m|^_<|, keys %main::);
|
||||
return map { substr($_,2) } @f;
|
||||
}
|
||||
|
||||
####
|
||||
# returns reference to an array holding the lines in currently
|
||||
# loaded file
|
||||
#
|
||||
sub lines {
|
||||
my $s = shift;
|
||||
return \@DB::dbline;
|
||||
}
|
||||
|
||||
####
|
||||
# loadfile($file, $line)
|
||||
#
|
||||
sub loadfile {
|
||||
my $s = shift;
|
||||
my($file, $line) = @_;
|
||||
if (!defined $main::{'_<' . $file}) {
|
||||
my $try;
|
||||
if (($try) = grep(m|^_<.*$file|, keys %main::)) {
|
||||
$file = substr($try,2);
|
||||
}
|
||||
}
|
||||
if (defined($main::{'_<' . $file})) {
|
||||
my $c;
|
||||
# _outputall("Loading file $file..");
|
||||
*DB::dbline = "::_<$file";
|
||||
$DB::filename = $file;
|
||||
for $c (@clients) {
|
||||
# print "2 ", $file, '|', $line, "\n";
|
||||
$c->showfile($file, $line);
|
||||
}
|
||||
return $file;
|
||||
}
|
||||
return undef;
|
||||
}
|
||||
|
||||
sub lineevents {
|
||||
my $s = shift;
|
||||
my $fname = shift;
|
||||
my(%ret) = ();
|
||||
my $i;
|
||||
$fname = $DB::filename unless $fname;
|
||||
local(*DB::dbline) = "::_<$fname";
|
||||
for ($i = 1; $i <= $#DB::dbline; $i++) {
|
||||
$ret{$i} = [$DB::dbline[$i], split(/\0/, $DB::dbline{$i})]
|
||||
if defined $DB::dbline{$i};
|
||||
}
|
||||
return %ret;
|
||||
}
|
||||
|
||||
sub set_break {
|
||||
my $s = shift;
|
||||
my $i = shift;
|
||||
my $cond = shift;
|
||||
$i ||= $DB::lineno;
|
||||
$cond ||= '1';
|
||||
$i = _find_subline($i) if ($i =~ /\D/);
|
||||
$s->output("Subroutine not found.\n") unless $i;
|
||||
if ($i) {
|
||||
if ($DB::dbline[$i] == 0) {
|
||||
$s->output("Line $i not breakable.\n");
|
||||
}
|
||||
else {
|
||||
$DB::dbline{$i} =~ s/^[^\0]*/$cond/;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
sub set_tbreak {
|
||||
my $s = shift;
|
||||
my $i = shift;
|
||||
$i = _find_subline($i) if ($i =~ /\D/);
|
||||
$s->output("Subroutine not found.\n") unless $i;
|
||||
if ($i) {
|
||||
if ($DB::dbline[$i] == 0) {
|
||||
$s->output("Line $i not breakable.\n");
|
||||
}
|
||||
else {
|
||||
$DB::dbline{$i} =~ s/($|\0)/;9$1/; # add one-time-only b.p.
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
sub _find_subline {
|
||||
my $name = shift;
|
||||
$name =~ s/\'/::/;
|
||||
$name = "${DB::package}\:\:" . $name if $name !~ /::/;
|
||||
$name = "main" . $name if substr($name,0,2) eq "::";
|
||||
my($fname, $from, $to) = ($DB::sub{$name} =~ /^(.*):(\d+)-(\d+)$/);
|
||||
if ($from) {
|
||||
local *DB::dbline = "::_<$fname";
|
||||
++$from while $DB::dbline[$from] == 0 && $from < $to;
|
||||
return $from;
|
||||
}
|
||||
return undef;
|
||||
}
|
||||
|
||||
sub clr_breaks {
|
||||
my $s = shift;
|
||||
my $i;
|
||||
if (@_) {
|
||||
while (@_) {
|
||||
$i = shift;
|
||||
$i = _find_subline($i) if ($i =~ /\D/);
|
||||
$s->output("Subroutine not found.\n") unless $i;
|
||||
if (defined $DB::dbline{$i}) {
|
||||
$DB::dbline{$i} =~ s/^[^\0]+//;
|
||||
if ($DB::dbline{$i} =~ s/^\0?$//) {
|
||||
delete $DB::dbline{$i};
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
else {
|
||||
for ($i = 1; $i <= $#DB::dbline ; $i++) {
|
||||
if (defined $DB::dbline{$i}) {
|
||||
$DB::dbline{$i} =~ s/^[^\0]+//;
|
||||
if ($DB::dbline{$i} =~ s/^\0?$//) {
|
||||
delete $DB::dbline{$i};
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
sub set_action {
|
||||
my $s = shift;
|
||||
my $i = shift;
|
||||
my $act = shift;
|
||||
$i = _find_subline($i) if ($i =~ /\D/);
|
||||
$s->output("Subroutine not found.\n") unless $i;
|
||||
if ($i) {
|
||||
if ($DB::dbline[$i] == 0) {
|
||||
$s->output("Line $i not actionable.\n");
|
||||
}
|
||||
else {
|
||||
$DB::dbline{$i} =~ s/\0[^\0]*//;
|
||||
$DB::dbline{$i} .= "\0" . $act;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
sub clr_actions {
|
||||
my $s = shift;
|
||||
my $i;
|
||||
if (@_) {
|
||||
while (@_) {
|
||||
my $i = shift;
|
||||
$i = _find_subline($i) if ($i =~ /\D/);
|
||||
$s->output("Subroutine not found.\n") unless $i;
|
||||
if ($i && $DB::dbline[$i] != 0) {
|
||||
$DB::dbline{$i} =~ s/\0[^\0]*//;
|
||||
delete $DB::dbline{$i} if $DB::dbline{$i} =~ s/^\0?$//;
|
||||
}
|
||||
}
|
||||
}
|
||||
else {
|
||||
for ($i = 1; $i <= $#DB::dbline ; $i++) {
|
||||
if (defined $DB::dbline{$i}) {
|
||||
$DB::dbline{$i} =~ s/\0[^\0]*//;
|
||||
delete $DB::dbline{$i} if $DB::dbline{$i} =~ s/^\0?$//;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
sub prestop {
|
||||
my ($client, $val) = @_;
|
||||
return defined($val) ? $preeval->{$client} = $val : $preeval->{$client};
|
||||
}
|
||||
|
||||
sub poststop {
|
||||
my ($client, $val) = @_;
|
||||
return defined($val) ? $posteval->{$client} = $val : $posteval->{$client};
|
||||
}
|
||||
|
||||
#
|
||||
# "pure virtual" methods
|
||||
#
|
||||
|
||||
# client-specific pre/post-stop actions.
|
||||
sub cprestop {}
|
||||
sub cpoststop {}
|
||||
|
||||
# client complete startup
|
||||
sub awaken {}
|
||||
|
||||
sub skippkg {
|
||||
my $s = shift;
|
||||
push @skippkg, @_ if @_;
|
||||
}
|
||||
|
||||
sub evalcode {
|
||||
my ($client, $val) = @_;
|
||||
if (defined $val) {
|
||||
$running = 2; # hand over to DB() to evaluate in its context
|
||||
$ineval->{$client} = $val;
|
||||
}
|
||||
return $ineval->{$client};
|
||||
}
|
||||
|
||||
sub ready {
|
||||
my $s = shift;
|
||||
return $ready = 1;
|
||||
}
|
||||
|
||||
# stubs
|
||||
|
||||
sub init {}
|
||||
sub stop {}
|
||||
sub idle {}
|
||||
sub cleanup {}
|
||||
sub output {}
|
||||
|
||||
#
|
||||
# client init
|
||||
#
|
||||
for (@clients) { $_->init }
|
||||
|
||||
$SIG{'INT'} = \&DB::catch;
|
||||
|
||||
# disable this if stepping through END blocks is desired
|
||||
# (looks scary and deconstructivist with Swat)
|
||||
END { $ready = 0 }
|
||||
|
||||
1;
|
||||
__END__
|
||||
|
||||
=head1 NAME
|
||||
|
||||
DB - programmatic interface to the Perl debugging API
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
package CLIENT;
|
||||
use DB;
|
||||
@ISA = qw(DB);
|
||||
|
||||
# these (inherited) methods can be called by the client
|
||||
|
||||
CLIENT->register() # register a client package name
|
||||
CLIENT->done() # de-register from the debugging API
|
||||
CLIENT->skippkg('hide::hide') # ask DB not to stop in this package
|
||||
CLIENT->cont([WHERE]) # run some more (until BREAK or
|
||||
# another breakpointt)
|
||||
CLIENT->step() # single step
|
||||
CLIENT->next() # step over
|
||||
CLIENT->ret() # return from current subroutine
|
||||
CLIENT->backtrace() # return the call stack description
|
||||
CLIENT->ready() # call when client setup is done
|
||||
CLIENT->trace_toggle() # toggle subroutine call trace mode
|
||||
CLIENT->subs([SUBS]) # return subroutine information
|
||||
CLIENT->files() # return list of all files known to DB
|
||||
CLIENT->lines() # return lines in currently loaded file
|
||||
CLIENT->loadfile(FILE,LINE) # load a file and let other clients know
|
||||
CLIENT->lineevents() # return info on lines with actions
|
||||
CLIENT->set_break([WHERE],[COND])
|
||||
CLIENT->set_tbreak([WHERE])
|
||||
CLIENT->clr_breaks([LIST])
|
||||
CLIENT->set_action(WHERE,ACTION)
|
||||
CLIENT->clr_actions([LIST])
|
||||
CLIENT->evalcode(STRING) # eval STRING in executing code's context
|
||||
CLIENT->prestop([STRING]) # execute in code context before stopping
|
||||
CLIENT->poststop([STRING])# execute in code context before resuming
|
||||
|
||||
# These methods will be called at the appropriate times.
|
||||
# Stub versions provided do nothing.
|
||||
# None of these can block.
|
||||
|
||||
CLIENT->init() # called when debug API inits itself
|
||||
CLIENT->stop(FILE,LINE) # when execution stops
|
||||
CLIENT->idle() # while stopped (can be a client event loop)
|
||||
CLIENT->cleanup() # just before exit
|
||||
CLIENT->output(LIST) # called to print any output that
|
||||
# the API must show
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
Perl debug information is frequently required not just by debuggers,
|
||||
but also by modules that need some "special" information to do their
|
||||
job properly, like profilers.
|
||||
|
||||
This module abstracts and provides all of the hooks into Perl internal
|
||||
debugging functionality, so that various implementations of Perl debuggers
|
||||
(or packages that want to simply get at the "privileged" debugging data)
|
||||
can all benefit from the development of this common code. Currently used
|
||||
by Swat, the perl/Tk GUI debugger.
|
||||
|
||||
Note that multiple "front-ends" can latch into this debugging API
|
||||
simultaneously. This is intended to facilitate things like
|
||||
debugging with a command line and GUI at the same time, debugging
|
||||
debuggers etc. [Sounds nice, but this needs some serious support -- GSAR]
|
||||
|
||||
In particular, this API does B<not> provide the following functions:
|
||||
|
||||
=over 4
|
||||
|
||||
=item *
|
||||
|
||||
data display
|
||||
|
||||
=item *
|
||||
|
||||
command processing
|
||||
|
||||
=item *
|
||||
|
||||
command alias management
|
||||
|
||||
=item *
|
||||
|
||||
user interface (tty or graphical)
|
||||
|
||||
=back
|
||||
|
||||
These are intended to be services performed by the clients of this API.
|
||||
|
||||
This module attempts to be squeaky clean w.r.t C<use strict;> and when
|
||||
warnings are enabled.
|
||||
|
||||
|
||||
=head2 Global Variables
|
||||
|
||||
The following "public" global names can be read by clients of this API.
|
||||
Beware that these should be considered "readonly".
|
||||
|
||||
=over 8
|
||||
|
||||
=item $DB::sub
|
||||
|
||||
Name of current executing subroutine.
|
||||
|
||||
=item %DB::sub
|
||||
|
||||
The keys of this hash are the names of all the known subroutines. Each value
|
||||
is an encoded string that has the sprintf(3) format
|
||||
C<("%s:%d-%d", filename, fromline, toline)>.
|
||||
|
||||
=item $DB::single
|
||||
|
||||
Single-step flag. Will be true if the API will stop at the next statement.
|
||||
|
||||
=item $DB::signal
|
||||
|
||||
Signal flag. Will be set to a true value if a signal was caught. Clients may
|
||||
check for this flag to abort time-consuming operations.
|
||||
|
||||
=item $DB::trace
|
||||
|
||||
This flag is set to true if the API is tracing through subroutine calls.
|
||||
|
||||
=item @DB::args
|
||||
|
||||
Contains the arguments of current subroutine, or the C<@ARGV> array if in the
|
||||
toplevel context.
|
||||
|
||||
=item @DB::dbline
|
||||
|
||||
List of lines in currently loaded file.
|
||||
|
||||
=item %DB::dbline
|
||||
|
||||
Actions in current file (keys are line numbers). The values are strings that
|
||||
have the sprintf(3) format C<("%s\000%s", breakcondition, actioncode)>.
|
||||
|
||||
=item $DB::package
|
||||
|
||||
Package namespace of currently executing code.
|
||||
|
||||
=item $DB::filename
|
||||
|
||||
Currently loaded filename.
|
||||
|
||||
=item $DB::subname
|
||||
|
||||
Fully qualified name of currently executing subroutine.
|
||||
|
||||
=item $DB::lineno
|
||||
|
||||
Line number that will be executed next.
|
||||
|
||||
=back
|
||||
|
||||
=head2 API Methods
|
||||
|
||||
The following are methods in the DB base class. A client must
|
||||
access these methods by inheritance (*not* by calling them directly),
|
||||
since the API keeps track of clients through the inheritance
|
||||
mechanism.
|
||||
|
||||
=over 8
|
||||
|
||||
=item CLIENT->register()
|
||||
|
||||
register a client object/package
|
||||
|
||||
=item CLIENT->evalcode(STRING)
|
||||
|
||||
eval STRING in executing code context
|
||||
|
||||
=item CLIENT->skippkg('D::hide')
|
||||
|
||||
ask DB not to stop in these packages
|
||||
|
||||
=item CLIENT->run()
|
||||
|
||||
run some more (until a breakpt is reached)
|
||||
|
||||
=item CLIENT->step()
|
||||
|
||||
single step
|
||||
|
||||
=item CLIENT->next()
|
||||
|
||||
step over
|
||||
|
||||
=item CLIENT->done()
|
||||
|
||||
de-register from the debugging API
|
||||
|
||||
=back
|
||||
|
||||
=head2 Client Callback Methods
|
||||
|
||||
The following "virtual" methods can be defined by the client. They will
|
||||
be called by the API at appropriate points. Note that unless specified
|
||||
otherwise, the debug API only defines empty, non-functional default versions
|
||||
of these methods.
|
||||
|
||||
=over 8
|
||||
|
||||
=item CLIENT->init()
|
||||
|
||||
Called after debug API inits itself.
|
||||
|
||||
=item CLIENT->prestop([STRING])
|
||||
|
||||
Usually inherited from DB package. If no arguments are passed,
|
||||
returns the prestop action string.
|
||||
|
||||
=item CLIENT->stop()
|
||||
|
||||
Called when execution stops (w/ args file, line).
|
||||
|
||||
=item CLIENT->idle()
|
||||
|
||||
Called while stopped (can be a client event loop).
|
||||
|
||||
=item CLIENT->poststop([STRING])
|
||||
|
||||
Usually inherited from DB package. If no arguments are passed,
|
||||
returns the poststop action string.
|
||||
|
||||
=item CLIENT->evalcode(STRING)
|
||||
|
||||
Usually inherited from DB package. Ask for a STRING to be C<eval>-ed
|
||||
in executing code context.
|
||||
|
||||
=item CLIENT->cleanup()
|
||||
|
||||
Called just before exit.
|
||||
|
||||
=item CLIENT->output(LIST)
|
||||
|
||||
Called when API must show a message (warnings, errors etc.).
|
||||
|
||||
|
||||
=back
|
||||
|
||||
|
||||
=head1 BUGS
|
||||
|
||||
The interface defined by this module is missing some of the later additions
|
||||
to perl's debugging functionality. As such, this interface should be considered
|
||||
highly experimental and subject to change.
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Gurusamy Sarathy gsar@activestate.com
|
||||
|
||||
This code heavily adapted from an early version of perl5db.pl attributable
|
||||
to Larry Wall and the Perl Porters.
|
||||
|
||||
=cut
|
||||
Reference in New Issue
Block a user