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   93 use warnings; no warnings 'redefine';
  12     12   28  
  12     1   490  
  12     1   61  
  12         25  
  12         448  
  1         5  
  1         2  
  1         24  
  1         4  
  1         2  
  1         25  
3              
4 12     12   70 use rlib '../../../..';
  12     1   26  
  12         60  
  1         5  
  1         3  
  1         12  
5              
6             package Devel::Trepan::CmdProcessor::Command::Down;
7 12     12   4543 use if !@ISA, Devel::Trepan::CmdProcessor::Command ;
  12     1   66  
  12         132  
  1         357  
  1         2  
  1         4  
8              
9             unless (@ISA) {
10 12     12   69 eval <<"EOE";
  12     12   26  
  12     12   624  
  12     12   68  
  12     12   25  
  12         570  
  12         73  
  12         25  
  12         656  
  12         72  
  12         26  
  12         589  
  12         77  
  12         42  
  12         430  
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   2246 use strict; use vars qw(@ISA); @ISA = @CMD_ISA;
  12     12   26  
  12     1   363  
  12     1   76  
  12         22  
  12         619  
  1         53  
  1         2  
  1         30  
  1         6  
  1         2  
  1         51  
20 12     12   78 use vars @CMD_VARS; # Value inherited from parent
  12     1   26  
  12         4903  
  1         5  
  1         2  
  1         350  
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;