File Coverage

lib/Devel/Trepan/WatchMgr.pm

Criterion	Covered	Total	%
statement	75	93	80.6
branch	8	18	44.4
condition	0	4	0.0
subroutine	18	22	81.8
pod	0	13	0.0
total	101	150	67.3

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

use Class::Struct;
use strict;

struct WatchPoint => {
    id          => '$', # watchpoint number
    enabled     => '$', # True if watchpoint is enabled
    hits        => '$', # How many times watch was hit
    expr        => '$', # what Perl expression to evaluate
    old_value   => '$', # Previous value
    current_val => '$', # Current value. Set only when != old value
};

package WatchPoint;
sub inspect($)
{
    my $self = shift;
    sprintf("watchpoint %d, expr %s, old_value: %s, current_value %s",
            $self->id, $self->expr, $self->old_value // 'undef',
            $self->current_val // 'undef',
        );
};

package Devel::Trepan::WatchMgr;

sub new($$)
{
    my ($class, $dbgr) = @_;
    my $self = {};
    $self->{dbgr} = $dbgr;
    bless $self, $class;
    $self->clear();
    $self;
}

sub clear($)
{
    my $self = shift;
    $self->{list} = [];
    $self->{next_id} = 1;
}

sub inspect($)
{
    my $self = shift;
    my $str = '';
    for my $watchpoint ($self->list) {
        next unless defined $watchpoint;
        $str .= $watchpoint->inspect . "\n";
    }
    $str;
}

sub list($)
{
    my $self = shift;
    return @{$self->{list}};

}

# Remove all breakpoints that we have recorded
sub DESTROY() {
    my $self = shift;
    for my $id ($self->list) {
        $self->delete_by_object($id) if defined($id);
    }
    $self->{clear};
}

sub find($$)
{
    my ($self, $index) = @_;
    for my $object ($self->list) {
        next unless $object;
        return $object if $object->id eq $index;
    }
    return undef;
}

sub delete($$)
{
    my ($self, $index) = @_;
    my $object = $self->find($index);
    if (defined ($object)) {
        $self->delete_by_object($object);
        return $object;
    } else {
        return undef;
    }
}

sub delete_by_object($$)
{
    my ($self, $delete_object) = @_;
    my @list = $self->list;
    my $i = 0;
    for my $candidate (@list) {
        next unless defined $candidate;
        if ($candidate eq $delete_object) {
            splice @list, $i, 1;
            $self->{list} = \@list;
            return $delete_object;
        }
    }
    return undef;
}

sub add($$)
{
    my ($self, $expr) = @_;
    my $watchpoint = WatchPoint->new(
        id       => $self->{next_id}++,
        enabled => 1,
        hits    => 0,
        expr    => $expr,
        );

    push @{$self->{list}}, $watchpoint;
    return $watchpoint;
}

sub compact($)
{
    my $self = shift;
    my @new_list = ();
    for my $watchpoint ($self->list) {
        next unless defined $watchpoint;
        push @new_list, $watchpoint;
    }
    $self->{list} = \@new_list;
    return $self->{list};
}

sub is_empty($)
{
    my $self = shift;
    $self->compact();
    return scalar(0 == $self->list);
}

sub max($)
{
    my $self = shift;
    my $max = 0;
    for my $watchpoint ($self->list) {
        $max = $watchpoint->id if $watchpoint->id > $max;
    }
    return $max;
}

sub size($)
{
    my $self = shift;
    $self->compact();
    return scalar $self->list;
}

sub reset($)
{
    my $self = shift;
    for my $id ($self->list) {
        $self->{dbgr}->delete_object($id);
     }
    $self->{list} = [];
}


unless (caller) {

    eval <<'EOE';
    sub wp_status($$)
    {
        my ($watchpoints, $i) = @_;
        printf "list size: %s\n", $watchpoints->size();
        printf "max: %d\n", $watchpoints->max() // -1;
        print $watchpoints->inspect();
        print "--- ${i} ---\n";
    }
EOE

    my $watchpoints = Devel::Trepan::WatchMgr->new('bogus');
wp_status($watchpoints, 0);

my $watchpoint1 = $watchpoints->add('1+2');
wp_status($watchpoints, 1);
$watchpoints->add('3*4');
wp_status($watchpoints, 2);

$watchpoints->delete_by_object($watchpoint1);
wp_status($watchpoints, 3);

$watchpoints->add('3*4+5');
wp_status($watchpoints, 4);

$watchpoints->delete(2);
wp_status($watchpoints, 5);

}

1;