File Coverage

lib/Devel/Trepan/CmdProcessor/Command/Delete.pm
Criterion Covered Total %
statement 66 90 73.3
branch 0 16 0.0
condition n/a
subroutine 22 24 91.6
pod 0 2 0.0
total 88 132 66.6


line stmt bran cond sub pod time code
1             # -*- coding: utf-8 -*-
2             # Copyright (C) 2011-2014 Rocky Bernstein <rocky@cpan.org>
3 12     12   106 use warnings; no warnings 'redefine';
  12     12   31  
  12     1   459  
  12     1   72  
  12         30  
  12         459  
  1         8  
  1         3  
  1         22  
  1         4  
  1         3  
  1         26  
4 12     12   76 use rlib '../../../..';
  12     1   28  
  12         83  
  1         4  
  1         3  
  1         4  
5              
6             package Devel::Trepan::CmdProcessor::Command::Delete;
7 12     12   4066 use English qw( -no_match_vars );
  12     1   26  
  12         148  
  1         473  
  1         3  
  1         9  
8              
9 12     12   4496 use if !@ISA, Devel::Trepan::CmdProcessor::Command ;
  12     1   36  
  12         82  
  1         450  
  1         4  
  1         9  
10              
11             unless (@ISA) {
12 12     12   84 eval <<"EOE";
  12     12   29  
  12     12   670  
  12     12   85  
  12     12   30  
  12     12   612  
  12         79  
  12         31  
  12         795  
  12         78  
  12         31  
  12         491  
  12         66  
  12         32  
  12         546  
  12         65  
  12         26  
  12         445  
13             use constant ALIASES => qw(d);
14             use constant CATEGORY => 'breakpoints';
15             use constant SHORT_HELP => 'Delete 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   1981 use strict; use vars qw(@ISA); @ISA = @CMD_ISA;
  12     12   30  
  12     1   294  
  12     1   64  
  12         33  
  12         568  
  1         103  
  1         4  
  1         36  
  1         8  
  1         3  
  1         79  
23 12     12   70 use vars @CMD_VARS; # Value inherited from parent
  12     1   27  
  12         3599  
  1         10  
  1         4  
  1         454  
24              
25             our $NAME = set_name();
26             =pod
27              
28             =head2 Synopsis:
29              
30             =cut
31             our $HELP = <<'HELP';
32             =pod
33              
34             B<delete> [I<bp-number> [I<bp-number>...]]
35              
36             Delete some breakpoints.
37              
38             Arguments are breakpoint numbers with spaces in between. To delete
39             all breakpoints, give no arguments.
40              
41             See also the C<clear> command which clears breakpoints by line number
42             and C<info break> to get a list of breakpoint numbers.
43              
44             =head2 Examples:
45              
46             delete 1 # delete breakpoint number 1
47              
48             =head2 See also:
49              
50             L<C<break>|Devel::Trepan::CmdProcessor::Command::Break>,
51             L<C<enable>|Devel::Trepan::CmdProcessor::Command::Enable>, and
52             L<C<disable>|Devel::Trepan::CmdProcessor::Command::Disable>.
53              
54             =cut
55             HELP
56              
57             # This method runs the command
58             sub run($$) {
59 0     0 0   my ($self, $args) = @_;
  0     0 0    
60 0           my $proc = $self->{proc};
  0            
61 0           my @args = @$args;
  0            
62              
63 0 0         if (scalar @args == 1) {
  0 0          
64 0 0         if ($proc->confirm('Delete all breakpoints?', 0)) {
  0 0          
65 0           $proc->{brkpts}->reset;
  0            
66 0           return;
  0            
67             }
68             }
69 0           shift @args;
  0            
70 0           for my $num_str (@args) {
  0            
71 0           my $bp_num = $proc->get_an_int($num_str);
  0            
72 0 0         my $success = $proc->{brkpts}->delete($bp_num) if $bp_num;
  0 0          
73 0 0         $proc->msg("Deleted breakpoint $bp_num") if $success;
  0 0          
74             }
75             }
76              
77             unless (caller) {
78             require Devel::Trepan::CmdProcessor::Mock;
79             my $proc = Devel::Trepan::CmdProcessor::Mock::setup();
80             # my $cmd = __PACKAGE__->new($proc);
81             # $cmd->run([$NAME]);
82             }
83              
84             1;