File Coverage

lib/Devel/Trepan/CmdProcessor/Command/Undisplay.pm
Criterion Covered Total %
statement 63 93 67.7
branch 0 16 0.0
condition n/a
subroutine 21 23 91.3
pod 0 2 0.0
total 84 134 62.6


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   109 use warnings; no warnings 'redefine';
  12     12   34  
  12     1   424  
  12     1   75  
  12         33  
  12         410  
  1         8  
  1         2  
  1         25  
  1         9  
  1         2  
  1         32  
4 12     12   77 use rlib '../../../..';
  12     1   35  
  12         79  
  1         7  
  1         2  
  1         5  
5              
6             package Devel::Trepan::CmdProcessor::Command::Undisplay;
7 12     12   4327 use English qw( -no_match_vars );
  12     1   29  
  12         104  
  1         360  
  1         2  
  1         12  
8              
9 12     12   4519 use if !@ISA, Devel::Trepan::CmdProcessor::Command ;
  12     1   34  
  12         75  
  1         317  
  1         3  
  1         5  
10              
11             unless (@ISA) {
12 12     12   83 eval <<'EOE';
  12     12   36  
  12     12   653  
  12     12   81  
  12     12   32  
  12         615  
  12         83  
  12         31  
  12         511  
  12         73  
  12         33  
  12         478  
  12         78  
  12         36  
  12         392  
13             use constant CATEGORY => 'data';
14             use constant NEED_STACK => 0;;
15             use constant SHORT_HELP => 'Cancel some expressions to be displayed when program stops';
16             use constant MIN_ARGS => 0; # Need at least this many
17             use constant MAX_ARGS => undef; # Need at most this many - undef -> unlimited.
18             EOE
19             }
20              
21 12     12   1762 use strict; use vars qw(@ISA); @ISA = @CMD_ISA;
  12     12   32  
  12     1   309  
  12     1   64  
  12         34  
  12         583  
  1         57  
  1         3  
  1         19  
  1         5  
  1         2  
  1         46  
22 12     12   76 use vars @CMD_VARS; # Value inherited from parent
  12     1   30  
  12         3443  
  1         5  
  1         2  
  1         270  
23              
24             our $NAME = set_name();
25             =pod
26              
27             =head2 Synopsis:
28              
29             =cut
30             our $HELP = <<'HELP';
31             =pod
32              
33             B<undisplay> [I<display-number> ...]
34              
35             Cancel some expressions to be displayed when program stops. Arguments
36             are the code numbers of the expressions to stop displaying. No
37             argument means cancel all automatic-display expressions.
38              
39             =head2 See also:
40              
41             L<C<info display>|Devel::Trepan::CmdProcessor::Command::Info::Display>
42             =cut
43             HELP
44              
45             # This method runs the command
46             sub run($$) {
47 0     0 0   my ($self, $args) = @_;
  0     0 0    
48 0           my $proc = $self->{proc};
  0            
49 0           my @args = @$args;
  0            
50              
51 0 0         if (scalar @args == 1) {
  0 0          
52 0 0         if ($proc->confirm('Delete all displays?', 0)) {
  0 0          
53 0           $proc->{displays}->reset;
  0            
54 0           return;
  0            
55             }
56             }
57 0           shift @args;
  0            
58 0           for my $num_str (@args) {
  0            
59 0           my $opts = {msg_on_error => sprintf('%s must be a display number', $num_str)};
  0            
60 0           my $i = $proc->get_an_int($num_str);
  0            
61 0 0         if ($i) {
  0 0          
62 0 0         unless($proc->{displays}->delete($i)) {
  0 0          
63 0           $proc->errmsg("No display number $i");
  0            
64 0           return;
  0            
65             }
66             }
67             }
68             }
69              
70             unless (caller) {
71             require Devel::Trepan::CmdProcessor::Mock;
72             my $proc = Devel::Trepan::CmdProcessor::Mock::setup();
73             # my $cmd = __PACKAGE__->new($proc);
74             # $cmd->run([$NAME]);
75             }
76              
77             1;