X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2Fperl5db.pl;h=997b836d93aa722cc92e5be7ec9295ef298169ee;hb=4750257bd21f5a4355221e101326277c013826ec;hp=158510dfebf9bae84a3bc2201ffbce22257c14e0;hpb=3a4b996c622ca8a2cd8d468317fb869865ee25b2;p=p5sagit%2Fp5-mst-13.2.git diff --git a/lib/perl5db.pl b/lib/perl5db.pl index 158510d..997b836 100644 --- a/lib/perl5db.pl +++ b/lib/perl5db.pl @@ -1,7 +1,7 @@ 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 @@ -316,6 +316,10 @@ sub eval { # + m(methods), M(modules) # ... (was m,v) # + o(option) # lc (was O) # + v(view code), V(view Variables) # ... (was w,V) +# Changes: 1.18: Mar 17, 2002 Richard Foley +# + fixed missing cmd_O bug +# Changes: 1.19: Mar 29, 2002 Spider Boardman +# + Added missing local()s -- DB::DB is called recursively. # #################################################################### @@ -438,7 +442,7 @@ if (defined $ENV{PERLDB_PIDS}) { $term_pid = -1; } else { $ENV{PERLDB_PIDS} = "$$"; - $pids = ''; + $pids = "{pid=$$}"; $term_pid = $$; } $pidprompt = ''; @@ -662,9 +666,9 @@ sub DB { } $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}; @@ -675,7 +679,7 @@ sub DB { *dbline = $main::{'_<' . $filename}; } - $max = $#dbline; + local $max = $#dbline; if ($dbline{$line} && (($stop,$action) = split(/\0/,$dbline{$line}))) { if ($stop eq '1') { $signal |= 1; @@ -893,7 +897,7 @@ EOP $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; }; @@ -976,7 +980,28 @@ EOP } $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; @@ -1253,7 +1278,7 @@ EOP } } next CMD; }; - $cmd =~ /^\@\s*(.*\S)/ && do { + $cmd =~ /^source\s+(.*\S)/ && do { if (open my $fh, $1) { push @cmdfhs, $fh; } else { @@ -1441,7 +1466,7 @@ sub cmd_wrapper { my $call = 'cmd_'.( $set{$CommandSet}{$cmd} || $cmd ); - # print "rjsf: cmd_wrapper($cmd): $CommandSet($set{$CommandSet}{$cmd}) => call($call)\n"; + # print "cmd_wrapper($cmd): $CommandSet($set{$CommandSet}{$cmd}) => call($call)\n"; return &$call($line, $dblineno); } @@ -1885,6 +1910,12 @@ sub cmd_o { } } +sub cmd_O { + print $OUT "The old O command is now the o command.\n"; # hint + print $OUT "Use 'h' to get current command help synopsis or\n"; # + print $OUT "use 'o CommandSet=pre580' to revert to old usage\n"; # +} + sub cmd_v { my $line = shift; @@ -2232,6 +2263,9 @@ sub os2_get_fork_TTY { $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 @@ -2240,6 +2274,8 @@ sub os2_get_fork_TTY { 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, ' I Run cmd in a subprocess (reads from DB::IN, writes to DB::O . ( $rc eq $sh ? "" : " B<$psh> [I] Run I in subshell (forces \"\$SHELL -c 'cmd'\")." ) . " See 'B I' too. -B<@>I Execute I containing debugger commands (may nest). +B I Execute I containing debugger commands (may nest). B I<-number> Display last number commands (default all). B

I Same as \"I\" in current package. B<|>I Run debugger command, piping DB::OUT to current pager. @@ -2800,7 +2836,7 @@ I B List break/watch/act B [I<-num>] Display last num commands B [I] I Do cmd before line B<=> [I I] Define/list an alias B I Delete a/all actions B [I] Get help on command B I Add a watch expression - B Complete help page B I Delete a/all watch expressions + B Complete help page B I Delete a/all watch exprs B<|>[B<|>]I Send output to pager B<$psh>\[B<$psh>\] I Run cmd in a subprocess B or B<^D> Quit B Attempt a restart I B Execute perl code, also see: B,B,B I @@ -2809,6 +2845,7 @@ I B Execute perl code, also see: B,B,B B [[B]I] List subroutine names [not] matching pattern B [I [I]] List Variables in Package. Vars can be ~pattern or !pattern. B [I] Same as \"B I [I]\". + B [I [I]] List lexicals in higher scope . Vars same as B. For more help, type B I, or run B<$doccmd perldebug> for all docs. END_SUM # ')}}; # Fix balance of vi % matching @@ -2893,7 +2930,7 @@ B<$psh$psh> I Run cmd in a subprocess (reads from DB::IN, writes to DB::O . ( $rc eq $sh ? "" : " B<$psh> [I] Run I in subshell (forces \"\$SHELL -c 'cmd'\")." ) . " See 'B I' too. -B<@>I Execute I containing debugger commands (may nest). +B I Execute I containing debugger commands (may nest). B I<-number> Display last number commands (default all). B

I Same as \"I\" in current package. B<|>I Run debugger command, piping DB::OUT to current pager. @@ -2976,6 +3013,7 @@ I B Execute perl code, also see: B,B,B B [[B]I] List subroutine names [not] matching pattern B [I [I]] List Variables in Package. Vars can be ~pattern or !pattern. B [I] Same as \"B I [I]\". + B [I [I]] List lexicals in higher scope . Vars same as B. For more help, type B I, or run B<$doccmd perldebug> for all docs. END_SUM # ')}}; # Fix balance of vi % matching