Extract some duplicate code into a closure.

[perl5.git] / lib / perl5db.pl

diff --git a/lib/perl5db.pl b/lib/perl5db.pl
index 382dc4b..9574084 100644 (file)
--- a/lib/perl5db.pl
+++ b/lib/perl5db.pl
@@ -5489,7 +5489,6 @@ sub _cmd_l_handle_var_name {
 }
 
 sub _cmd_l_handle_subname {
-    my $line = shift;
 
     my $s = $subname;
 
@@ -5540,7 +5539,6 @@ sub _cmd_l_handle_subname {
         }
 
         # Call self recursively to list the range.
-        $line = $subrange;
         return _cmd_l_main( $subrange );
     } ## end if ($subrange)
 
@@ -5570,12 +5568,11 @@ sub _cmd_l_plus {
     $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 :
@@ -5588,7 +5585,7 @@ sub _cmd_l_calc_initial_end_and_i {
     my $i = $start_match;
 
     if ($i eq '.') {
-        $i = $line;
+        $i = $spec;
     }
 
     $i = _max($i, 1);
@@ -5599,10 +5596,10 @@ sub _cmd_l_calc_initial_end_and_i {
 }
 
 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) {
@@ -5675,7 +5672,7 @@ sub _cmd_l_main {
     }
     # l name. Try to find a sub by that name.
     elsif ( ($subname) = $spec =~ /\A([\':A-Za-z_][\':\w]*(?:\[.*\])?)/s ) {
-        return _cmd_l_handle_subname($spec);
+        return _cmd_l_handle_subname();
     }
     # Bare 'l' command.
     elsif ( $spec !~ /\S/ ) {
@@ -5714,9 +5711,7 @@ Watchpoints are simpler: we just list the entries in C<@to_watch>.
 
 =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';
@@ -5725,15 +5720,42 @@ sub cmd_L {
         $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;
+}
+
+sub _cmd_L_calc_wanted_flags {
+    my $arg = _cmd_L_calc_arg(shift);
+
+    return (map { index($arg, $_) >= 0 ? 1 : 0 } qw(a b w));
+}
+
+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 ) {
 
+        BREAKPOINTS_SCAN:
         # Look in all the files with breakpoints...
         for my $file ( keys %had_breakpoints ) {
 
@@ -5752,26 +5774,19 @@ sub cmd_L {
                 if ( defined $dbline{$i} ) {
 
                     # Print the header if we haven't.
-                    print $OUT "$file:\n" unless $was++;
+                    if (not $was++) {
+                        print {$OUT} "$file:\n";
+                    }
 
                     # Print the line.
-                    print $OUT " $i:\t", $dbline[$i];
+                    print {$OUT} " $i:\t", $dbline[$i];
 
-                    # Pull out the condition and the action.
-                    my ( $stop, $action ) = split( /\0/, $dbline{$i} );
-
-                    # Print the break if there is one and it's wanted.
-                    print $OUT "   break if (", $stop, ")\n"
-                      if $stop
-                      and $break_wanted;
-
-                    # Print the action if there is one and it's wanted.
-                    print $OUT "   action:  ", $action, "\n"
-                      if $action
-                      and $action_wanted;
+                    $handle_db_line->($dbline{$i});
 
                     # Quit if the user hit interrupt.
-                    last if $signal;
+                    if ($signal) {
+                        last BREAKPOINTS_SCAN;
+                    }
                 } ## end if (defined $dbline{$i...
             } ## end for my $i (1 .. $max)
         } ## end for my $file (keys %had_breakpoints)
@@ -5779,11 +5794,14 @@ sub cmd_L {
 
     # 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)
 
@@ -5794,22 +5812,23 @@ sub cmd_L {
 
     # 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 ) {