File Coverage

lib/Devel/Trepan/CmdProcessor/Command/Clear.pm
Criterion Covered Total %
statement 81 108 75.0
branch 4 24 16.6
condition n/a
subroutine 23 24 95.8
pod 0 2 0.0
total 108 158 68.3


line stmt bran cond sub pod time code
1             # -*- coding: utf-8 -*-
2             # Copyright (C) 2015 Rocky Bernstein <rocky@cpan.org>
3 12     12   1150 use warnings; no warnings 'redefine';
  12     12   25  
  12     2   397  
  12     2   59  
  12         24  
  12         393  
  2         19  
  2         4  
  2         52  
  2         10  
  2         4  
  2         65  
4 12     12   64 use rlib '../../../..';
  12     2   24  
  12         80  
  2         10  
  2         3  
  2         10  
5              
6             package Devel::Trepan::CmdProcessor::Command::Clear;
7 12     12   4457 use English qw( -no_match_vars );
  12     2   24  
  12         65  
  2         678  
  2         4  
  2         10  
8              
9 12     12   4264 use if !@ISA, Devel::Trepan::CmdProcessor::Command ;
  12     2   24  
  12         88  
  2         636  
  2         4  
  2         10  
10              
11             unless (@ISA) {
12 12     12   73 eval <<"EOE";
  12     12   24  
  12     12   622  
  12     12   69  
  12     12   26  
  12     12   621  
  12         72  
  12         27  
  12         526  
  12         68  
  12         24  
  12         516  
  12         77  
  12         23  
  12         514  
  12         86  
  12         32  
  12         495  
13             use constant ALIASES => qw(d);
14             use constant CATEGORY => 'breakpoints';
15             use constant SHORT_HELP => 'Clear some breakpoints';
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             use constant NEED_STACK => 0;
19             EOE
20             }
21              
22 12     12   1922 use strict; use vars qw(@ISA); @ISA = @CMD_ISA;
  12     12   33  
  12     2   367  
  12     2   64  
  12         36  
  12         640  
  2         126  
  2         3  
  2         49  
  2         9  
  2         4  
  2         123  
23 12     12   72 use vars @CMD_VARS; # Value inherited from parent
  12     2   25  
  12         8712  
  2         12  
  2         4  
  2         951  
24              
25             our $NAME = set_name();
26             =pod
27              
28             =head2 Synopsis:
29              
30             =cut
31             our $HELP = <<'HELP';
32             =pod
33              
34             B<clear> [I<line-number>]
35              
36             =head2 See also:
37              
38             L<C<delete>|Devel::Trepan::CmdProcessor::Command::Delete>,
39              
40             =cut
41             HELP
42              
43             # This method runs the command
44             sub run($$) {
45 2     2 0 2525 my ($self, $args) = @_;
  0     0 0    
46 2         10 my $proc = $self->{proc};
  0            
47 2         5 my @args = @$args;
  0            
48 2         6 my $line_number = $proc->{frame}{line};
  0            
49              
50 2 100       6 if (scalar @args > 1) {
  0 0          
51 1         8 $line_number = $proc->get_an_int($args->[1]);
  0            
52 1 50       97 return unless $line_number;
  0 0          
53             }
54              
55 2         5 my $bpmgr = $proc->{brkpts};
  0            
56 2         4 my @brkpts = @{$bpmgr->{list}};
  2         6  
  0            
  0            
57 2         3 my @line_nos = ();
  0            
58 2         5 foreach my $bp (@brkpts) {
  0            
59 0 0       0 if ($bp->line_num == $line_number) {
  0 0          
60 0         0 my $bp_num = $bp->id;
  0            
61 0         0 push @line_nos, $bp_num;
  0            
62 0         0 $proc->{brkpts}->delete($bp_num);
  0            
63             }
64             }
65 2         6 my $count = scalar @line_nos;
  0            
66 2 50       5 if ($count == 0) {
  0 0          
    0          
    0          
    0          
    0          
67 2         17 $self->errmsg(sprintf "No breakpoint at line %d", $line_number);
  0            
68             } elsif ($count == 1) {
69 0           $self->msg(sprintf "Deleted breakpoint %d", $line_nos[0]);
  0            
70             } elsif ($count >= 1) {
71 0           $self->msg(sprintf "Deleted breakpoints %s", join(' ', @line_nos));
  0            
72             }
73             }
74              
75             unless (caller) {
76             require Devel::Trepan::DB;
77             require Devel::Trepan::Core;
78             my $db = Devel::Trepan::Core->new;
79             my $intf = Devel::Trepan::Interface::User->new(undef, undef, {readline => 0});
80             my $proc = Devel::Trepan::CmdProcessor->new([$intf], $db);
81              
82             $proc->{stack_size} = 0;
83             $proc->{frame} = {line => 1};
84             my $cmd = __PACKAGE__->new($proc);
85             $cmd->run([$NAME]);
86             $cmd->run([$NAME, '5']);
87             }
88              
89             1;