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.02';
  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
 559
 560 =head1 SYNOPSIS
 561
 562     package CLIENT;
 563     use DB;
 564     @ISA = qw(DB);
 565
 566     # these (inherited) methods can be called by the client
 567
 568     CLIENT->register()      # register a client package name
 569     CLIENT->done()          # de-register from the debugging API
 570     CLIENT->skippkg('hide::hide')  # ask DB not to stop in this package
 571     CLIENT->cont([WHERE])       # run some more (until BREAK or another breakpt)
 572     CLIENT->step()              # single step
 573     CLIENT->next()              # step over
 574     CLIENT->ret()               # return from current subroutine
 575     CLIENT->backtrace()         # return the call stack description
 576     CLIENT->ready()             # call when client setup is done
 577     CLIENT->trace_toggle()      # toggle subroutine call trace mode
 578     CLIENT->subs([SUBS])        # return subroutine information
 579     CLIENT->files()             # return list of all files known to DB
 580     CLIENT->lines()             # return lines in currently loaded file
 581     CLIENT->loadfile(FILE,LINE) # load a file and let other clients know
 582     CLIENT->lineevents()        # return info on lines with actions
 583     CLIENT->set_break([WHERE],[COND])
 584     CLIENT->set_tbreak([WHERE])
 585     CLIENT->clr_breaks([LIST])
 586     CLIENT->set_action(WHERE,ACTION)
 587     CLIENT->clr_actions([LIST])
 588     CLIENT->evalcode(STRING)  # eval STRING in executing code's context
 589     CLIENT->prestop([STRING]) # execute in code context before stopping
 590     CLIENT->poststop([STRING])# execute in code context before resuming
 591
 592     # These methods will be called at the appropriate times.
 593     # Stub versions provided do nothing.
 594     # None of these can block.
 595
 596     CLIENT->init()          # called when debug API inits itself
 597     CLIENT->stop(FILE,LINE) # when execution stops
 598     CLIENT->idle()          # while stopped (can be a client event loop)
 599     CLIENT->cleanup()       # just before exit
 600     CLIENT->output(LIST)    # called to print any output that API must show
 601
 602 =head1 DESCRIPTION
 603
 604 Perl debug information is frequently required not just by debuggers,
 605 but also by modules that need some "special" information to do their
 606 job properly, like profilers.
 607
 608 This module abstracts and provides all of the hooks into Perl internal
 609 debugging functionality, so that various implementations of Perl debuggers
 610 (or packages that want to simply get at the "privileged" debugging data)
 611 can all benefit from the development of this common code.  Currently used
 612 by Swat, the perl/Tk GUI debugger.
 613
 614 Note that multiple "front-ends" can latch into this debugging API
 615 simultaneously.  This is intended to facilitate things like
 616 debugging with a command line and GUI at the same time, debugging
 617 debuggers etc.  [Sounds nice, but this needs some serious support -- GSAR]
 618
 619 In particular, this API does B<not> provide the following functions:
 620
 621 =over 4
 622
 623 =item *
 624
 625 data display
 626
 627 =item *
 628
 629 command processing
 630
 631 =item *
 632
 633 command alias management
 634
 635 =item *
 636
 637 user interface (tty or graphical)
 638
 639 =back
 640
 641 These are intended to be services performed by the clients of this API.
 642
 643 This module attempts to be squeaky clean w.r.t C<use strict;> and when
 644 warnings are enabled.
 645
 646
 647 =head2 Global Variables
 648
 649 The following "public" global names can be read by clients of this API.
 650 Beware that these should be considered "readonly".
 651
 652 =over 8
 653
 654 =item  $DB::sub
 655
 656 Name of current executing subroutine.
 657
 658 =item  %DB::sub
 659
 660 The keys of this hash are the names of all the known subroutines.  Each value
 661 is an encoded string that has the sprintf(3) format
 662 C<("%s:%d-%d", filename, fromline, toline)>.
 663
 664 =item  $DB::single
 665
 666 Single-step flag.  Will be true if the API will stop at the next statement.
 667
 668 =item  $DB::signal
 669
 670 Signal flag. Will be set to a true value if a signal was caught.  Clients may
 671 check for this flag to abort time-consuming operations.
 672
 673 =item  $DB::trace
 674
 675 This flag is set to true if the API is tracing through subroutine calls.
 676
 677 =item  @DB::args
 678
 679 Contains the arguments of current subroutine, or the C<@ARGV> array if in the
 680 toplevel context.
 681
 682 =item  @DB::dbline
 683
 684 List of lines in currently loaded file.
 685
 686 =item  %DB::dbline
 687
 688 Actions in current file (keys are line numbers).  The values are strings that
 689 have the sprintf(3) format C<("%s\000%s", breakcondition, actioncode)>.
 690
 691 =item  $DB::package
 692
 693 Package namespace of currently executing code.
 694
 695 =item  $DB::filename
 696
 697 Currently loaded filename.
 698
 699 =item  $DB::subname
 700
 701 Fully qualified name of currently executing subroutine.
 702
 703 =item  $DB::lineno
 704
 705 Line number that will be executed next.
 706
 707 =back
 708
 709 =head2 API Methods
 710
 711 The following are methods in the DB base class.  A client must
 712 access these methods by inheritance (*not* by calling them directly),
 713 since the API keeps track of clients through the inheritance
 714 mechanism.
 715
 716 =over 8
 717
 718 =item CLIENT->register()
 719
 720 register a client object/package
 721
 722 =item CLIENT->evalcode(STRING)
 723
 724 eval STRING in executing code context
 725
 726 =item CLIENT->skippkg('D::hide')
 727
 728 ask DB not to stop in these packages
 729
 730 =item CLIENT->run()
 731
 732 run some more (until a breakpt is reached)
 733
 734 =item CLIENT->step()
 735
 736 single step
 737
 738 =item CLIENT->next()
 739
 740 step over
 741
 742 =item CLIENT->done()
 743
 744 de-register from the debugging API
 745
 746 =back
 747
 748 =head2 Client Callback Methods
 749
 750 The following "virtual" methods can be defined by the client.  They will
 751 be called by the API at appropriate points.  Note that unless specified
 752 otherwise, the debug API only defines empty, non-functional default versions
 753 of these methods.
 754
 755 =over 8
 756
 757 =item CLIENT->init()
 758
 759 Called after debug API inits itself.
 760
 761 =item CLIENT->prestop([STRING])
 762
 763 Usually inherited from DB package.  If no arguments are passed,
 764 returns the prestop action string.
 765
 766 =item CLIENT->stop()
 767
 768 Called when execution stops (w/ args file, line).
 769
 770 =item CLIENT->idle()
 771
 772 Called while stopped (can be a client event loop).
 773
 774 =item CLIENT->poststop([STRING])
 775
 776 Usually inherited from DB package.  If no arguments are passed,
 777 returns the poststop action string.
 778
 779 =item CLIENT->evalcode(STRING)
 780
 781 Usually inherited from DB package.  Ask for a STRING to be C<eval>-ed
 782 in executing code context.
 783
 784 =item CLIENT->cleanup()
 785
 786 Called just before exit.
 787
 788 =item CLIENT->output(LIST)
 789
 790 Called when API must show a message (warnings, errors etc.).
 791
 792
 793 =back
 794
 795
 796 =head1 BUGS
 797
 798 The interface defined by this module is missing some of the later additions
 799 to perl's debugging functionality.  As such, this interface should be considered
 800 highly experimental and subject to change.
 801
 802 =head1 AUTHOR
 803
 804 Gurusamy Sarathy        gsar@activestate.com
 805
 806 This code heavily adapted from an early version of perl5db.pl attributable
 807 to Larry Wall and the Perl Porters.
 808
 809 =cut