home *** CD-ROM | disk | FTP | other *** search
/ Chip 2000 May / Chip_2000-05_cd1.bin / zkuste / Perl / ActivePerl-5.6.0.613.msi / 䆊䌷䈹䈙䏵-䞅䞆䞀㡆䞃䄦䠥 / _319b8f6e609cd404ff383d5609420527 < prev    next >
Encoding:
Text File  |  2000-03-15  |  19.3 KB  |  803 lines
  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
  803.