package DB;
# Debugger for Perl 5.00x; perl5db.pl patch level:
-$VERSION = 1.17;
+$VERSION = 1.19;
$header = "perl5db.pl version $VERSION";
# It is crucial that there is no lexicals in scope of `eval ""' down below
# + v(view code), V(view Variables) # ... (was w,V)
# Changes: 1.18: Mar 17, 2002 Richard Foley <richard.foley@rfi.net>
# + fixed missing cmd_O bug
+# Changes: 1.19: Mar 29, 2002 Spider Boardman
+# + Added missing local()s -- DB::DB is called recursively.
#
####################################################################
$term_pid = -1;
} else {
$ENV{PERLDB_PIDS} = "$$";
- $pids = '';
+ $pids = "{pid=$$}";
$term_pid = $$;
}
$pidprompt = '';
}
$runnonstop = 0 if $single or $signal; # Disable it if interactive.
&save;
- ($package, $filename, $line) = caller;
- $filename_ini = $filename;
- $usercontext = '($@, $!, $^E, $,, $/, $\, $^W) = @saved;' .
+ local($package, $filename, $line) = caller;
+ local $filename_ini = $filename;
+ local $usercontext = '($@, $!, $^E, $,, $/, $\, $^W) = @saved;' .
"package $package;"; # this won't let them modify, alas
local(*dbline) = $main::{'_<' . $filename};
*dbline = $main::{'_<' . $filename};
}
- $max = $#dbline;
+ local $max = $#dbline;
if ($dbline{$line} && (($stop,$action) = split(/\0/,$dbline{$line}))) {
if ($stop eq '1') {
$signal |= 1;
$incr = $window - 1;
$cmd = 'l ' . ($start) . '+'; };
# rjsf ->
- $cmd =~ /^([aAbBDhlLMoOvwW])\b\s*(.*)/s && do {
+ $cmd =~ /^([aAbBhlLMoOvwW])\b\s*(.*)/s && do {
&cmd_wrapper($1, $2, $line);
next CMD;
};
}
$pretype = [$1];
next CMD; };
- $cmd =~ /^n$/ && do {
+ $cmd =~ /^y(?:\s+(\d*)\s*(.*))?$/ && do {
+ eval { require PadWalker; PadWalker->VERSION(0.08) }
+ or &warn($@ =~ /locate/
+ ? "PadWalker module not found - please install\n"
+ : $@)
+ and next CMD;
+ do 'dumpvar.pl' unless defined &main::dumpvar;
+ defined &main::dumpvar
+ or print $OUT "dumpvar.pl not available.\n"
+ and next CMD;
+ my @vars = split(' ', $2 || '');
+ my $h = eval { PadWalker::peek_my(($1 || 0) + 1) };
+ $@ and $@ =~ s/ at .*//, &warn($@), next CMD;
+ my $savout = select($OUT);
+ dumpvar::dumplex($_, $h->{$_},
+ defined $option{dumpDepth}
+ ? $option{dumpDepth} : -1,
+ @vars)
+ for sort keys %$h;
+ select($savout);
+ next CMD; };
+ $cmd =~ /^n$/ && do {
end_report(), next CMD if $finished and $level <= 1;
$single = 2;
$laststep = $cmd;
}
}
next CMD; };
- $cmd =~ /^\@\s*(.*\S)/ && do {
+ $cmd =~ /^source\s+(.*\S)/ && do {
if (open my $fh, $1) {
push @cmdfhs, $fh;
} else {
$ENV{PERL5OPT} =~ s/(?:^|(?<=\s))-d\b// if $ENV{PERL5OPT};
$ENV{PERL5OPT} =~ s/(?:^|(?<=\s))-d\B/-/ if $ENV{PERL5OPT};
print $OUT "Making kid PERL5OPT->`$ENV{PERL5OPT}'.\n" if $ENV{PERL5OPT};
+ local $ENV{PERL5LIB} = $ENV{PERL5LIB} ? $ENV{PERL5LIB} : $ENV{PERLLIB};
+ $ENV{PERL5LIB} = '' unless defined $ENV{PERL5LIB};
+ $ENV{PERL5LIB} = join ';', @ini_INC, split /;/, $ENV{PERL5LIB};
(my $name = $0) =~ s,^.*[/\\],,s;
my @args;
if ( pipe $in1, $out1 and pipe $in2, $out2
and @args = ($rl, fileno $in1, fileno $out2,
"Daughter Perl debugger $pids $name") and
(($kpid = CORE::system 4, $^X, '-we', <<'ES', @args) >= 0 # P_SESSION
+END {sleep 5 unless $loaded}
+BEGIN {open STDIN, '</dev/con' or warn "reopen stdin: $!"}
use OS2::Process;
my ($rl, $in) = (shift, shift); # Read from $in and pass through
. ( $rc eq $sh ? "" : "
B<$psh> [I<cmd>] Run I<cmd> in subshell (forces \"\$SHELL -c 'cmd'\")." ) . "
See 'B<O> I<shellBang>' too.
-B<@>I<file> Execute I<file> containing debugger commands (may nest).
+B<source> I<file> Execute I<file> containing debugger commands (may nest).
B<H> I<-number> Display last number commands (default all).
B<p> I<expr> Same as \"I<print {DB::OUT} expr>\" in current package.
B<|>I<dbcmd> Run debugger command, piping DB::OUT to current pager.
B<H> [I<-num>] Display last num commands B<a> [I<ln>] I<cmd> Do cmd before line
B<=> [I<a> I<val>] Define/list an alias B<A> I<ln|*> Delete a/all actions
B<h> [I<db_cmd>] Get help on command B<w> I<expr> Add a watch expression
- B<h h> Complete help page B<W> I<expr|*> Delete a/all watch expressions
+ B<h h> Complete help page B<W> I<expr|*> Delete a/all watch exprs
B<|>[B<|>]I<db_cmd> Send output to pager B<$psh>\[B<$psh>\] I<syscmd> Run cmd in a subprocess
B<q> or B<^D> Quit B<R> Attempt a restart
I<Data Examination:> B<expr> Execute perl code, also see: B<s>,B<n>,B<t> I<expr>
. ( $rc eq $sh ? "" : "
B<$psh> [I<cmd>] Run I<cmd> in subshell (forces \"\$SHELL -c 'cmd'\")." ) . "
See 'B<O> I<shellBang>' too.
-B<@>I<file> Execute I<file> containing debugger commands (may nest).
+B<source> I<file> Execute I<file> containing debugger commands (may nest).
B<H> I<-number> Display last number commands (default all).
B<p> I<expr> Same as \"I<print {DB::OUT} expr>\" in current package.
B<|>I<dbcmd> Run debugger command, piping DB::OUT to current pager.