# Debugger for Perl 5.00x; perl5db.pl patch level:
-$VERSION = 0.9906;
+$VERSION = 0.9908;
$header = "perl5db.pl patch level $VERSION";
# Enhanced by ilya@math.ohio-state.edu (Ilya Zakharevich)
$dumpvar::quoteHighBit,
$dumpvar::printUndef,
$dumpvar::globPrint,
- $readline::Tk_toloop,
$dumpvar::usageOnly,
@ARGS,
$Carp::CarpLevel,
HighBit => \$dumpvar::quoteHighBit,
undefPrint => \$dumpvar::printUndef,
globPrint => \$dumpvar::globPrint,
- tkRunning => \$readline::Tk_toloop,
UsageOnly => \$dumpvar::usageOnly,
frame => \$frame,
AutoTrace => \$trace,
signalLevel => \&signalLevel,
warnLevel => \&warnLevel,
dieLevel => \&dieLevel,
+ tkRunning => \&tkRunning,
);
%optionRequire = (
%postponed = get_list("PERLDB_POSTPONE");
my @had_breakpoints= get_list("PERLDB_VISITED");
for (0 .. $#had_breakpoints) {
- %{$postponed_file{$had_breakpoints[$_]}} = get_list("PERLDB_FILE_$_");
+ my %pf = get_list("PERLDB_FILE_$_");
+ $postponed_file{$had_breakpoints[$_]} = \%pf if %pf;
}
my %opt = get_list("PERLDB_OPT");
my ($opt,$val);
print $OUT "Postponed breakpoints in files:\n";
my ($file, $line);
for $file (keys %postponed_file) {
- my %db = %{$postponed_file{$file}};
- next unless keys %db;
+ my $db = $postponed_file{$file};
print $OUT " $file:\n";
- for $line (sort {$a <=> $b} keys %db) {
+ for $line (sort {$a <=> $b} keys %$db) {
print $OUT " $line:\n";
- my ($stop,$action) = split(/\0/, $db{$line});
+ my ($stop,$action) = split(/\0/, $$db{$line});
print $OUT " break if (", $stop, ")\n"
if $stop;
print $OUT " action: ", $action, "\n"
for (0 .. $#had_breakpoints) {
my $file = $had_breakpoints[$_];
*dbline = $main::{'_<' . $file};
- next unless %dbline or %{$postponed_file{$file}};
+ next unless %dbline or $postponed_file{$file};
(push @hard, $file), next
if $file =~ /^\(eval \d+\)$/;
my @add;
@add = %{$postponed_file{$file}}
- if %{$postponed_file{$file}};
+ if $postponed_file{$file};
set_list("PERLDB_FILE_$_", %dbline, @add);
}
for (@hard) { # Yes, really-really...
$signal = 1, print $OUT "'$filename' loaded...\n"
if $break_on_load{$filename};
print $LINEINFO ' ' x $#stack, "Package $filename.\n" if $frame;
- return unless %{$postponed_file{$filename}};
+ return unless $postponed_file{$filename};
$had_breakpoints{$filename}++;
#%dbline = %{$postponed_file{$filename}}; # Cannot be done: unsufficient magic
my $key;
for $key (keys %{$postponed_file{$filename}}) {
$dbline{$key} = $ {$postponed_file{$filename}}{$key};
}
- undef %{$postponed_file{$filename}};
+ delete $postponed_file{$filename};
}
sub dumpit {
} else {
$term = new Term::ReadLine 'perldb', $IN, $OUT;
- $readline::rl_basic_word_break_characters .= "[:"
- if defined $readline::rl_basic_word_break_characters
- and index($readline::rl_basic_word_break_characters, ":") == -1;
- $readline::rl_special_prefixes =
- $readline::rl_special_prefixes = '$@&%';
- $readline::rl_completer_word_break_characters =
- $readline::rl_completer_word_break_characters . '$@&%';
- $readline::rl_completion_function =
- $readline::rl_completion_function = \&db_complete;
+ $rl_attribs = $term->Attribs;
+ $rl_attribs->{basic_word_break_characters} .= '-:+/*,[])}'
+ if defined $rl_attribs->{basic_word_break_characters}
+ and index($rl_attribs->{basic_word_break_characters}, ":") == -1;
+ $rl_attribs->{special_prefixes} = '$@&%';
+ $rl_attribs->{completer_word_break_characters} .= '$@&%';
+ $rl_attribs->{completion_function} = \&db_complete;
}
$LINEINFO = $OUT unless defined $LINEINFO;
$lineinfo = $console unless defined $lineinfo;
$rl;
}
+sub tkRunning {
+ if ($ {$term->Features}{tkRunning}) {
+ return $term->tkRunning(@_);
+ } else {
+ print $OUT "tkRunning not supported by current ReadLine package.\n";
+ 0;
+ }
+}
+
sub NonStop {
if ($term) {
&warn("Too late to set up NonStop mode!\n") if @_;
$out = "=$val ";
}
# Default to value if one completion, to question if many
- $readline::rl_completer_terminator_character
- = $readline::rl_completer_terminator_character
- = (@out == 1 ? $out : '? ');
+ $rl_attribs->{completer_terminator_character} = (@out == 1 ? $out : '? ');
return sort @out;
}
- return &readline::rl_filename_list($text); # filenames
+ return $term->filename_list($text); # filenames
}
sub end_report { print $OUT "Use `q' to quit and `R' to restart. `h q' for details.\n" }