# interpreter, though the values used by perl5db.pl have the form
# "$break_condition\0$action". Values are magical in numeric context.
#
-# The scalar ${'_<'.$filename} contains "_<$filename".
+# The scalar ${'_<'.$filename} contains $filename.
#
# Note that no subroutine call is possible until &DB::sub is defined
# (for subroutines defined outside of the package DB). In fact the same is
);
# These guys may be defined in $ENV{PERL5DB} :
-$rl = 1 unless defined $rl;
-$warnLevel = 1 unless defined $warnLevel;
-$dieLevel = 1 unless defined $dieLevel;
-$signalLevel = 1 unless defined $signalLevel;
-$pre = [] unless defined $pre;
-$post = [] unless defined $post;
-$pretype = [] unless defined $pretype;
+$rl = 1 unless defined $rl;
+$warnLevel = 0 unless defined $warnLevel;
+$dieLevel = 0 unless defined $dieLevel;
+$signalLevel = 1 unless defined $signalLevel;
+$pre = [] unless defined $pre;
+$post = [] unless defined $post;
+$pretype = [] unless defined $pretype;
warnLevel($warnLevel);
dieLevel($dieLevel);
next CMD;
}
}
- $cmd =~ /^q$/ && ($exiting = 1) && exit 0;
+ $cmd =~ /^q$/ && ($exiting = 1) && exit $?;
$cmd =~ /^h$/ && do {
print_help($help);
next CMD; };
print $OUT "Will stop on load of `@{[join '\', `', sort keys %break_on_load]}'.\n";
next CMD; };
$cmd =~ /^b\b\s*(postpone|compile)\b\s*([':A-Za-z_][':\w]*)\s*(.*)/ && do {
- my $cond = $3 || '1';
+ my $cond = length $3 ? $3 : '1';
my ($subname, $break) = ($2, $1 eq 'postpone');
- $subname =~ s/\'/::/;
+ $subname =~ s/\'/::/g;
$subname = "${'package'}::" . $subname
unless $subname =~ /::/;
$subname = "main".$subname if substr($subname,0,2) eq "::";
next CMD; };
$cmd =~ /^b\b\s*([':A-Za-z_][':\w]*(?:\[.*\])?)\s*(.*)/ && do {
$subname = $1;
- $cond = $2 || '1';
- $subname =~ s/\'/::/;
+ $cond = length $2 ? $2 : '1';
+ $subname =~ s/\'/::/g;
$subname = "${'package'}::" . $subname
unless $subname =~ /::/;
$subname = "main".$subname if substr($subname,0,2) eq "::";
next CMD; };
$cmd =~ /^b\b\s*(\d*)\s*(.*)/ && do {
$i = $1 || $line;
- $cond = $2 || '1';
+ $cond = length $2 ? $2 : '1';
if ($dbline[$i] == 0) {
print $OUT "Line $i not breakable.\n";
} else {
next CMD; };
$cmd =~ /^d\b\s*(\d*)/ && do {
$i = $1 || $line;
- $dbline{$i} =~ s/^[^\0]*//;
- delete $dbline{$i} if $dbline{$i} eq '';
+ if ($dbline[$i] == 0) {
+ print $OUT "Line $i not breakable.\n";
+ } else {
+ $dbline{$i} =~ s/^[^\0]*//;
+ delete $dbline{$i} if $dbline{$i} eq '';
+ }
next CMD; };
$cmd =~ /^A$/ && do {
print $OUT "Deleting all actions...\n";
next CMD; };
$cmd =~ /^<\s*(.*)/ && do {
unless ($1) {
- print OUT "All < actions cleared.\n";
+ print $OUT "All < actions cleared.\n";
$pre = [];
next CMD;
}
if ($1 eq '?') {
unless (@$pre) {
- print OUT "No pre-prompt Perl actions.\n";
+ print $OUT "No pre-prompt Perl actions.\n";
next CMD;
}
- print OUT "Perl commands run before each prompt:\n";
+ print $OUT "Perl commands run before each prompt:\n";
for my $action ( @$pre ) {
- print "\t< -- $action\n";
+ print $OUT "\t< -- $action\n";
}
next CMD;
}
next CMD; };
$cmd =~ /^>\s*(.*)/ && do {
unless ($1) {
- print OUT "All > actions cleared.\n";
+ print $OUT "All > actions cleared.\n";
$post = [];
next CMD;
}
if ($1 eq '?') {
unless (@$post) {
- print OUT "No post-prompt Perl actions.\n";
+ print $OUT "No post-prompt Perl actions.\n";
next CMD;
}
- print OUT "Perl commands run after each prompt:\n";
+ print $OUT "Perl commands run after each prompt:\n";
for my $action ( @$post ) {
- print "\t> -- $action\n";
+ print $OUT "\t> -- $action\n";
}
next CMD;
}
next CMD; };
$cmd =~ /^\{\{\s*(.*)/ && do {
if ($cmd =~ /^\{.*\}$/ && unbalanced(substr($cmd,2))) {
- print OUT "{{ is now a debugger command\n",
+ print $OUT "{{ is now a debugger command\n",
"use `;{{' if you mean Perl code\n";
$cmd = "h {{";
redo CMD;
next CMD; };
$cmd =~ /^\{\s*(.*)/ && do {
unless ($1) {
- print OUT "All { actions cleared.\n";
+ print $OUT "All { actions cleared.\n";
$pretype = [];
next CMD;
}
if ($1 eq '?') {
unless (@$pretype) {
- print OUT "No pre-prompt debugger actions.\n";
+ print $OUT "No pre-prompt debugger actions.\n";
next CMD;
}
- print OUT "Debugger commands run before each prompt:\n";
+ print $OUT "Debugger commands run before each prompt:\n";
for my $action ( @$pretype ) {
- print "\t{ -- $action\n";
+ print $OUT "\t{ -- $action\n";
}
next CMD;
}
if ($cmd =~ /^\{.*\}$/ && unbalanced(substr($cmd,1))) {
- print OUT "{ is now a debugger command\n",
+ print $OUT "{ is now a debugger command\n",
"use `;{' if you mean Perl code\n";
$cmd = "h {";
redo CMD;
local $otrace = $trace;
local $osingle = $single;
local $od = $^D;
+ { ($evalarg) = $evalarg =~ /(.*)/s; }
@res = eval "$usercontext $evalarg;\n"; # '\n' for nice recursive debug
$trace = $otrace;
$single = $osingle;
}
sub gets {
- local($.);
- #<IN>;
&readline("cont: ");
}
}
sub readline {
+ local $.;
if (@typeahead) {
my $left = @typeahead;
my $got = shift @typeahead;
local $frame = 0;
local $doret = -2;
if (ref $OUT and UNIVERSAL::isa($OUT, 'IO::Socket::INET')) {
- print $OUT @_;
+ $OUT->write(join('', @_));
my $stuff;
$IN->recv( $stuff, 2048 ); # XXX: what's wrong with sysread?
$stuff;
B<V> [I<pkg> [I<vars>]] List some (default all) variables in package (default current).
Use B<~>I<pattern> and B<!>I<pattern> for positive and negative regexps.
B<X> [I<vars>] Same as \"B<V> I<currentpackage> [I<vars>]\".
-B<x> I<expr> Evals expression in array context, dumps the result.
-B<m> I<expr> Evals expression in array context, prints methods callable
+B<x> I<expr> Evals expression in list context, dumps the result.
+B<m> I<expr> Evals expression in list context, prints methods callable
on the first element of the result.
B<m> I<class> Prints methods callable via the given class.
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>
- B<x>|B<m> I<expr> Evals expr in array context, dumps the result or lists methods.
+ B<x>|B<m> I<expr> Evals expr in list context, dumps the result or lists methods.
B<p> I<expr> Print expression (uses script's current package).
B<S> [[B<!>]I<pat>] List subroutine names [not] matching pattern
B<V> [I<Pk> [I<Vars>]] List Variables in Package. Vars can be ~pattern or !pattern.