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