Lines Matching defs:DB
5 package DB;
18 # them right after a C<require DB;>
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
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
44 $DB::VERSION = $DB::VERSION = '1.0';
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;
73 @DB::ret = &$DB::sub;
74 $DB::single |= pop(@stack);
75 @DB::ret;
78 $DB::ret = &$DB::sub;
79 $DB::single |= pop(@stack);
80 $DB::ret;
87 sub DB {
90 ($DB::package, $DB::filename, $DB::lineno) = caller;
92 return if @skippkg and grep { $_ eq $DB::package } @skippkg;
94 $usrctxt = "package $DB::package;"; # this won't let them modify, alas
95 local(*DB::dbline) = "::_<$DB::filename";
99 # since this is done late, $DB::filename will be "wrong" after
101 if ($^O eq 'MacOS' && $#DB::dbline < 0) {
102 $DB::filename = 'Dev:Pseudo';
103 *DB::dbline = "::_<$DB::filename";
107 if (($stop,$action) = split(/\0/,$DB::dbline{$DB::lineno})) {
109 $DB::signal |= 1;
113 $evalarg = "\$DB::signal |= do { $stop; }"; &eval;
114 $DB::dbline{$DB::lineno} =~ s/;9($|\0)/$1/; # clear any temp breakpt
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);
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;
128 &eval if ($evalarg = DB->prestop);
146 &eval if ($evalarg = DB->poststop);
157 eval "$usrctxt $evalarg; &DB::save";
165 use strict; # this can run only after DB() and sub() are defined
174 $DB::signal = 1;
207 $DB::single = 2;
213 $DB::single = 1;
224 $DB::single = 0;
230 # on how many client call frames are between this call and the DB call).
235 my $i = shift; # how many levels to get to DB sub
238 $DB::single = 0;
244 # on how many client call frames are between this call and the DB call).
253 @a = @DB::args;
273 last if $DB::signal;
287 $DB::trace = !$DB::trace;
301 push @ret, [$DB::sub{$name} =~ /^(.*)\:(\d+)-(\d+)$/]
302 if exists $DB::sub{$name};
306 return keys %DB::sub;
317 $fname = $DB::filename unless $fname;
318 return grep { $DB::sub{$_} =~ /^$fname/ } keys %DB::sub;
322 # returns a list of all filenames that DB knows about
336 return \@DB::dbline;
354 *DB::dbline = "::_<$file";
355 $DB::filename = $file;
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};
383 $i ||= $DB::lineno;
388 if ($DB::dbline[$i] == 0) {
392 $DB::dbline{$i} =~ s/^[^\0]*/$cond/;
403 if ($DB::dbline[$i] == 0) {
407 $DB::dbline{$i} =~ s/($|\0)/;9$1/; # add one-time-only b.p.
415 $name = "${DB::package}\:\:" . $name if $name !~ /::/;
417 my($fname, $from, $to) = ($DB::sub{$name} =~ /^(.*):(\d+)-(\d+)$/);
419 local *DB::dbline = "::_<$fname";
420 ++$from while $DB::dbline[$from] == 0 && $from < $to;
434 if (defined $DB::dbline{$i}) {
435 $DB::dbline{$i} =~ s/^[^\0]+//;
436 if ($DB::dbline{$i} =~ s/^\0?$//) {
437 delete $DB::dbline{$i};
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};
461 if ($DB::dbline[$i] == 0) {
465 $DB::dbline{$i} =~ s/\0[^\0]*//;
466 $DB::dbline{$i} .= "\0" . $act;
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?$//;
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?$//;
524 $running = 2; # hand over to DB() to evaluate in its context
548 $SIG{'INT'} = \&DB::catch;
559 DB - programmatic interface to the Perl debugging API (draft, subject to
565 use DB;
566 @ISA = qw(DB);
572 CLIENT->skippkg('hide::hide') # ask DB not to stop in this package
581 CLIENT->files() # return list of all files known to DB
656 =item $DB::sub
660 =item %DB::sub
666 =item $DB::single
670 =item $DB::signal
675 =item $DB::trace
679 =item @DB::args
684 =item @DB::dbline
688 =item %DB::dbline
693 =item $DB::package
697 =item $DB::filename
701 =item $DB::subname
705 =item $DB::lineno
713 The following are methods in the DB base class. A client must
730 ask DB not to stop in these packages
765 Usually inherited from DB package. If no arguments are passed,
778 Usually inherited from DB package. If no arguments are passed,
783 Usually inherited from DB package. Ask for a STRING to be C<eval>-ed