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