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   1444 use warnings; no warnings 'redefine';
  12     12   30  
  12     2   432  
  12     2   71  
  12         27  
  12         400  
  2         16  
  2         5  
  2         52  
  2         8  
  2         5  
  2         52  
4 12     12   73 use rlib '../../../..';
  12     2   28  
  12         102  
  2         9  
  2         4  
  2         11  
5              
6             package Devel::Trepan::CmdProcessor::Command::Clear;
7 12     12   4424 use English qw( -no_match_vars );
  12     2   34  
  12         87  
  2         632  
  2         5  
  2         11  
8              
9 12     12   4454 use if !@ISA, Devel::Trepan::CmdProcessor::Command ;
  12     2   34  
  12         82  
  2         571  
  2         5  
  2         13  
10              
11             unless (@ISA) {
12 12     12   84 eval <<"EOE";
  12     12   34  
  12     12   715  
  12     12   90  
  12     12   38  
  12     12   549  
  12         72  
  12         116  
  12         513  
  12         70  
  12         36  
  12         473  
  12         77  
  12         36  
  12         496  
  12         73  
  12         34  
  12         450  
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   2038 use strict; use vars qw(@ISA); @ISA = @CMD_ISA;
  12     12   36  
  12     2   296  
  12     2   67  
  12         32  
  12         572  
  2         126  
  2         4  
  2         44  
  2         8  
  2         5  
  2         88  
23 12     12   68 use vars @CMD_VARS; # Value inherited from parent
  12     2   87  
  12         5837  
  2         11  
  2         4  
  2         758  
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 0     0 0 0 my ($self, $args) = @_;
  2     2 0 1155  
46 0         0 my $proc = $self->{proc};
  2         9  
47 0         0 my @args = @$args;
  2         6  
48 0         0 my $line_number = $proc->{frame}{line};
  2         5  
49              
50 0 0       0 if (scalar @args > 1) {
  2 100       7  
51 0         0 $line_number = $proc->get_an_int($args->[1]);
  1         8  
52 0 0       0 return unless $line_number;
  1 50       3  
53             }
54              
55 0         0 my $bpmgr = $proc->{brkpts};
  2         5  
56 0         0 my @brkpts = @{$bpmgr->{list}};
  0         0  
  2         5  
  2         5  
57 0         0 my @line_nos = ();
  2         5  
58 0         0 foreach my $bp (@brkpts) {
  2         5  
59 0 0       0 if ($bp->line_num == $line_number) {
  0 0       0  
60 0         0 my $bp_num = $bp->id;
  0         0  
61 0         0 push @line_nos, $bp_num;
  0         0  
62 0         0 $proc->{brkpts}->delete($bp_num);
  0         0  
63             }
64             }
65 0         0 my $count = scalar @line_nos;
  2         5  
66 0 0       0 if ($count == 0) {
  2 0       6  
    0          
    50          
    0          
    0          
67 0         0 $self->errmsg(sprintf "No breakpoint at line %d", $line_number);
  2         20  
68             } elsif ($count == 1) {
69 0         0 $self->msg(sprintf "Deleted breakpoint %d", $line_nos[0]);
  0            
70             } elsif ($count >= 1) {
71 0         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;