File Coverage

lib/Devel/Trepan/CmdProcessor/Command/Up.pm
Criterion Covered Total %
statement 63 85 74.1
branch 0 8 0.0
condition n/a
subroutine 21 25 84.0
pod 0 4 0.0
total 84 122 68.8


line stmt bran cond sub pod time code
1             # Copyright (C) 2011-2012, 2014 Rocky Bernstein <rocky@cpan.org>
2 12     12   98 use warnings; no warnings 'redefine';
  12     12   36  
  12     1   385  
  12     1   66  
  12         30  
  12         375  
  1         7  
  1         4  
  1         24  
  1         6  
  1         3  
  1         31  
3              
4 12     12   66 use rlib '../../../..';
  12     1   30  
  12         83  
  1         6  
  1         2  
  1         6  
5              
6 12     12   3928 use Exporter;
  12     1   32  
  12         766  
  1         293  
  1         2  
  1         53  
7             # NOTE: The down command subclasses this, so beware when changing!
8             package Devel::Trepan::CmdProcessor::Command::Up;
9 12     12   73 use if !@ISA, Devel::Trepan::CmdProcessor::Command ;
  12     1   30  
  12         89  
  1         6  
  1         2  
  1         4  
10              
11             unless (@ISA) {
12 12     12   82 eval <<'EOE';
  12     12   39  
  12     12   647  
  12     12   76  
  12     12   32  
  12         531  
  12         72  
  12         37  
  12         545  
  12         71  
  12         39  
  12         479  
  12         71  
  12         32  
  12         549  
13             use constant CATEGORY => 'stack';
14             use constant SHORT_HELP => 'Move frame in the direction of most recent frame';
15             use constant MIN_ARGS => 0; # Need at least this many
16             use constant MAX_ARGS => 1; # Need at most this many - undef -> unlimited.
17             use constant NEED_STACK => 1;
18             EOE
19             }
20              
21 12     12   2018 use strict;
  12     1   35  
  12         329  
  1         52  
  1         2  
  1         22  
22              
23 12     12   68 use vars qw(@ISA @EXPORT); @ISA = @CMD_ISA; push @ISA, 'Exporter';
  12     1   28  
  12         724  
  1         4  
  1         3  
  1         53  
24 12     12   73 use vars @CMD_VARS; # Value inherited from parent
  12     1   29  
  12         4400  
  1         5  
  1         3  
  1         388  
25             @EXPORT = qw(@CMD_VARS set_name);
26              
27             our $NAME = set_name();
28             =pod
29              
30             =head2 Synopsis:
31              
32             =cut
33             our $HELP = <<'HELP';
34             =pod
35              
36             B<up> [I<count>]
37              
38             Move the current frame up to a caller in the stack trace (an
39             older frame). 0 is the most recent frame. If no count is given, move
40             up 1. This is same as C<down>, but moving in the opposite direction.
41              
42             =head2 Examples:
43              
44             up # Set current frame to the caller of this current one
45             up 1 # Same as above
46             up -1 # Same as down
47              
48             =head2 See also:
49              
50             L<C<down>|Devel::Trepan::CmdProcessor::Command::Down>,
51             L<C<frame>|Devel::Trepan::CmdProcessor::Command::Frame>,
52             and L<C<backtrace>|Devel::Trepan::CmdProcessor::Command::Backtrace>
53              
54             =cut
55             HELP
56              
57             sub complete($$)
58             {
59 0     0 0   my ($self, $prefix) = @_;
  0     0 0    
60 0           $self->{proc}->frame_complete($prefix, 1);
  0            
61             }
62              
63             # This method runs the command
64             sub run($$)
65             {
66 0     0 0   my ($self, $args) = @_;
  0     0 0    
67 0           my $proc = $self->{proc};
  0            
68 0           my $count_str = $args->[1];
  0            
69 0 0         $count_str = 1 unless defined $count_str;
  0 0          
70 0           my ($low, $high) = $proc->frame_low_high(0);
  0            
71 0           my $opts= {
  0            
72             'msg_on_error' =>
73             "The '${NAME}' command requires a frame number. Got: ${count_str}",
74             min_value => $low,
75             max_value => $high
76             };
77 0           my $count = $proc->get_an_int($count_str, $opts);
  0            
78 0 0         return unless defined $count;
  0 0          
79 0           $proc->adjust_frame($count, 0);
  0            
80             }
81              
82             unless (caller) {
83             require Devel::Trepan::DB;
84             require Devel::Trepan::Core;
85             my $db = Devel::Trepan::Core->new;
86             my $intf = Devel::Trepan::Interface::User->new;
87             my $proc = Devel::Trepan::CmdProcessor->new([$intf], $db);
88             $proc->{stack_size} = 0;
89             my $cmd = __PACKAGE__->new($proc);
90             $cmd->run([$NAME, 0]);
91             }
92              
93             1;