lib/DB.pm

   1 #
   2 # Documentation is at the __END__
   3 #
   4
   5 package DB;
   6
   7 # "private" globals
   8
   9 my ($running, $ready, $deep, $usrctxt, $evalarg,
  10     @stack, @saved, @skippkg, @clients);
  11 my $preeval = {};
  12 my $posteval = {};
  13 my $ineval = {};
  14
  15 ####
  16 #
  17 # Globals - must be defined at startup so that clients can refer to
  18 # them right after a C<require DB;>
  19 #
  20 ####
  21
  22 BEGIN {
  23
  24   # these are hardcoded in perl source (some are magical)
  25
  26   $DB::sub = '';        # name of current subroutine
  27   %DB::sub = ();        # "filename:fromline-toline" for every known sub
  28   $DB::single = 0;      # single-step flag (set it to 1 to enable stops in BEGIN/use)
  29   $DB::signal = 0;      # signal flag (will cause a stop at the next line)
  30   $DB::trace = 0;       # are we tracing through subroutine calls?
  31   @DB::args = ();       # arguments of current subroutine or @ARGV array
  32   @DB::dbline = ();     # list of lines in currently loaded file
  33   %DB::dbline = ();     # actions in current file (keyed by line number)
  34   @DB::ret = ();        # return value of last sub executed in list context
  35   $DB::ret = '';        # return value of last sub executed in scalar context
  36
  37   # other "public" globals
  38
  39   $DB::package = '';    # current package space
  40   $DB::filename = '';   # current filename
  41   $DB::subname = '';    # currently executing sub (fullly qualified name)
  42   $DB::lineno = '';     # current line number
  43
  44   $DB::VERSION = $DB::VERSION = '1.0';
  45
  46   # initialize private globals to avoid warnings
  47
  48   $running = 1;         # are we running, or are we stopped?
  49   @stack = (0);
  50   @clients = ();
  51   $deep = 100;
  52   $ready = 0;
  53   @saved = ();
  54   @skippkg = ();
  55   $usrctxt = '';
  56   $evalarg = '';
  57 }
  58
  59 ####
  60 # entry point for all subroutine calls
  61 #
  62 sub sub {
  63   push(@stack, $DB::single);
  64   $DB::single &= 1;
  65   $DB::single |= 4 if $#stack == $deep;
  66   if ($DB::sub eq 'DESTROY' or substr($DB::sub, -9) eq '::DESTROY' or not defined wantarray) {
  67     &$DB::sub;
  68     $DB::single |= pop(@stack);
  69     $DB::ret = undef;
  70   }
  71   elsif (wantarray) {
  72     @DB::ret = &$DB::sub;
  73     $DB::single |= pop(@stack);
  74     @DB::ret;
  75   }
  76   else {
  77     $DB::ret = &$DB::sub;
  78     $DB::single |= pop(@stack);
  79     $DB::ret;
  80   }
  81 }
  82
  83 ####
  84 # this is called by perl for every statement
  85 #
  86 sub DB {
  87   return unless $ready;
  88   &save;
  89   ($DB::package, $DB::filename, $DB::lineno) = caller;
  90
  91   return if @skippkg and grep { $_ eq $DB::package } @skippkg;
  92
  93   $usrctxt = "package $DB::package;";           # this won't let them modify, alas
  94   local(*DB::dbline) = "::_<$DB::filename";
  95
  96   # we need to check for pseudofiles on Mac OS (these are files
  97   # not attached to a filename, but instead stored in Dev:Pseudo)
  98   # since this is done late, $DB::filename will be "wrong" after
  99   # skippkg
 100   if ($^O eq 'MacOS' && $#DB::dbline < 0) {
 101     $DB::filename = 'Dev:Pseudo';
 102     *DB::dbline = "::_<$DB::filename";
 103   }
 104
 105   my ($stop, $action);
 106   if (($stop,$action) = split(/\0/,$DB::dbline{$DB::lineno})) {
 107     if ($stop eq '1') {
 108       $DB::signal |= 1;
 109     }
 110     else {
 111       $stop = 0 unless $stop;                   # avoid un_init warning
 112       $evalarg = "\$DB::signal |= do { $stop; }"; &eval;
 113       $DB::dbline{$DB::lineno} =~ s/;9($|\0)/$1/;    # clear any temp breakpt
 114     }
 115   }
 116   if ($DB::single || $DB::trace || $DB::signal) {
 117     $DB::subname = ($DB::sub =~ /\'|::/) ? $DB::sub : "${DB::package}::$DB::sub"; #';
 118     DB->loadfile($DB::filename, $DB::lineno);
 119   }
 120   $evalarg = $action, &eval if $action;
 121   if ($DB::single || $DB::signal) {
 122     _outputall($#stack . " levels deep in subroutine calls.\n") if $DB::single & 4;
 123     $DB::single = 0;
 124     $DB::signal = 0;
 125     $running = 0;
 126
 127     &eval if ($evalarg = DB->prestop);
 128     my $c;
 129     for $c (@clients) {
 130       # perform any client-specific prestop actions
 131       &eval if ($evalarg = $c->cprestop);
 132
 133       # Now sit in an event loop until something sets $running
 134       do {
 135         $c->idle;                     # call client event loop; must not block
 136         if ($running == 2) {          # client wants something eval-ed
 137           &eval if ($evalarg = $c->evalcode);
 138           $running = 0;
 139         }
 140       } until $running;
 141
 142       # perform any client-specific poststop actions
 143       &eval if ($evalarg = $c->cpoststop);
 144     }
 145     &eval if ($evalarg = DB->poststop);
 146   }
 147   ($@, $!, $,, $/, $\, $^W) = @saved;
 148   ();
 149 }
 150
 151 ####
 152 # this takes its argument via $evalarg to preserve current @_
 153 #
 154 sub eval {
 155   ($@, $!, $,, $/, $\, $^W) = @saved;
 156   eval "$usrctxt $evalarg; &DB::save";
 157   _outputall($@) if $@;
 158 }
 159
 160 ###############################################################################
 161 #         no compile-time subroutine call allowed before this point           #
 162 ###############################################################################
 163
 164 use strict;                # this can run only after DB() and sub() are defined
 165
 166 sub save {
 167   @saved = ($@, $!, $,, $/, $\, $^W);
 168   $, = ""; $/ = "\n"; $\ = ""; $^W = 0;
 169 }
 170
 171 sub catch {
 172   for (@clients) { $_->awaken; }
 173   $DB::signal = 1;
 174   $ready = 1;
 175 }
 176
 177 ####
 178 #
 179 # Client callable (read inheritable) methods defined after this point
 180 #
 181 ####
 182
 183 sub register {
 184   my $s = shift;
 185   $s = _clientname($s) if ref($s);
 186   push @clients, $s;
 187 }
 188
 189 sub done {
 190   my $s = shift;
 191   $s = _clientname($s) if ref($s);
 192   @clients = grep {$_ ne $s} @clients;
 193   $s->cleanup;
 194 #  $running = 3 unless @clients;
 195   exit(0) unless @clients;
 196 }
 197
 198 sub _clientname {
 199   my $name = shift;
 200   "$name" =~ /^(.+)=[A-Z]+\(.+\)$/;
 201   return $1;
 202 }
 203
 204 sub next {
 205   my $s = shift;
 206   $DB::single = 2;
 207   $running = 1;
 208 }
 209
 210 sub step {
 211   my $s = shift;
 212   $DB::single = 1;
 213   $running = 1;
 214 }
 215
 216 sub cont {
 217   my $s = shift;
 218   my $i = shift;
 219   $s->set_tbreak($i) if $i;
 220   for ($i = 0; $i <= $#stack;) {
 221         $stack[$i++] &= ~1;
 222   }
 223   $DB::single = 0;
 224   $running = 1;
 225 }
 226
 227 ####
 228 # XXX caller must experimentally determine $i (since it depends
 229 # on how many client call frames are between this call and the DB call).
 230 # Such is life.
 231 #
 232 sub ret {
 233   my $s = shift;
 234   my $i = shift;      # how many levels to get to DB sub
 235   $i = 0 unless defined $i;
 236   $stack[$#stack-$i] |= 1;
 237   $DB::single = 0;
 238   $running = 1;
 239 }
 240
 241 ####
 242 # XXX caller must experimentally determine $start (since it depends
 243 # on how many client call frames are between this call and the DB call).
 244 # Such is life.
 245 #
 246 sub backtrace {
 247   my $self = shift;
 248   my $start = shift;
 249   my($p,$f,$l,$s,$h,$w,$e,$r,$a, @a, @ret,$i);
 250   $start = 1 unless $start;
 251   for ($i = $start; ($p,$f,$l,$s,$h,$w,$e,$r) = caller($i); $i++) {
 252     @a = @DB::args;
 253     for (@a) {
 254       s/'/\\'/g;
 255       s/([^\0]*)/'$1'/ unless /^-?[\d.]+$/;
 256       s/([\200-\377])/sprintf("M-%c",ord($1)&0177)/eg;
 257       s/([\0-\37\177])/sprintf("^%c",ord($1)^64)/eg;
 258     }
 259     $w = $w ? '@ = ' : '$ = ';
 260     $a = $h ? '(' . join(', ', @a) . ')' : '';
 261     $e =~ s/\n\s*\;\s*\Z// if $e;
 262     $e =~ s/[\\\']/\\$1/g if $e;
 263     if ($r) {
 264       $s = "require '$e'";
 265     } elsif (defined $r) {
 266       $s = "eval '$e'";
 267     } elsif ($s eq '(eval)') {
 268       $s = "eval {...}";
 269     }
 270     $f = "file `$f'" unless $f eq '-e';
 271     push @ret, "$w&$s$a from $f line $l";
 272     last if $DB::signal;
 273   }
 274   return @ret;
 275 }
 276
 277 sub _outputall {
 278   my $c;
 279   for $c (@clients) {
 280     $c->output(@_);
 281   }
 282 }
 283
 284 sub trace_toggle {
 285   my $s = shift;
 286   $DB::trace = !$DB::trace;
 287 }
 288
 289
 290 ####
 291 # without args: returns all defined subroutine names
 292 # with subname args: returns a listref [file, start, end]
 293 #
 294 sub subs {
 295   my $s = shift;
 296   if (@_) {
 297     my(@ret) = ();
 298     while (@_) {
 299       my $name = shift;
 300       push @ret, [$DB::sub{$name} =~ /^(.*)\:(\d+)-(\d+)$/]
 301         if exists $DB::sub{$name};
 302     }
 303     return @ret;
 304   }
 305   return keys %DB::sub;
 306 }
 307
 308 ####
 309 # first argument is a filename whose subs will be returned
 310 # if a filename is not supplied, all subs in the current
 311 # filename are returned.
 312 #
 313 sub filesubs {
 314   my $s = shift;
 315   my $fname = shift;
 316   $fname = $DB::filename unless $fname;
 317   return grep { $DB::sub{$_} =~ /^$fname/ } keys %DB::sub;
 318 }
 319
 320 ####
 321 # returns a list of all filenames that DB knows about
 322 #
 323 sub files {
 324   my $s = shift;
 325   my(@f) = grep(m|^_<|, keys %main::);
 326   return map { substr($_,2) } @f;
 327 }
 328
 329 ####
 330 # returns reference to an array holding the lines in currently
 331 # loaded file
 332 #
 333 sub lines {
 334   my $s = shift;
 335   return \@DB::dbline;
 336 }
 337
 338 ####
 339 # loadfile($file, $line)
 340 #
 341 sub loadfile {
 342   my $s = shift;
 343   my($file, $line) = @_;
 344   if (!defined $main::{'_<' . $file}) {
 345     my $try;
 346     if (($try) = grep(m|^_<.*$file|, keys %main::)) {
 347       $file = substr($try,2);
 348     }
 349   }
 350   if (defined($main::{'_<' . $file})) {
 351     my $c;
 352 #    _outputall("Loading file $file..");
 353     *DB::dbline = "::_<$file";
 354     $DB::filename = $file;
 355     for $c (@clients) {
 356 #      print "2 ", $file, '|', $line, "\n";
 357       $c->showfile($file, $line);
 358     }
 359     return $file;
 360   }
 361   return undef;
 362 }
 363
 364 sub lineevents {
 365   my $s = shift;
 366   my $fname = shift;
 367   my(%ret) = ();
 368   my $i;
 369   $fname = $DB::filename unless $fname;
 370   local(*DB::dbline) = "::_<$fname";
 371   for ($i = 1; $i <= $#DB::dbline; $i++) {
 372     $ret{$i} = [$DB::dbline[$i], split(/\0/, $DB::dbline{$i})]
 373       if defined $DB::dbline{$i};
 374   }
 375   return %ret;
 376 }
 377
 378 sub set_break {
 379   my $s = shift;
 380   my $i = shift;
 381   my $cond = shift;
 382   $i ||= $DB::lineno;
 383   $cond ||= '1';
 384   $i = _find_subline($i) if ($i =~ /\D/);
 385   $s->output("Subroutine not found.\n") unless $i;
 386   if ($i) {
 387     if ($DB::dbline[$i] == 0) {
 388       $s->output("Line $i not breakable.\n");
 389     }
 390     else {
 391       $DB::dbline{$i} =~ s/^[^\0]*/$cond/;
 392     }
 393   }
 394 }
 395
 396 sub set_tbreak {
 397   my $s = shift;
 398   my $i = shift;
 399   $i = _find_subline($i) if ($i =~ /\D/);
 400   $s->output("Subroutine not found.\n") unless $i;
 401   if ($i) {
 402     if ($DB::dbline[$i] == 0) {
 403       $s->output("Line $i not breakable.\n");
 404     }
 405     else {
 406       $DB::dbline{$i} =~ s/($|\0)/;9$1/; # add one-time-only b.p.
 407     }
 408   }
 409 }
 410
 411 sub _find_subline {
 412   my $name = shift;
 413   $name =~ s/\'/::/;
 414   $name = "${DB::package}\:\:" . $name if $name !~ /::/;
 415   $name = "main" . $name if substr($name,0,2) eq "::";
 416   my($fname, $from, $to) = ($DB::sub{$name} =~ /^(.*):(\d+)-(\d+)$/);
 417   if ($from) {
 418     local *DB::dbline = "::_<$fname";
 419     ++$from while $DB::dbline[$from] == 0 && $from < $to;
 420     return $from;
 421   }
 422   return undef;
 423 }
 424
 425 sub clr_breaks {
 426   my $s = shift;
 427   my $i;
 428   if (@_) {
 429     while (@_) {
 430       $i = shift;
 431       $i = _find_subline($i) if ($i =~ /\D/);
 432       $s->output("Subroutine not found.\n") unless $i;
 433       if (defined $DB::dbline{$i}) {
 434         $DB::dbline{$i} =~ s/^[^\0]+//;
 435         if ($DB::dbline{$i} =~ s/^\0?$//) {
 436           delete $DB::dbline{$i};
 437         }
 438       }
 439     }
 440   }
 441   else {
 442     for ($i = 1; $i <= $#DB::dbline ; $i++) {
 443       if (defined $DB::dbline{$i}) {
 444         $DB::dbline{$i} =~ s/^[^\0]+//;
 445         if ($DB::dbline{$i} =~ s/^\0?$//) {
 446           delete $DB::dbline{$i};
 447         }
 448       }
 449     }
 450   }
 451 }
 452
 453 sub set_action {
 454   my $s = shift;
 455   my $i = shift;
 456   my $act = shift;
 457   $i = _find_subline($i) if ($i =~ /\D/);
 458   $s->output("Subroutine not found.\n") unless $i;
 459   if ($i) {
 460     if ($DB::dbline[$i] == 0) {
 461       $s->output("Line $i not actionable.\n");
 462     }
 463     else {
 464       $DB::dbline{$i} =~ s/\0[^\0]*//;
 465       $DB::dbline{$i} .= "\0" . $act;
 466     }
 467   }
 468 }
 469
 470 sub clr_actions {
 471   my $s = shift;
 472   my $i;
 473   if (@_) {
 474     while (@_) {
 475       my $i = shift;
 476       $i = _find_subline($i) if ($i =~ /\D/);
 477       $s->output("Subroutine not found.\n") unless $i;
 478       if ($i && $DB::dbline[$i] != 0) {
 479         $DB::dbline{$i} =~ s/\0[^\0]*//;
 480         delete $DB::dbline{$i} if $DB::dbline{$i} =~ s/^\0?$//;
 481       }
 482     }
 483   }
 484   else {
 485     for ($i = 1; $i <= $#DB::dbline ; $i++) {
 486       if (defined $DB::dbline{$i}) {
 487         $DB::dbline{$i} =~ s/\0[^\0]*//;
 488         delete $DB::dbline{$i} if $DB::dbline{$i} =~ s/^\0?$//;
 489       }
 490     }
 491   }
 492 }
 493
 494 sub prestop {
 495   my ($client, $val) = @_;
 496   return defined($val) ? $preeval->{$client} = $val : $preeval->{$client};
 497 }
 498
 499 sub poststop {
 500   my ($client, $val) = @_;
 501   return defined($val) ? $posteval->{$client} = $val : $posteval->{$client};
 502 }
 503
 504 #
 505 # "pure virtual" methods
 506 #
 507
 508 # client-specific pre/post-stop actions.
 509 sub cprestop {}
 510 sub cpoststop {}
 511
 512 # client complete startup
 513 sub awaken {}
 514
 515 sub skippkg {
 516   my $s = shift;
 517   push @skippkg, @_ if @_;
 518 }
 519
 520 sub evalcode {
 521   my ($client, $val) = @_;
 522   if (defined $val) {
 523     $running = 2;    # hand over to DB() to evaluate in its context
 524     $ineval->{$client} = $val;
 525   }
 526   return $ineval->{$client};
 527 }
 528
 529 sub ready {
 530   my $s = shift;
 531   return $ready = 1;
 532 }
 533
 534 # stubs
 535
 536 sub init {}
 537 sub stop {}
 538 sub idle {}
 539 sub cleanup {}
 540 sub output {}
 541
 542 #
 543 # client init
 544 #
 545 for (@clients) { $_->init }
 546
 547 $SIG{'INT'} = \&DB::catch;
 548
 549 # disable this if stepping through END blocks is desired
 550 # (looks scary and deconstructivist with Swat)
 551 END { $ready = 0 }
 552
 553 1;
 554 __END__
 555
 556 =head1 NAME
 557
 558 DB - programmatic interface to the Perl debugging API (draft, subject to
 559 change)
 560
 561 =head1 SYNOPSIS
 562
 563     package CLIENT;
 564     use DB;
 565     @ISA = qw(DB);
 566
 567     # these (inherited) methods can be called by the client
 568
 569     CLIENT->register()      # register a client package name
 570     CLIENT->done()          # de-register from the debugging API
 571     CLIENT->skippkg('hide::hide')  # ask DB not to stop in this package
 572     CLIENT->cont([WHERE])       # run some more (until BREAK or another breakpt)
 573     CLIENT->step()              # single step
 574     CLIENT->next()              # step over
 575     CLIENT->ret()               # return from current subroutine
 576     CLIENT->backtrace()         # return the call stack description
 577     CLIENT->ready()             # call when client setup is done
 578     CLIENT->trace_toggle()      # toggle subroutine call trace mode
 579     CLIENT->subs([SUBS])        # return subroutine information
 580     CLIENT->files()             # return list of all files known to DB
 581     CLIENT->lines()             # return lines in currently loaded file
 582     CLIENT->loadfile(FILE,LINE) # load a file and let other clients know
 583     CLIENT->lineevents()        # return info on lines with actions
 584     CLIENT->set_break([WHERE],[COND])
 585     CLIENT->set_tbreak([WHERE])
 586     CLIENT->clr_breaks([LIST])
 587     CLIENT->set_action(WHERE,ACTION)
 588     CLIENT->clr_actions([LIST])
 589     CLIENT->evalcode(STRING)  # eval STRING in executing code's context
 590     CLIENT->prestop([STRING]) # execute in code context before stopping
 591     CLIENT->poststop([STRING])# execute in code context before resuming
 592
 593     # These methods will be called at the appropriate times.
 594     # Stub versions provided do nothing.
 595     # None of these can block.
 596
 597     CLIENT->init()          # called when debug API inits itself
 598     CLIENT->stop(FILE,LINE) # when execution stops
 599     CLIENT->idle()          # while stopped (can be a client event loop)
 600     CLIENT->cleanup()       # just before exit
 601     CLIENT->output(LIST)    # called to print any output that API must show
 602
 603 =head1 DESCRIPTION
 604
 605 Perl debug information is frequently required not just by debuggers,
 606 but also by modules that need some "special" information to do their
 607 job properly, like profilers.
 608
 609 This module abstracts and provides all of the hooks into Perl internal
 610 debugging functionality, so that various implementations of Perl debuggers
 611 (or packages that want to simply get at the "privileged" debugging data)
 612 can all benefit from the development of this common code.  Currently used
 613 by Swat, the perl/Tk GUI debugger.
 614
 615 Note that multiple "front-ends" can latch into this debugging API
 616 simultaneously.  This is intended to facilitate things like
 617 debugging with a command line and GUI at the same time, debugging
 618 debuggers etc.  [Sounds nice, but this needs some serious support -- GSAR]
 619
 620 In particular, this API does B<not> provide the following functions:
 621
 622 =over 4
 623
 624 =item *
 625
 626 data display
 627
 628 =item *
 629
 630 command processing
 631
 632 =item *
 633
 634 command alias management
 635
 636 =item *
 637
 638 user interface (tty or graphical)
 639
 640 =back
 641
 642 These are intended to be services performed by the clients of this API.
 643
 644 This module attempts to be squeaky clean w.r.t C<use strict;> and when
 645 warnings are enabled.
 646
 647
 648 =head2 Global Variables
 649
 650 The following "public" global names can be read by clients of this API.
 651 Beware that these should be considered "readonly".
 652
 653 =over 8
 654
 655 =item  $DB::sub
 656
 657 Name of current executing subroutine.
 658
 659 =item  %DB::sub
 660
 661 The keys of this hash are the names of all the known subroutines.  Each value
 662 is an encoded string that has the sprintf(3) format
 663 C<("%s:%d-%d", filename, fromline, toline)>.
 664
 665 =item  $DB::single
 666
 667 Single-step flag.  Will be true if the API will stop at the next statement.
 668
 669 =item  $DB::signal
 670
 671 Signal flag. Will be set to a true value if a signal was caught.  Clients may
 672 check for this flag to abort time-consuming operations.
 673
 674 =item  $DB::trace
 675
 676 This flag is set to true if the API is tracing through subroutine calls.
 677
 678 =item  @DB::args
 679
 680 Contains the arguments of current subroutine, or the C<@ARGV> array if in the
 681 toplevel context.
 682
 683 =item  @DB::dbline
 684
 685 List of lines in currently loaded file.
 686
 687 =item  %DB::dbline
 688
 689 Actions in current file (keys are line numbers).  The values are strings that
 690 have the sprintf(3) format C<("%s\000%s", breakcondition, actioncode)>.
 691
 692 =item  $DB::package
 693
 694 Package namespace of currently executing code.
 695
 696 =item  $DB::filename
 697
 698 Currently loaded filename.
 699
 700 =item  $DB::subname
 701
 702 Fully qualified name of currently executing subroutine.
 703
 704 =item  $DB::lineno
 705
 706 Line number that will be executed next.
 707
 708 =back
 709
 710 =head2 API Methods
 711
 712 The following are methods in the DB base class.  A client must
 713 access these methods by inheritance (*not* by calling them directly),
 714 since the API keeps track of clients through the inheritance
 715 mechanism.
 716
 717 =over 8
 718
 719 =item CLIENT->register()
 720
 721 register a client object/package
 722
 723 =item CLIENT->evalcode(STRING)
 724
 725 eval STRING in executing code context
 726
 727 =item CLIENT->skippkg('D::hide')
 728
 729 ask DB not to stop in these packages
 730
 731 =item CLIENT->run()
 732
 733 run some more (until a breakpt is reached)
 734
 735 =item CLIENT->step()
 736
 737 single step
 738
 739 =item CLIENT->next()
 740
 741 step over
 742
 743 =item CLIENT->done()
 744
 745 de-register from the debugging API
 746
 747 =back
 748
 749 =head2 Client Callback Methods
 750
 751 The following "virtual" methods can be defined by the client.  They will
 752 be called by the API at appropriate points.  Note that unless specified
 753 otherwise, the debug API only defines empty, non-functional default versions
 754 of these methods.
 755
 756 =over 8
 757
 758 =item CLIENT->init()
 759
 760 Called after debug API inits itself.
 761
 762 =item CLIENT->prestop([STRING])
 763
 764 Usually inherited from DB package.  If no arguments are passed,
 765 returns the prestop action string.
 766
 767 =item CLIENT->stop()
 768
 769 Called when execution stops (w/ args file, line).
 770
 771 =item CLIENT->idle()
 772
 773 Called while stopped (can be a client event loop).
 774
 775 =item CLIENT->poststop([STRING])
 776
 777 Usually inherited from DB package.  If no arguments are passed,
 778 returns the poststop action string.
 779
 780 =item CLIENT->evalcode(STRING)
 781
 782 Usually inherited from DB package.  Ask for a STRING to be C<eval>-ed
 783 in executing code context.
 784
 785 =item CLIENT->cleanup()
 786
 787 Called just before exit.
 788
 789 =item CLIENT->output(LIST)
 790
 791 Called when API must show a message (warnings, errors etc.).
 792
 793
 794 =back
 795
 796
 797 =head1 BUGS
 798
 799 The interface defined by this module is missing some of the later additions
 800 to perl's debugging functionality.  As such, this interface should be considered
 801 highly experimental and subject to change.
 802
 803 =head1 AUTHOR
 804
 805 Gurusamy Sarathy        gsar@activestate.com
 806
 807 This code heavily adapted from an early version of perl5db.pl attributable
 808 to Larry Wall and the Perl Porters.
 809
 810 =cut