}
sub _cmd_l_handle_subname {
- my $line = shift;
my $s = $subname;
}
# Call self recursively to list the range.
- $line = $subrange;
return _cmd_l_main( $subrange );
} ## end if ($subrange)
$incr = $new_incr || ($window - 1);
# Create a line range we'll understand, and recurse to do it.
- my $line = $start . '-' . ( $start + $incr );
- return _cmd_l_main( $line );
+ return _cmd_l_main( $start . '-' . ( $start + $incr ) );
}
sub _cmd_l_calc_initial_end_and_i {
- my ($line, $start_match, $end_match) = @_;
+ my ($spec, $start_match, $end_match) = @_;
# Determine end point; use end of file if not specified.
my $end = ( !defined $start_match ) ? $max :
my $i = $start_match;
if ($i eq '.') {
- $i = $line;
+ $i = $spec;
}
$i = _max($i, 1);
}
sub _cmd_l_range {
- my ($line, $current_line, $start_match, $end_match) = @_;
+ my ($spec, $current_line, $start_match, $end_match) = @_;
my ($end, $i) =
- _cmd_l_calc_initial_end_and_i($line, $start_match, $end_match);
+ _cmd_l_calc_initial_end_and_i($spec, $start_match, $end_match);
# If we're running under a slave editor, force it to show the lines.
if ($slave_editor) {
}
sub _cmd_l_main {
- my $current_line = $line;
- my $line = shift;
+ my $spec = shift;
# If this is '-something', delete any spaces after the dash.
- $line =~ s/\A-\s*\z/-/;
+ $spec =~ s/\A-\s*\z/-/;
# If the line is '$something', assume this is a scalar containing a
# line number.
# Set up for DB::eval() - evaluate in *user* context.
- if ( my ($var_name) = $line =~ /\A(\$.*)/s ) {
+ if ( my ($var_name) = $spec =~ /\A(\$.*)/s ) {
return _cmd_l_handle_var_name($var_name);
}
# l name. Try to find a sub by that name.
- elsif ( ($subname) = $line =~ /\A([\':A-Za-z_][\':\w]*(?:\[.*\])?)/s ) {
- return _cmd_l_handle_subname($line);
+ elsif ( ($subname) = $spec =~ /\A([\':A-Za-z_][\':\w]*(?:\[.*\])?)/s ) {
+ return _cmd_l_handle_subname();
}
# Bare 'l' command.
- elsif ( $line !~ /\S/ ) {
+ elsif ( $spec !~ /\S/ ) {
return _cmd_l_empty();
}
# l [start]+number_of_lines
- elsif ( my ($new_start, $new_incr) = $line =~ /\A(\d*)\+(\d*)\z/ ) {
+ elsif ( my ($new_start, $new_incr) = $spec =~ /\A(\d*)\+(\d*)\z/ ) {
return _cmd_l_plus($new_start, $new_incr);
}
# l start-stop or l start,stop
- elsif (my ($s, $e) = $line =~ /^(?:(-?[\d\$\.]+)(?:[-,]([\d\$\.]+))?)?/ ) {
- return _cmd_l_range($line, $current_line, $s, $e);
+ elsif (my ($s, $e) = $spec =~ /^(?:(-?[\d\$\.]+)(?:[-,]([\d\$\.]+))?)?/ ) {
+ return _cmd_l_range($spec, $line, $s, $e);
}
return;
=cut
-sub cmd_L {
- my $cmd = shift;
-
+sub _cmd_L_calc_arg {
# If no argument, list everything. Pre-5.8.0 version always lists
# everything
my $arg = shift || 'abw';
$arg = 'abw';
}
- # See what is wanted.
- my $action_wanted = ( $arg =~ /a/ ) ? 1 : 0;
- my $break_wanted = ( $arg =~ /b/ ) ? 1 : 0;
- my $watch_wanted = ( $arg =~ /w/ ) ? 1 : 0;
+ return $arg;
+}
- # Breaks and actions are found together, so we look in the same place
- # for both.
- if ( $break_wanted or $action_wanted ) {
+sub _cmd_L_calc_wanted_flags {
+ my $arg = _cmd_L_calc_arg(shift);
- # Look in all the files with breakpoints...
- for my $file ( keys %had_breakpoints ) {
+ return (map { index($arg, $_) >= 0 ? 1 : 0 } qw(a b w));
+}
- # Temporary switch to this file.
- local *dbline = $main::{ '_<' . $file };
- # Set up to look through the whole file.
- $max = $#dbline;
- my $was; # Flag: did we print something
- # in this file?
+sub _cmd_L_handle_breakpoints {
+ my ($handle_db_line) = @_;
- # For each line in the file ...
- for my $i (1 .. $max) {
+ BREAKPOINTS_SCAN:
+ # Look in all the files with breakpoints...
+ for my $file ( keys %had_breakpoints ) {
- # We've got something on this line.
- if ( defined $dbline{$i} ) {
+ # Temporary switch to this file.
+ local *dbline = $main::{ '_<' . $file };
+
+ # Set up to look through the whole file.
+ $max = $#dbline;
+ my $was; # Flag: did we print something
+ # in this file?
+
+ # For each line in the file ...
+ for my $i (1 .. $max) {
- # Print the header if we haven't.
- print $OUT "$file:\n" unless $was++;
+ # We've got something on this line.
+ if ( defined $dbline{$i} ) {
- # Print the line.
- print $OUT " $i:\t", $dbline[$i];
+ # Print the header if we haven't.
+ if (not $was++) {
+ print {$OUT} "$file:\n";
+ }
- # Pull out the condition and the action.
- my ( $stop, $action ) = split( /\0/, $dbline{$i} );
+ # Print the line.
+ print {$OUT} " $i:\t", $dbline[$i];
- # Print the break if there is one and it's wanted.
- print $OUT " break if (", $stop, ")\n"
- if $stop
- and $break_wanted;
+ $handle_db_line->($dbline{$i});
- # Print the action if there is one and it's wanted.
- print $OUT " action: ", $action, "\n"
- if $action
- and $action_wanted;
+ # Quit if the user hit interrupt.
+ if ($signal) {
+ last BREAKPOINTS_SCAN;
+ }
+ } ## end if (defined $dbline{$i...
+ } ## end for my $i (1 .. $max)
+ } ## end for my $file (keys %had_breakpoints)
- # Quit if the user hit interrupt.
- last if $signal;
- } ## end if (defined $dbline{$i...
- } ## end for my $i (1 .. $max)
- } ## end for my $file (keys %had_breakpoints)
+ return;
+}
+
+sub cmd_L {
+ my $cmd = shift;
+
+ my ($action_wanted, $break_wanted, $watch_wanted) =
+ _cmd_L_calc_wanted_flags(shift);
+
+ my $handle_db_line = sub {
+ my ($l) = @_;
+
+ my ( $stop, $action ) = split( /\0/, $l );
+
+ if ($stop and $break_wanted) {
+ print {$OUT} " break if (", $stop, ")\n"
+ }
+
+ if ($action && $action_wanted) {
+ print {$OUT} " action: ", $action, "\n"
+ }
+
+ return;
+ };
+
+ # Breaks and actions are found together, so we look in the same place
+ # for both.
+ if ( $break_wanted or $action_wanted ) {
+ _cmd_L_handle_breakpoints($handle_db_line);
} ## end if ($break_wanted or $action_wanted)
# Look for breaks in not-yet-compiled subs:
if ( %postponed and $break_wanted ) {
- print $OUT "Postponed breakpoints in subroutines:\n";
+ print {$OUT} "Postponed breakpoints in subroutines:\n";
my $subname;
+ SUBS_SCAN:
for $subname ( keys %postponed ) {
- print $OUT " $subname\t$postponed{$subname}\n";
- last if $signal;
+ print {$OUT} " $subname\t$postponed{$subname}\n";
+ if ($signal) {
+ last SUBS_SCAN;
+ }
}
} ## end if (%postponed and $break_wanted)
# If there are any, list them.
if ( @have and ( $break_wanted or $action_wanted ) ) {
- print $OUT "Postponed breakpoints in files:\n";
+ print {$OUT} "Postponed breakpoints in files:\n";
+ POSTPONED_SCANS:
for my $file ( keys %postponed_file ) {
my $db = $postponed_file{$file};
- print $OUT " $file:\n";
+ print {$OUT} " $file:\n";
for my $line ( sort { $a <=> $b } keys %$db ) {
- print $OUT " $line:\n";
- my ( $stop, $action ) = split( /\0/, $$db{$line} );
- print $OUT " break if (", $stop, ")\n"
- if $stop
- and $break_wanted;
- print $OUT " action: ", $action, "\n"
- if $action
- and $action_wanted;
- last if $signal;
+ print {$OUT} " $line:\n";
+
+ $handle_db_line->($db->{$line});
+
+ if ($signal) {
+ last POSTPONED_SCANS;
+ }
} ## end for $line (sort { $a <=>...
- last if $signal;
+ if ($signal) {
+ last POSTPONED_SCANS;
+ }
} ## end for $file (keys %postponed_file)
} ## end if (@have and ($break_wanted...
if ( %break_on_load and $break_wanted ) {
https://perl5.git.perl.org / perl5.git / blobdiff