File Coverage

lib/Devel/Trepan/CmdProcessor/Command/Disable.pm

Criterion	Covered	Total	%
statement	57	173	32.9
branch	0	52	0.0
condition			n/a
subroutine	19	27	70.3
pod	0	8	0.0
total	76	260	29.2

# Copyright (C) 2011-2012, 2014 Rocky Bernstein <[e-mail]>
# -*- coding: utf-8 -*-
use warnings; no warnings 'redefine';
use rlib '../../../..';

# disable breakpoint command. The difference however is that the
# parameter to @proc.en_disable_breakpoint_by_number is different (set
# as ENABLE_PARM below).
#
# NOTE: The enable command  subclasses this, so beware when changing!
package Devel::Trepan::CmdProcessor::Command::Disable;
use if !@ISA, Devel::Trepan::CmdProcessor::Command ;
use strict;

use vars qw(@ISA);

unless (@ISA) {
    eval <<"EOE";
use constant CATEGORY   => 'breakpoints';
use constant SHORT_HELP => 'Disable some breakpoints';
use constant MIN_ARGS  => 0;  # Need at least this many
use constant MAX_ARGS  => undef;  # Need at most this many - undef -> unlimited.
use constant NEED_STACK => 0;
EOE
}

@ISA = @CMD_ISA;
use vars @CMD_VARS;  # Value inherited from parent

# require_relative '../breakpoint'
# require_relative '../../app/util'

our $NAME = set_name();
=pod

=head2 Synopsis:

=cut
our $HELP = <<'HELP';
=pod

B<disable> I<bp-number> [I<bp-number> ...]

Disables the breakpoints given as a space separated list of breakpoint
numbers.

=head2 Examples:

 disable 1 2    # Enable breakpoint 1 and 2
 disable b1 b2  # Same as above
 disable a4     # Enable action 4
 disable w1 2   # Enable watch expression 1 and breakpoint 2

=head2 See also:

L<C<info break>|Devel::Trepan::CmdProcessor::Command::Info::Breakpoints> to
get a list of breakpoints, and
L<C<enable>|<Devel::Trepan::CmdProcessor::Command::Enable> to
enable breakpoints.

=cut
HELP

### FIXME: parameterize and combine these. Also combine with enable.
sub disable_breakpoint($$) {
    my ($proc, $i) = @_;
    my $bp = $proc->{brkpts}->find($i);
    my $msg;
    if ($bp) {
        if ($bp->enabled) {
            $bp->enabled(0);
            $msg = sprintf("Breakpoint %d disabled", $bp->id);
            $proc->msg($msg);
        } else {
            $msg = sprintf("Breakpoint %d already disabled", $bp->id);
            $proc->errmsg($msg);
        }
    } else {
        $msg = sprintf("No breakpoint %d found", $i);
        $proc->errmsg($msg);
    }
}

sub disable_watchpoint($$) {
    my ($proc, $i) = @_;
    my $wp = $proc->{dbgr}{watch}->find($i);
    my $msg;
    if ($wp) {
        if ($wp->enabled) {
            $wp->enabled(0);
            $msg = sprintf("Watch expression %d disabled", $wp->id);
            $proc->msg($msg);
        } else {
            $msg = sprintf("Watch expression %d already disabled", $wp->id);
            $proc->errmsg($msg);
        }
    } else {
        $msg = sprintf("No watchpoint %d found", $i);
        $proc->errmsg($msg);
    }
}

sub disable_action($$) {
    my ($proc, $i) = @_;
    my $act = $proc->{actions}->find($i);
    my $msg;
    if ($act) {
        if ($act->enabled) {
            $act->enabled(0);
            $msg = sprintf("Action %d disabled", $act->id);
            $proc->msg($msg);
        } else {
            $msg = sprintf("Action %d already disabled", $act->id);
            $proc->errmsg($msg);
        }
    } else {
        $msg = sprintf("No action %d found", $i);
        $proc->errmsg($msg);
    }
}

sub run($$)
{
    my ($self, $args) = @_;
    my $proc = $self->{proc};
    my @args = @{$args};
    if (scalar @args == 1) {
        $proc->errmsg('No breakpoint number given.');
        return;
    }
    my $first = shift @args;
    for my $num_str (@args) {
        my $type = lc(substr($num_str,0,1));
        if ($type !~ /[0-9baw]/) {
            $proc->errmsg("Invalid prefix $type. Argument $num_str ignored");
            next;
        }
        if ($type =~ /[0-9]/) {
            $type='b';
        } else {
            $num_str = substr($num_str, 1);
        }
        my $i = $proc->get_an_int($num_str);
        if (defined $i) {
            if ('a' eq $type) {
                disable_action($proc, $i);
            } elsif ('b' eq $type) {
                disable_breakpoint($proc, $i);
            } elsif ('w' eq $type) {
                disable_watchpoint($proc, $i);
            }
        }
    }
}

unless (caller) {
  # require_relative '../mock'
  # dbgr, cmd = MockDebugger::setup
  # cmd.run([cmd.name])
  # cmd.run([cmd.name, '1'])
  # cmdproc = dbgr.core.processor
  # cmds = cmdproc.commands
  # break_cmd = cmds['break']
  # break_cmd.run(['break', cmdproc.frame.source_location[0].to_s])
  # # require_relative '../../lib/trepanning'
  # # Trepan.debug
  # cmd.run([cmd.name, '1'])
}

1;