summaryrefslogtreecommitdiff
path: root/lib/perl5db.pl
diff options
context:
space:
mode:
authorShlomi Fish <shlomif@shlomifish.org>2012-11-11 19:56:00 +0200
committerTony Cook <tony@develop-help.com>2013-01-02 11:21:58 +1100
commita1a6cc5d11ff261c27a5cca7a72c2a95a17bf64d (patch)
tree7b96745f9e9d9ad2d637ad003cbacc31e018518a /lib/perl5db.pl
parent4886a4695752d717aefb72af970002a2f8fcf776 (diff)
downloadperl-a1a6cc5d11ff261c27a5cca7a72c2a95a17bf64d.tar.gz
[perl5db] Extract some subroutines.
Diffstat (limited to 'lib/perl5db.pl')
-rw-r--r--lib/perl5db.pl165
1 files changed, 90 insertions, 75 deletions
diff --git a/lib/perl5db.pl b/lib/perl5db.pl
index 516926723b..c7dbaf8b2d 100644
--- a/lib/perl5db.pl
+++ b/lib/perl5db.pl
@@ -5478,107 +5478,122 @@ sub _cmd_l_handle_var_name {
return cmd_l( 'l', $s );
}
-sub cmd_l {
- my $current_line = $line;
+sub _cmd_l_handle_subname {
my $cmd = shift;
my $line = shift;
- # If this is '-something', delete any spaces after the dash.
- $line =~ s/^-\s*$/-/;
+ my $s = $subname;
- # 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 ) {
- return _cmd_l_handle_var_name($var_name);
- } ## end if ($line =~ /^(\$.*)/s)
+ # De-Perl4.
+ $subname =~ s/\'/::/;
- # l name. Try to find a sub by that name.
- elsif ( ($subname) = $line =~ /\A([\':A-Za-z_][\':\w]*(?:\[.*\])?)/s ) {
- my $s = $subname;
+ # Put it in this package unless it starts with ::.
+ $subname = $package . "::" . $subname unless $subname =~ /::/;
- # De-Perl4.
- $subname =~ s/\'/::/;
+ # Put it in CORE::GLOBAL if t doesn't start with :: and
+ # it doesn't live in this package and it lives in CORE::GLOBAL.
+ $subname = "CORE::GLOBAL::$s"
+ if not defined &$subname
+ and $s !~ /::/
+ and defined &{"CORE::GLOBAL::$s"};
- # Put it in this package unless it starts with ::.
- $subname = $package . "::" . $subname unless $subname =~ /::/;
+ # Put leading '::' names into 'main::'.
+ $subname = "main" . $subname if substr( $subname, 0, 2 ) eq "::";
- # Put it in CORE::GLOBAL if t doesn't start with :: and
- # it doesn't live in this package and it lives in CORE::GLOBAL.
- $subname = "CORE::GLOBAL::$s"
- if not defined &$subname
- and $s !~ /::/
- and defined &{"CORE::GLOBAL::$s"};
+ # Get name:start-stop from find_sub, and break this up at
+ # colons.
+ my @pieces = split( /:/, find_sub($subname) || $sub{$subname} );
- # Put leading '::' names into 'main::'.
- $subname = "main" . $subname if substr( $subname, 0, 2 ) eq "::";
+ # Pull off start-stop.
+ my $subrange = pop @pieces;
- # Get name:start-stop from find_sub, and break this up at
- # colons.
- my @pieces = split( /:/, find_sub($subname) || $sub{$subname} );
+ # If the name contained colons, the split broke it up.
+ # Put it back together.
+ $file = join( ':', @pieces );
- # Pull off start-stop.
- my $subrange = pop @pieces;
+ # If we're not in that file, switch over to it.
+ if ( $file ne $filename ) {
+ if (! $slave_editor) {
+ print {$OUT} "Switching to file '$file'.\n";
+ }
- # If the name contained colons, the split broke it up.
- # Put it back together.
- $file = join( ':', @pieces );
+ # Switch debugger's magic structures.
+ *dbline = $main::{ '_<' . $file };
+ $max = $#dbline;
+ $filename = $file;
+ } ## end if ($file ne $filename)
+
+ # Subrange is 'start-stop'. If this is less than a window full,
+ # swap it to 'start+', which will list a window from the start point.
+ if ($subrange) {
+ if ( eval($subrange) < -$window ) {
+ $subrange =~ s/-.*/+/;
+ }
- # If we're not in that file, switch over to it.
- if ( $file ne $filename ) {
- if (! $slave_editor) {
- print {$OUT} "Switching to file '$file'.\n";
- }
+ # Call self recursively to list the range.
+ $line = $subrange;
+ return cmd_l( 'l', $subrange );
+ } ## end if ($subrange)
- # Switch debugger's magic structures.
- *dbline = $main::{ '_<' . $file };
- $max = $#dbline;
- $filename = $file;
- } ## end if ($file ne $filename)
+ # Couldn't find it.
+ else {
+ print {$OUT} "Subroutine $subname not found.\n";
+ return;
+ }
+}
- # Subrange is 'start-stop'. If this is less than a window full,
- # swap it to 'start+', which will list a window from the start point.
- if ($subrange) {
- if ( eval($subrange) < -$window ) {
- $subrange =~ s/-.*/+/;
- }
+sub _cmd_l_empty {
+ # Compute new range to list.
+ $incr = $window - 1;
- # Call self recursively to list the range.
- $line = $subrange;
- return cmd_l( 'l', $subrange );
- } ## end if ($subrange)
+ # Recurse to do it.
+ return cmd_l( 'l', $start . '-' . ( $start + $incr ) );
+}
- # Couldn't find it.
- else {
- print {$OUT} "Subroutine $subname not found.\n";
- return;
- }
+sub _cmd_l_plus {
+ my ($new_start, $new_incr) = @_;
+
+ # Don't reset start for 'l +nnn'.
+ $start = $new_start if $new_start;
+
+ # Increment for list. Use window size if not specified.
+ # (Allows 'l +' to work.)
+ $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( 'l', $line );
+}
+
+sub cmd_l {
+ my $current_line = $line;
+ my $cmd = shift;
+ my $line = shift;
+
+ # If this is '-something', delete any spaces after the dash.
+ $line =~ s/^-\s*$/-/;
+
+ # 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 ) {
+ return _cmd_l_handle_var_name($var_name);
+ } ## end if ($line =~ /^(\$.*)/s)
+
+ # l name. Try to find a sub by that name.
+ elsif ( ($subname) = $line =~ /\A([\':A-Za-z_][\':\w]*(?:\[.*\])?)/s ) {
+ return _cmd_l_handle_subname($cmd, $line);
} ## end elsif ($line =~ /^([\':A-Za-z_][\':\w]*(\[.*\])?)/s)
# Bare 'l' command.
elsif ( $line !~ /\S/ ) {
-
- # Compute new range to list.
- $incr = $window - 1;
- $line = $start . '-' . ( $start + $incr );
-
- # Recurse to do it.
- return cmd_l( 'l', $line );
+ return _cmd_l_empty();
}
# l [start]+number_of_lines
elsif ( my ($new_start, $new_incr) = $line =~ /\A(\d*)\+(\d*)\z/ ) {
- # Don't reset start for 'l +nnn'.
- $start = $new_start if $new_start;
-
- # Increment for list. Use window size if not specified.
- # (Allows 'l +' to work.)
- $incr = $new_incr || ($window - 1);
-
- # Create a line range we'll understand, and recurse to do it.
- $line = $start . '-' . ( $start + $incr );
- return cmd_l( 'l', $line );
+ return _cmd_l_plus($new_start, $new_incr);
} ## end elsif ($line =~ /^(\d*)\+(\d*)$/)
# l start-stop or l start,stop