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 #  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     local *DB::dbline = "::_<$fname";
 410     ++$from while $DB::dbline[$from] == 0 && $from < $to;
 411     return $from;
 412   }
 413   return undef;
 414 }
 415
 416 sub clr_breaks {
 417   my $s = shift;
 418   my $i;
 419   if (@_) {
 420     while (@_) {
 421       $i = shift;
 422       $i = _find_subline($i) if ($i =~ /\D/);
 423       $s->output("Subroutine not found.\n") unless $i;
 424       if (defined $DB::dbline{$i}) {
 425         $DB::dbline{$i} =~ s/^[^\0]+//;
 426         if ($DB::dbline{$i} =~ s/^\0?$//) {
 427           delete $DB::dbline{$i};
 428         }
 429       }
 430     }
 431   }
 432   else {
 433     for ($i = 1; $i <= $#DB::dbline ; $i++) {
 434       if (defined $DB::dbline{$i}) {
 435         $DB::dbline{$i} =~ s/^[^\0]+//;
 436         if ($DB::dbline{$i} =~ s/^\0?$//) {
 437           delete $DB::dbline{$i};
 438         }
 439       }
 440     }
 441   }
 442 }
 443
 444 sub set_action {
 445   my $s = shift;
 446   my $i = shift;
 447   my $act = shift;
 448   $i = _find_subline($i) if ($i =~ /\D/);
 449   $s->output("Subroutine not found.\n") unless $i;
 450   if ($i) {
 451     if ($DB::dbline[$i] == 0) {
 452       $s->output("Line $i not actionable.\n");
 453     }
 454     else {
 455       $DB::dbline{$i} =~ s/\0[^\0]*//;
 456       $DB::dbline{$i} .= "\0" . $act;
 457     }
 458   }
 459 }
 460
 461 sub clr_actions {
 462   my $s = shift;
 463   my $i;
 464   if (@_) {
 465     while (@_) {
 466       my $i = shift;
 467       $i = _find_subline($i) if ($i =~ /\D/);
 468       $s->output("Subroutine not found.\n") unless $i;
 469       if ($i && $DB::dbline[$i] != 0) {
 470         $DB::dbline{$i} =~ s/\0[^\0]*//;
 471         delete $DB::dbline{$i} if $DB::dbline{$i} =~ s/^\0?$//;
 472       }
 473     }
 474   }
 475   else {
 476     for ($i = 1; $i <= $#DB::dbline ; $i++) {
 477       if (defined $DB::dbline{$i}) {
 478         $DB::dbline{$i} =~ s/\0[^\0]*//;
 479         delete $DB::dbline{$i} if $DB::dbline{$i} =~ s/^\0?$//;
 480       }
 481     }
 482   }
 483 }
 484
 485 sub prestop {
 486   my ($client, $val) = @_;
 487   return defined($val) ? $preeval->{$client} = $val : $preeval->{$client};
 488 }
 489
 490 sub poststop {
 491   my ($client, $val) = @_;
 492   return defined($val) ? $posteval->{$client} = $val : $posteval->{$client};
 493 }
 494
 495 #
 496 # "pure virtual" methods
 497 #
 498
 499 # client-specific pre/post-stop actions.
 500 sub cprestop {}
 501 sub cpoststop {}
 502
 503 # client complete startup
 504 sub awaken {}
 505
 506 sub skippkg {
 507   my $s = shift;
 508   push @skippkg, @_ if @_;
 509 }
 510
 511 sub evalcode {
 512   my ($client, $val) = @_;
 513   if (defined $val) {
 514     $running = 2;    # hand over to DB() to evaluate in its context
 515     $ineval->{$client} = $val;
 516   }
 517   return $ineval->{$client};
 518 }
 519
 520 sub ready {
 521   my $s = shift;
 522   return $ready = 1;
 523 }
 524
 525 # stubs
 526
 527 sub init {}
 528 sub stop {}
 529 sub idle {}
 530 sub cleanup {}
 531 sub output {}
 532
 533 #
 534 # client init
 535 #
 536 for (@clients) { $_->init }
 537
 538 $SIG{'INT'} = \&DB::catch;
 539
 540 # disable this if stepping through END blocks is desired
 541 # (looks scary and deconstructivist with Swat)
 542 END { $ready = 0 }
 543
 544 1;
 545 __END__
 546
 547 =head1 NAME
 548
 549 DB - programmatic interface to the Perl debugging API (draft, subject to
 550 change)
 551
 552 =head1 SYNOPSIS
 553
 554     package CLIENT;
 555     use DB;
 556     @ISA = qw(DB);
 557
 558     # these (inherited) methods can be called by the client
 559
 560     CLIENT->register()      # register a client package name
 561     CLIENT->done()          # de-register from the debugging API
 562     CLIENT->skippkg('hide::hide')  # ask DB not to stop in this package
 563     CLIENT->cont([WHERE])       # run some more (until BREAK or another breakpt)
 564     CLIENT->step()              # single step
 565     CLIENT->next()              # step over
 566     CLIENT->ret()               # return from current subroutine
 567     CLIENT->backtrace()         # return the call stack description
 568     CLIENT->ready()             # call when client setup is done
 569     CLIENT->trace_toggle()      # toggle subroutine call trace mode
 570     CLIENT->subs([SUBS])        # return subroutine information
 571     CLIENT->files()             # return list of all files known to DB
 572     CLIENT->lines()             # return lines in currently loaded file
 573     CLIENT->loadfile(FILE,LINE) # load a file and let other clients know
 574     CLIENT->lineevents()        # return info on lines with actions
 575     CLIENT->set_break([WHERE],[COND])
 576     CLIENT->set_tbreak([WHERE])
 577     CLIENT->clr_breaks([LIST])
 578     CLIENT->set_action(WHERE,ACTION)
 579     CLIENT->clr_actions([LIST])
 580     CLIENT->evalcode(STRING)  # eval STRING in executing code's context
 581     CLIENT->prestop([STRING]) # execute in code context before stopping
 582     CLIENT->poststop([STRING])# execute in code context before resuming
 583
 584     # These methods will be called at the appropriate times.
 585     # Stub versions provided do nothing.
 586     # None of these can block.
 587
 588     CLIENT->init()          # called when debug API inits itself
 589     CLIENT->stop(FILE,LINE) # when execution stops
 590     CLIENT->idle()          # while stopped (can be a client event loop)
 591     CLIENT->cleanup()       # just before exit
 592     CLIENT->output(LIST)    # called to print any output that API must show
 593
 594 =head1 DESCRIPTION
 595
 596 Perl debug information is frequently required not just by debuggers,
 597 but also by modules that need some "special" information to do their
 598 job properly, like profilers.
 599
 600 This module abstracts and provides all of the hooks into Perl internal
 601 debugging functionality, so that various implementations of Perl debuggers
 602 (or packages that want to simply get at the "privileged" debugging data)
 603 can all benefit from the development of this common code.  Currently used
 604 by Swat, the perl/Tk GUI debugger.
 605
 606 Note that multiple "front-ends" can latch into this debugging API
 607 simultaneously.  This is intended to facilitate things like
 608 debugging with a command line and GUI at the same time, debugging
 609 debuggers etc.  [Sounds nice, but this needs some serious support -- GSAR]
 610
 611 In particular, this API does B<not> provide the following functions:
 612
 613 =over 4
 614
 615 =item *
 616
 617 data display
 618
 619 =item *
 620
 621 command processing
 622
 623 =item *
 624
 625 command alias management
 626
 627 =item *
 628
 629 user interface (tty or graphical)
 630
 631 =back
 632
 633 These are intended to be services performed by the clients of this API.
 634
 635 This module attempts to be squeaky clean w.r.t C<use strict;> and when
 636 warnings are enabled.
 637
 638
 639 =head2 Global Variables
 640
 641 The following "public" global names can be read by clients of this API.
 642 Beware that these should be considered "readonly".
 643
 644 =over 8
 645
 646 =item  $DB::sub
 647
 648 Name of current executing subroutine.
 649
 650 =item  %DB::sub
 651
 652 The keys of this hash are the names of all the known subroutines.  Each value
 653 is an encoded string that has the sprintf(3) format
 654 C<("%s:%d-%d", filename, fromline, toline)>.
 655
 656 =item  $DB::single
 657
 658 Single-step flag.  Will be true if the API will stop at the next statement.
 659
 660 =item  $DB::signal
 661
 662 Signal flag. Will be set to a true value if a signal was caught.  Clients may
 663 check for this flag to abort time-consuming operations.
 664
 665 =item  $DB::trace
 666
 667 This flag is set to true if the API is tracing through subroutine calls.
 668
 669 =item  @DB::args
 670
 671 Contains the arguments of current subroutine, or the C<@ARGV> array if in the
 672 toplevel context.
 673
 674 =item  @DB::dbline
 675
 676 List of lines in currently loaded file.
 677
 678 =item  %DB::dbline
 679
 680 Actions in current file (keys are line numbers).  The values are strings that
 681 have the sprintf(3) format C<("%s\000%s", breakcondition, actioncode)>.
 682
 683 =item  $DB::package
 684
 685 Package namespace of currently executing code.
 686
 687 =item  $DB::filename
 688
 689 Currently loaded filename.
 690
 691 =item  $DB::subname
 692
 693 Fully qualified name of currently executing subroutine.
 694
 695 =item  $DB::lineno
 696
 697 Line number that will be executed next.
 698
 699 =back
 700
 701 =head2 API Methods
 702
 703 The following are methods in the DB base class.  A client must
 704 access these methods by inheritance (*not* by calling them directly),
 705 since the API keeps track of clients through the inheritance
 706 mechanism.
 707
 708 =over 8
 709
 710 =item CLIENT->register()
 711
 712 register a client object/package
 713
 714 =item CLIENT->evalcode(STRING)
 715
 716 eval STRING in executing code context
 717
 718 =item CLIENT->skippkg('D::hide')
 719
 720 ask DB not to stop in these packages
 721
 722 =item CLIENT->run()
 723
 724 run some more (until a breakpt is reached)
 725
 726 =item CLIENT->step()
 727
 728 single step
 729
 730 =item CLIENT->next()
 731
 732 step over
 733
 734 =item CLIENT->done()
 735
 736 de-register from the debugging API
 737
 738 =back
 739
 740 =head2 Client Callback Methods
 741
 742 The following "virtual" methods can be defined by the client.  They will
 743 be called by the API at appropriate points.  Note that unless specified
 744 otherwise, the debug API only defines empty, non-functional default versions
 745 of these methods.
 746
 747 =over 8
 748
 749 =item CLIENT->init()
 750
 751 Called after debug API inits itself.
 752
 753 =item CLIENT->prestop([STRING])
 754
 755 Usually inherited from DB package.  If no arguments are passed,
 756 returns the prestop action string.
 757
 758 =item CLIENT->stop()
 759
 760 Called when execution stops (w/ args file, line).
 761
 762 =item CLIENT->idle()
 763
 764 Called while stopped (can be a client event loop).
 765
 766 =item CLIENT->poststop([STRING])
 767
 768 Usually inherited from DB package.  If no arguments are passed,
 769 returns the poststop action string.
 770
 771 =item CLIENT->evalcode(STRING)
 772
 773 Usually inherited from DB package.  Ask for a STRING to be C<eval>-ed
 774 in executing code context.
 775
 776 =item CLIENT->cleanup()
 777
 778 Called just before exit.
 779
 780 =item CLIENT->output(LIST)
 781
 782 Called when API must show a message (warnings, errors etc.).
 783
 784
 785 =back
 786
 787
 788 =head1 BUGS
 789
 790 The interface defined by this module is missing some of the later additions
 791 to perl's debugging functionality.  As such, this interface should be considered
 792 highly experimental and subject to change.
 793
 794 =head1 AUTHOR
 795
 796 Gurusamy Sarathy        gsar@activestate.com
 797
 798 This code heavily adapted from an early version of perl5db.pl attributable
 799 to Larry Wall and the Perl Porters.
 800
 801 =cut