File Coverage

lib/Devel/Trepan/CmdProcessor/Command/Info_Subcmd/Variables_Subcmd/Lexicals.pm
Criterion Covered Total %
statement 27 48 56.2
branch 0 8 0.0
condition n/a
subroutine 9 10 90.0
pod n/a
total 36 66 54.5


line stmt bran cond sub pod time code
1             # -*- coding: utf-8 -*-
2             # Copyright (C) 2011-2012, 2014 Rocky Bernstein <rocky@cpan.org>
3 12     12   80 use warnings; no warnings 'redefine'; no warnings 'once';
  12     12   39  
  12     12   485  
  12         70  
  12         32  
  12         759  
  12         156  
  12         38  
  12         331  
4 12     12   78 use rlib '../../../../../..';
  12         36  
  12         87  
5              
6             package Devel::Trepan::CmdProcessor::Command::Info::Variables::Lexicals;
7             our (@ISA, @SUBCMD_VARS);
8              
9 12     12   11662 use Devel::Trepan::CmdProcessor::Command::Subcmd::Subsubcmd;
  12         50  
  12         390  
10 12     12   84 use PadWalker qw(peek_my peek_our);
  12         37  
  12         751  
11 12     12   5961 use Devel::Trepan::CmdProcessor::Command::Info_Subcmd::Variables_Subcmd::My;
  12         48  
  12         1044  
12              
13             our $CMD = "info variables lexicals";
14             my @CMD = split(/ /, $CMD);
15 12     12   86 use constant MAX_ARGS => undef;
  12         31  
  12         563  
16 12     12   71 use constant NEED_STACK => 1;
  12         27  
  12         4303  
17              
18             our $MIN_ABBREV = length('l');
19             =pod
20              
21             =head2 Synopsis:
22              
23             =cut
24             our $HELP = <<'HELP';
25             =pod
26              
27             B<info variables lexicals>
28              
29             B<info variables lexicals -v>
30              
31             B<info variables lexicals> I<var1> [I<var2>...]
32              
33             Lists C<my> or C<lexical> variables at the current frame. Use the
34             frame changing commands like C<up>, C<down> or C<frame> set the
35             current frame.
36              
37             In the first form, give a list of C<my> or C<our> variable names only.
38             In the second form, list variable names and values In the third form,
39             list variable names and values of I<var1>, etc.
40              
41             =head2 See also:
42              
43             L<C<info variables
44             my>|Devel::Trepan::CmdProcessor::Command::Info::Variables::My>,
45             L<C<info variables
46             our>|Devel::Trepan::CmdProcessor::Command::Info::Variables::Our>, and
47             frame-changing commands
48             =cut
49             HELP
50             our $SHORT_HELP = "Information about 'my' or 'our' variables.";
51              
52             @ISA = qw(Devel::Trepan::CmdProcessor::Command::Info::Variables::My);
53              
54             sub run($$)
55             {
56 0     0     my ($self, $args) = @_;
57             # FIXME: combine with My.pm
58 0           my $i = 0;
59 0           while (my ($pkg, $file, $line, $fn) = caller($i++)) { ; };
60 0           my $diff = $i - $DB::stack_depth;
61              
62             # FIXME: 4 is a magic fixup constant, also found in DB::finish.
63             # Remove it.
64 0           my $my_hash = peek_my($diff + $self->{proc}->{frame_index} + 4);
65 0           my $our_hash = peek_our($diff + $self->{proc}->{frame_index} + 4);
66              
67 0           my @ARGS = @{$args};
  0            
68 0           @ARGS = splice(@ARGS, scalar(@CMD));
69 0 0         if (scalar(@ARGS == 0)) {
70 0           $self->process_args(\@ARGS, $my_hash, 'my');
71 0           $self->process_args(\@ARGS, $our_hash, 'our');
72             } else {
73 0 0         if ($ARGS[0] eq '-v') {
74 0           $self->process_args(['-v'], $my_hash, 'my');
75 0           $self->process_args(['-v'], $our_hash, 'our');
76             } else {
77 0           my $proc = $self->{proc};
78 0           for my $name (@ARGS) {
79 0 0         if (exists($my_hash->{$name})) {
    0          
80 0           Devel::Trepan::CmdProcessor::Command::Info::Variables::My::show_var($proc, $name, $my_hash->{$name});
81             } elsif (exists($our_hash->{$name})) {
82 0           Devel::Trepan::CmdProcessor::Command::Info::Variables::My::show_var($proc, $name, $our_hash->{$name});
83             } else {
84 0           $proc->errmsg("No 'my' or 'our' variable $name found at this level");
85             }
86             }
87             }
88             }
89             }
90              
91             unless (caller) {
92             # Demo it.
93              
94             }
95              
96             1;