File Coverage

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

Criterion	Covered	Total	%
statement	87	123	70.7
branch	0	8	0.0
condition			n/a
subroutine	29	31	93.5
pod	0	2	0.0
total	116	164	70.7

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

package Devel::Trepan::CmdProcessor::Command::Watch;
use English qw( -no_match_vars );

use if !@ISA, Devel::Trepan::WatchMgr ;
use if !@ISA, Devel::Trepan::Condition ;
use if !@ISA, Devel::Trepan::CmdProcessor::Command ;

unless (@ISA) {
    eval <<'EOE';
#   eval "use constant ALIASES    => qw(w);";
use constant CATEGORY   => 'breakpoints';
use constant NEED_STACK => 0;
use constant SHORT_HELP =>
    'Set to enter debugger when a watched expression changes';
use constant MIN_ARGS   => 1;     # Need at least this many
use constant MAX_ARGS   => undef; # Need at most this many - undef -> unlimited.
EOE
}

use strict; use vars qw(@ISA); @ISA = @CMD_ISA;
use vars @CMD_VARS;  # Value inherited from parent

our $NAME = set_name();
=pod

=head2 Synopsis:

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

B<watch> I<Perl-expression>

Stop every time I<Perl-expression> changes from its prior value.

=head2 Examples:

 watch $a  # enter debugger when the value of $a changes
 watch scalar(@ARGV))  # enter debugger if size of @ARGV changes.

=head2 See also

L<C<delete>|Devel::Trepan::CmdProcessor::Command::Delete>,
L<C<enable>|Devel::Trepan::CmdProcessor::Command::Enable>,
L<C<disable>|Devel::Trepan::CmdProcessor::Command::Disable>, and
L<C<info watch>|Devel::Trepan::CmdProcessor::Command::Watch>.

=cut
HELP

no warnings 'redefine';

# This method runs the command
sub run($$) {
    my ($self, $args) = @_;
    my $proc = $self->{proc};
    my $expr;
    my @args = @{$args};
    shift @args;

    $expr = join(' ', @args);
    unless (is_valid_condition($expr)) {
        $proc->errmsg("Invalid watch expression: $expr");
        return
    }
    my $wp = $proc->{dbgr}->{watch}->add($expr);
    if ($wp) {
        # FIXME: handle someday...
        # my $cmd_name = $args->[0];
        # my $opts->{return_type} = parse_eval_suffix($cmd_name);
        my $opts = {return_type => '$'};
        my $mess = sprintf("Watch expression %d: %s set", $wp->id, $expr);
        $proc->msg($mess);
        $proc->eval($expr, $opts);
        $proc->{set_wp} = $wp;

        # Without setting $DB::trace = 1, it is possible
        # that a continue won't trigger calls to $DB::DB
        # and therefore we won't check watch expressions.
	no warnings 'once';
        $DB::trace = 1;
    }
}

unless (caller) {
    require Devel::Trepan::CmdProcessor::Mock;
    my $proc = Devel::Trepan::CmdProcessor::Mock::setup();
    # my $cmd = __PACKAGE__->new($proc);
    # $cmd->run([$NAME]);
}

1;