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   92 use warnings; no warnings 'redefine';
  12     12   29  
  12     1   370  
  12     1   58  
  12         29  
  12         357  
  1         7  
  1         1  
  1         23  
  1         4  
  1         2  
  1         26  
4 12     12   71 use rlib '../../../..';
  12     1   47  
  12         67  
  1         5  
  1         2  
  1         3  
5              
6             package Devel::Trepan::CmdProcessor::Command::Display;
7 12     12   4291 use English qw( -no_match_vars );
  12     1   26  
  12         69  
  1         345  
  1         2  
  1         6  
8              
9 12     12   4435 use if !@ISA, Devel::Trepan::DB::Display ;
  12     1   28  
  12         84  
  1         278  
  1         2  
  1         5  
10 12     12   729 use if !@ISA, Devel::Trepan::Condition ;
  12     1   24  
  12         54  
  1         32  
  1         2  
  1         3  
11 12     12   926 use if !@ISA, Devel::Trepan::CmdProcessor::Command ;
  12     1   39  
  12         54  
  1         40  
  1         2  
  1         5  
12              
13             unless (@ISA) {
14 12     12   960 eval <<"EOE";
  12     12   35  
  12     12   736  
  12     12   83  
  12     12   30  
  12         627  
  12         86  
  12         27  
  12         554  
  12         68  
  12         26  
  12         595  
  12         69  
  12         31  
  12         434  
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   1762 use strict; use vars qw(@ISA); @ISA = @CMD_ISA;
  12     12   27  
  12     1   417  
  12     1   64  
  12         24  
  12         586  
  1         63  
  1         2  
  1         29  
  1         5  
  1         2  
  1         40  
25 12     12   91 use vars @CMD_VARS; # Value inherited from parent
  12     1   37  
  12         3829  
  1         5  
  1         2  
  1         285  
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;