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   100 use warnings; no warnings 'redefine';
  12     12   29  
  12     1   377  
  12     1   72  
  12         25  
  12         381  
  1         7  
  1         3  
  1         25  
  1         6  
  1         1  
  1         28  
3              
4 12     12   62 use rlib '../../../..';
  12     1   24  
  12         71  
  1         4  
  1         2  
  1         5  
5              
6 12     12   4280 use Exporter;
  12     1   24  
  12         713  
  1         347  
  1         2  
  1         58  
7             # NOTE: The down command subclasses this, so beware when changing!
8             package Devel::Trepan::CmdProcessor::Command::Up;
9 12     12   69 use if !@ISA, Devel::Trepan::CmdProcessor::Command ;
  12     1   24  
  12         70  
  1         5  
  1         2  
  1         5  
10              
11             unless (@ISA) {
12 12     12   81 eval <<'EOE';
  12     12   30  
  12     12   674  
  12     12   82  
  12     12   46  
  12         571  
  12         78  
  12         29  
  12         610  
  12         75  
  12         29  
  12         558  
  12         72  
  12         23  
  12         527  
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   1777 use strict;
  12     1   28  
  12         433  
  1         47  
  1         10  
  1         26  
22              
23 12     12   66 use vars qw(@ISA @EXPORT); @ISA = @CMD_ISA; push @ISA, 'Exporter';
  12     1   40  
  12         1100  
  1         5  
  1         2  
  1         60  
24 12     12   75 use vars @CMD_VARS; # Value inherited from parent
  12     1   26  
  12         6325  
  1         5  
  1         2  
  1         367  
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;