File Coverage

lib/Devel/Trepan/CmdProcessor/Command/Display.pm
Criterion Covered Total %
statement 75 103 72.8
branch 0 8 0.0
condition n/a
subroutine 25 27 92.5
pod 0 2 0.0
total 100 140 71.4


line stmt bran cond sub pod time code
1             # -*- coding: utf-8 -*-
2             # Copyright (C) 2011-2015 Rocky Bernstein <rocky@cpan.org>
3 12     12   101 use warnings; no warnings 'redefine';
  12     12   34  
  12     1   443  
  12     1   68  
  12         92  
  12         442  
  1         8  
  1         2  
  1         27  
  1         5  
  1         2  
  1         30  
4 12     12   79 use rlib '../../../..';
  12     1   31  
  12         80  
  1         5  
  1         2  
  1         5  
5              
6             package Devel::Trepan::CmdProcessor::Command::Display;
7 12     12   4357 use English qw( -no_match_vars );
  12     1   30  
  12         109  
  1         356  
  1         3  
  1         8  
8              
9 12     12   4531 use if !@ISA, Devel::Trepan::DB::Display ;
  12     1   35  
  12         75  
  1         269  
  1         3  
  1         6  
10 12     12   773 use if !@ISA, Devel::Trepan::Condition ;
  12     1   33  
  12         53  
  1         38  
  1         2  
  1         4  
11 12     12   1136 use if !@ISA, Devel::Trepan::CmdProcessor::Command ;
  12     1   34  
  12         56  
  1         28  
  1         3  
  1         4  
12              
13             unless (@ISA) {
14 12     12   80 eval <<"EOE";
  12     12   40  
  12     12   648  
  12     12   69  
  12     12   34  
  12         688  
  12         83  
  12         40  
  12         568  
  12         274  
  12         32  
  12         638  
  12         323  
  12         35  
  12         431  
15             use constant CATEGORY => 'data';
16             use constant NEED_STACK => 0;
17             use constant SHORT_HELP =>
18             'Display expressions when entering debugger';
19             use constant MIN_ARGS => 1; # Need at least this many
20             use constant MAX_ARGS => undef; # Need at most this many - undef -> unlimited.
21             EOE
22             }
23              
24 12     12   1744 use strict; use vars qw(@ISA); @ISA = @CMD_ISA;
  12     12   29  
  12     1   317  
  12     1   63  
  12         28  
  12         548  
  1         62  
  1         3  
  1         22  
  1         5  
  1         2  
  1         48  
25 12     12   66 use vars @CMD_VARS; # Value inherited from parent
  12     1   29  
  12         3702  
  1         5  
  1         2  
  1         264  
26              
27             our $NAME = set_name();
28             =pod
29              
30             =head2 Synopsis:
31              
32             =cut
33             our $HELP = <<'HELP';
34             =pod
35              
36             B<display> I<Perl-expression>
37              
38             Print value of expression I<Perl-expression> each time the program stops.
39              
40             =head2 Examples:
41              
42             display $a # Display variable \$a each time we enter debugger
43             display join(', ', @ARGV) # show values of array @ARGV
44              
45             If what you want to do is evaluate a Perl expression or statement once
46             rather than every time the program stops, see C<eval>.
47              
48             See also L<C<undisplay>|<Devel::Trepan::CmdProcessor::Command::Undisplay>,
49             L<C<enable>|<Devel::Trepan::CmdProcessor::Command::Enable>, and
50             L<C<disable>|<Devel::Trepan::CmdProcessor::Command::Disable>
51             =cut
52             HELP
53              
54             # This method runs the command
55             sub run($$) {
56 0     0 0   my ($self, $args) = @_;
  0     0 0    
57 0           my $proc = $self->{proc};
  0            
58 0           my $display;
  0            
59 0           my @args = @{$args};
  0            
  0            
  0            
60 0           shift @args;
  0            
61              
62 0           $display = join(' ', @args);
  0            
63 0 0         unless (is_valid_condition($display)) {
  0 0          
64 0           $proc->errmsg("Invalid display: $display");
  0            
65             return
66 0           }
  0            
67 0           my $disp = $proc->{displays}->add($display);
  0            
68 0 0         if ($disp) {
  0 0          
69 0           my $mess = sprintf("Display %d set", $disp->number);
  0            
70 0           $proc->msg($mess);
  0            
71             }
72             }
73              
74             unless (caller) {
75             require Devel::Trepan::CmdProcessor::Mock;
76             my $proc = Devel::Trepan::CmdProcessor::Mock::setup();
77             my $cmd = __PACKAGE__->new($proc);
78             $cmd->run([$NAME]);
79             }
80              
81             1;