File Coverage

lib/Devel/Trepan/CmdProcessor/Command/Down.pm
Criterion Covered Total %
statement 57 79 72.1
branch 0 8 0.0
condition n/a
subroutine 19 23 82.6
pod 0 4 0.0
total 76 114 66.6


line stmt bran cond sub pod time code
1             # Copyright (C) 2011-2012, 2014-2015 Rocky Bernstein <rocky@cpan.org>
2 12     12   100 use warnings; no warnings 'redefine';
  12     12   39  
  12     1   466  
  12     1   73  
  12         136  
  12         452  
  1         7  
  1         2  
  1         24  
  1         6  
  1         3  
  1         27  
3              
4 12     12   407 use rlib '../../../..';
  12     1   30  
  12         74  
  1         5  
  1         3  
  1         6  
5              
6             package Devel::Trepan::CmdProcessor::Command::Down;
7 12     12   3959 use if !@ISA, Devel::Trepan::CmdProcessor::Command ;
  12     1   28  
  12         68  
  1         312  
  1         2  
  1         6  
8              
9             unless (@ISA) {
10 12     12   95 eval <<"EOE";
  12     12   707  
  12     12   720  
  12     12   79  
  12     12   27  
  12         536  
  12         73  
  12         29  
  12         548  
  12         70  
  12         40  
  12         472  
  12         409  
  12         32  
  12         399  
11             use constant CATEGORY => 'stack';
12             use constant SHORT_HELP => 'Move frame in the direction of the least recent frame';
13             use constant NEED_STACK => 1;
14             use constant MIN_ARGS => 0; # Need at least this many
15             use constant MAX_ARGS => 1; # Need at most this many - undef -> unlimited.
16             EOE
17             }
18              
19 12     12   2125 use strict; use vars qw(@ISA); @ISA = @CMD_ISA;
  12     12   36  
  12     1   282  
  12     1   62  
  12         35  
  12         605  
  1         61  
  1         2  
  1         17  
  1         5  
  1         2  
  1         46  
20 12     12   193 use vars @CMD_VARS; # Value inherited from parent
  12     1   38  
  12         4765  
  1         6  
  1         2  
  1         324  
21              
22             our $NAME = set_name();
23             =pod
24              
25             =head2 Synopsis:
26              
27             =cut
28             our $HELP = <<'HELP';
29             =pod
30              
31             B<down> [I<count>]
32              
33             Move the current frame down in the stack trace (to a newer frame). 0
34             is the most recent frame. If no count is given, move down 1. This is
35             the same as C<up>, but moving in an opposite direction.
36              
37             =head2 See also:
38              
39             L<C<up>|Devel::Trepan::CmdProcessor::Command::Up>,
40             L<C<frame>|Devel::Trepan::CmdProcessor::Command::Frame>,
41             and L<C<backtrace>|Devel::Trepan::CmdProcessor::Command::Backtrace>
42              
43             =cut
44             HELP
45              
46             sub complete($$)
47             {
48 0     0 0   my ($self, $prefix) = @_;
  0     0 0    
49 0           $self->{proc}->frame_complete($prefix, -1);
  0            
50             }
51              
52             # This method runs the command
53             sub run($$)
54             {
55 0     0 0   my ($self, $args) = @_;
  0     0 0    
56 0           my $proc = $self->{proc};
  0            
57 0           my $count_str = $args->[1];
  0            
58 0 0         $count_str = 1 unless defined $count_str;
  0 0          
59 0           my ($low, $high) = $proc->frame_low_high(0);
  0            
60 0           my $opts= {
  0            
61             'msg_on_error' =>
62             "The '${NAME}' command requires a frame number. Got: ${count_str}",
63             min_value => $low,
64             max_value => $high
65             };
66 0           my $count = $proc->get_an_int($count_str, $opts);
  0            
67 0 0         return unless defined $count;
  0 0          
68 0           $proc->adjust_frame(-$count, 0);
  0            
69             }
70              
71             unless (caller) {
72             require Devel::Trepan::DB;
73             require Devel::Trepan::Core;
74             my $db = Devel::Trepan::Core->new;
75             my $intf = Devel::Trepan::Interface::User->new;
76             my $proc = Devel::Trepan::CmdProcessor->new([$intf], $db);
77             $proc->{stack_size} = 0;
78             my $cmd = __PACKAGE__->new($proc);
79             $cmd->run([$NAME, 0]);
80             }
81              
82             1;