}
}
-# This would probably be better done with "use vars", but that wasn't around
-# when this code was originally written. (Neither was "use strict".) And on
-# the principle of not fiddling with something that was working, this was
-# left alone.
-warn( # Do not ;-)
- # These variables control the execution of 'dumpvar.pl'.
- $dumpvar::hashDepth,
- $dumpvar::arrayDepth,
- $dumpvar::dumpDBFiles,
- $dumpvar::dumpPackages,
- $dumpvar::quoteHighBit,
- $dumpvar::printUndef,
- $dumpvar::globPrint,
- $dumpvar::usageOnly,
-
- # used to control die() reporting in diesignal()
- $Carp::CarpLevel,
-
+# These variables control the execution of 'dumpvar.pl'.
+{
+ package dumpvar;
+ use vars qw(
+ $hashDepth
+ $arrayDepth
+ $dumpDBFiles
+ $dumpPackages
+ $quoteHighBit
+ $printUndef
+ $globPrint
+ $usageOnly
+ );
+}
- )
- if 0;
+# used to control die() reporting in diesignal()
+{
+ package Carp;
+ use vars qw($CarpLevel);
+}
# without threads, $filename is not defined until DB::DB is called
foreach my $k (keys (%INC)) {
- &share(\$main::{'_<'.$filename}) if defined $filename;
+ share(\$main::{'_<'.$filename}) if defined $filename;
};
# Command-line + PERLLIB:
# Set up defaults for command recall and shell escape (note:
# these currently don't work in linemode debugging).
-&recallCommand("!") unless defined $prc;
-&shellBang("!") unless defined $psh;
+recallCommand("!") unless defined $prc;
+shellBang("!") unless defined $psh;
=pod
# As noted, this test really doesn't check accurately that the debugger
# is running at a terminal or not.
-my $dev_tty = '/dev/tty';
- $dev_tty = 'TT:' if ($^O eq 'VMS');
use vars qw($rcfile);
-if ( -e $dev_tty ) { # this is the wrong metric!
- $rcfile = ".perldb";
-}
-else {
- $rcfile = "perldb.ini";
+{
+ my $dev_tty = (($^O eq 'VMS') ? 'TT:' : '/dev/tty');
+ # this is the wrong metric!
+ $rcfile = ((-e $dev_tty) ? ".perldb" : "perldb.ini");
}
=pod
use vars qw(@hist @truehist %postponed_file @typeahead);
-if ( exists $ENV{PERLDB_RESTART} ) {
-
- # We're restarting, so we don't need the flag that says to restart anymore.
- delete $ENV{PERLDB_RESTART};
-
- # $restart = 1;
+sub _restore_shared_globals_after_restart
+{
@hist = get_list('PERLDB_HIST');
%break_on_load = get_list("PERLDB_ON_LOAD");
%postponed = get_list("PERLDB_POSTPONE");
- share(@hist);
- share(@truehist);
- share(%break_on_load);
- share(%postponed);
+ share(@hist);
+ share(@truehist);
+ share(%break_on_load);
+ share(%postponed);
+}
+
+sub _restore_breakpoints_and_actions {
- # restore breakpoints/actions
my @had_breakpoints = get_list("PERLDB_VISITED");
+
for my $file_idx ( 0 .. $#had_breakpoints ) {
my $filename = $had_breakpoints[$file_idx];
my %pf = get_list("PERLDB_FILE_$file_idx");
}
}
- # restore options
- my %opt = get_list("PERLDB_OPT");
- my ( $opt, $val );
- while ( ( $opt, $val ) = each %opt ) {
+ return;
+}
+
+sub _restore_options_after_restart
+{
+ my %options_map = get_list("PERLDB_OPT");
+
+ while ( my ( $opt, $val ) = each %options_map ) {
$val =~ s/[\\\']/\\$1/g;
parse_options("$opt'$val'");
}
+ return;
+}
+
+sub _restore_globals_after_restart
+{
# restore original @INC
@INC = get_list("PERLDB_INC");
@ini_INC = @INC;
$pre = [ get_list("PERLDB_PRE") ];
$post = [ get_list("PERLDB_POST") ];
@typeahead = get_list( "PERLDB_TYPEAHEAD", @typeahead );
+
+ return;
+}
+
+
+if ( exists $ENV{PERLDB_RESTART} ) {
+
+ # We're restarting, so we don't need the flag that says to restart anymore.
+ delete $ENV{PERLDB_RESTART};
+
+ # $restart = 1;
+ _restore_shared_globals_after_restart();
+
+ _restore_breakpoints_and_actions();
+
+ # restore options
+ _restore_options_after_restart();
+
+ _restore_globals_after_restart();
} ## end if (exists $ENV{PERLDB_RESTART...
=head2 SETTING UP THE TERMINAL
# No line spec? Use dbline.
# If there is one, use it if it's non-zero, or wipe it out if it is.
- my $line = ( $_[0] =~ /^\./ ) ? $dbline : shift || '';
+ my $line = ( $_[0] =~ /\A\./ ) ? $dbline : (shift || '');
my $dbline = shift;
# If the line was dot, make the line the current one.
# If it's * we're deleting all the breakpoints.
if ( $line eq '*' ) {
- eval { &delete_breakpoint(); 1 } or print $OUT $@ and return;
+ if (not eval { delete_breakpoint(); 1 }) {
+ print {$OUT} $@;
+ }
}
# If there is a line spec, delete the breakpoint on that line.
- elsif ( $line =~ /^(\S.*)/ ) {
- if (not eval { &delete_breakpoint( $line || $dbline ); 1 }) {
+ elsif ( $line =~ /\A(\S.*)/ ) {
+ if (not eval { delete_breakpoint( $line || $dbline ); 1 }) {
local $\ = '';
- print $OUT $@ and return;
+ print {$OUT} $@;
}
} ## end elsif ($line =~ /^(\S.*)/)
# No line spec.
else {
- print $OUT
+ print {$OUT}
"Deleting a breakpoint requires a line number, or '*' for all\n"
; # hint
}
+
+ return;
} ## end sub cmd_B
=head3 delete_breakpoint([line]) (API)
=cut
-sub delete_breakpoint {
- my $i = shift;
+sub _remove_breakpoint_entry {
+ my ($fn, $i) = @_;
- my $fn = $filename;
+ delete $dbline{$i};
+ _delete_breakpoint_data_ref($fn, $i);
- # If we got a line, delete just that one.
- if ( defined($i) ) {
+ return;
+}
+
+sub _delete_all_breakpoints {
+ print {$OUT} "Deleting all breakpoints...\n";
+
+ # %had_breakpoints lists every file that had at least one
+ # breakpoint in it.
+ for my $fn ( keys %had_breakpoints ) {
- # Woops. This line wasn't breakable at all.
- die "Line $i not breakable.\n" if $dbline[$i] == 0;
+ # Switch to the desired file temporarily.
+ local *dbline = $main::{ '_<' . $fn };
- # Kill the condition, but leave any action.
- $dbline{$i} =~ s/^[^\0]*//;
+ $max = $#dbline;
- # Remove the entry entirely if there's no action left.
- if ($dbline{$i} eq '') {
- delete $dbline{$i};
- _delete_breakpoint_data_ref($fn, $i);
+ # For all lines in this file ...
+ for my $i (1 .. $max) {
+
+ # If there's a breakpoint or action on this line ...
+ if ( defined $dbline{$i} ) {
+
+ # ... remove the breakpoint.
+ $dbline{$i} =~ s/\A[^\0]+//;
+ if ( $dbline{$i} =~ s/\A\0?\z// ) {
+ # Remove the entry altogether if no action is there.
+ _remove_breakpoint_entry($fn, $i);
+ }
+ } ## end if (defined $dbline{$i...
+ } ## end for $i (1 .. $max)
+
+ # If, after we turn off the "there were breakpoints in this file"
+ # bit, the entry in %had_breakpoints for this file is zero,
+ # we should remove this file from the hash.
+ if ( not $had_breakpoints{$fn} &= (~1) ) {
+ delete $had_breakpoints{$fn};
}
- }
+ } ## end for my $fn (keys %had_breakpoints)
- # No line; delete them all.
- else {
- print $OUT "Deleting all breakpoints...\n";
+ # Kill off all the other breakpoints that are waiting for files that
+ # haven't been loaded yet.
+ undef %postponed;
+ undef %postponed_file;
+ undef %break_on_load;
- # %had_breakpoints lists every file that had at least one
- # breakpoint in it.
- for my $file ( keys %had_breakpoints ) {
+ return;
+}
- # Switch to the desired file temporarily.
- local *dbline = $main::{ '_<' . $file };
+sub _delete_breakpoint_from_line {
+ my ($i) = @_;
- $max = $#dbline;
- my $was;
+ # Woops. This line wasn't breakable at all.
+ die "Line $i not breakable.\n" if $dbline[$i] == 0;
- # For all lines in this file ...
- for $i (1 .. $max) {
+ # Kill the condition, but leave any action.
+ $dbline{$i} =~ s/\A[^\0]*//;
- # If there's a breakpoint or action on this line ...
- if ( defined $dbline{$i} ) {
+ # Remove the entry entirely if there's no action left.
+ if ($dbline{$i} eq '') {
+ _remove_breakpoint_entry($filename, $i);
+ }
- # ... remove the breakpoint.
- $dbline{$i} =~ s/^[^\0]+//;
- if ( $dbline{$i} =~ s/^\0?$// ) {
+ return;
+}
- # Remove the entry altogether if no action is there.
- delete $dbline{$i};
- _delete_breakpoint_data_ref($file, $i);
- }
- } ## end if (defined $dbline{$i...
- } ## end for $i (1 .. $max)
+sub delete_breakpoint {
+ my $i = shift;
- # If, after we turn off the "there were breakpoints in this file"
- # bit, the entry in %had_breakpoints for this file is zero,
- # we should remove this file from the hash.
- if ( not $had_breakpoints{$file} &= ~1 ) {
- delete $had_breakpoints{$file};
- }
- } ## end for my $file (keys %had_breakpoints)
+ # If we got a line, delete just that one.
+ if ( defined($i) ) {
+ _delete_breakpoint_from_line($i);
+ }
+ # No line; delete them all.
+ else {
+ _delete_all_breakpoints();
+ }
- # Kill off all the other breakpoints that are waiting for files that
- # haven't been loaded yet.
- undef %postponed;
- undef %postponed_file;
- undef %break_on_load;
- } ## end else [ if (defined($i))
-} ## end sub delete_breakpoint
+ return;
+}
=head3 cmd_stop (command)
last BREAK_ON_LOAD if $signal;
}
} ## end if (%break_on_load and...
- if ($watch_wanted) {
- if ( $trace & 2 ) {
- print {$OUT} "Watch-expressions:\n" if @to_watch;
- TO_WATCH: for my $expr (@to_watch) {
- print {$OUT} " $expr\n";
- last TO_WATCH if $signal;
- }
- } ## end if ($trace & 2)
- } ## end if ($watch_wanted)
+ if ($watch_wanted and ( $trace & 2 )) {
+ print {$OUT} "Watch-expressions:\n" if @to_watch;
+ TO_WATCH: for my $expr (@to_watch) {
+ print {$OUT} " $expr\n";
+ last TO_WATCH if $signal;
+ }
+ }
} ## end sub cmd_L
=head3 C<cmd_M> - list modules (command)
=cut
sub cmd_M {
- &list_modules();
+ list_modules();
+
+ return;
}
=head3 C<cmd_o> - options (command)