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   93 use warnings; no warnings 'redefine';
  12     12   32  
  12     1   404  
  12     1   60  
  12         24  
  12         333  
  1         7  
  1         2  
  1         22  
  1         5  
  1         3  
  1         35  
4 12     12   59 use rlib '../../../..';
  12     1   24  
  12         135  
  1         6  
  1         2  
  1         4  
5              
6             package Devel::Trepan::CmdProcessor::Command::Delete;
7 12     12   4249 use English qw( -no_match_vars );
  12     1   26  
  12         65  
  1         342  
  1         2  
  1         5  
8              
9 12     12   4244 use if !@ISA, Devel::Trepan::CmdProcessor::Command ;
  12     1   27  
  12         64  
  1         231  
  1         2  
  1         4  
10              
11             unless (@ISA) {
12 12     12   105 eval <<"EOE";
  12     12   25  
  12     12   610  
  12     12   66  
  12     12   29  
  12     12   676  
  12         70  
  12         26  
  12         532  
  12         80  
  12         35  
  12         9828  
  12         72  
  12         55  
  12         594  
  12         81  
  12         27  
  12         521  
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   1780 use strict; use vars qw(@ISA); @ISA = @CMD_ISA;
  12     12   30  
  12     1   341  
  12     1   66  
  12         38  
  12         631  
  1         90  
  1         3  
  1         19  
  1         4  
  1         2  
  1         58  
23 12     12   70 use vars @CMD_VARS; # Value inherited from parent
  12     1   27  
  12         4094  
  1         6  
  1         2  
  1         279  
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;