diff options
author | Shlomi Fish <shlomif@shlomifish.org> | 2012-11-11 19:56:00 +0200 |
---|---|---|
committer | Tony Cook <tony@develop-help.com> | 2013-01-02 11:21:58 +1100 |
commit | a1a6cc5d11ff261c27a5cca7a72c2a95a17bf64d (patch) | |
tree | 7b96745f9e9d9ad2d637ad003cbacc31e018518a | |
parent | 4886a4695752d717aefb72af970002a2f8fcf776 (diff) | |
download | perl-a1a6cc5d11ff261c27a5cca7a72c2a95a17bf64d.tar.gz |
[perl5db] Extract some subroutines.
-rw-r--r-- | lib/perl5db.pl | 165 |
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 |