# -*- coding: utf-8 -*- # Copyright (C) 2011, 2012 Rocky Bernstein use strict; use warnings; no warnings 'redefine'; use English qw( -no_match_vars ); use rlib '../..'; use Devel::Trepan::DB::Breakpoint; package Devel::Trepan::BrkptMgr; 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 $brkpt ($self->list) { next unless defined $brkpt; $str .= $brkpt->inspect . "\n"; } $str; } sub ids($) { my $self = shift; map $_->id, @{$self->compact()}; } sub list($) { my $self = shift; map defined($_) ? $_ : (), @{$self->{list}} } # Remove all breakpoints that we have recorded sub DESTROY() { my $self = shift; for my $bp ($self->list) { $self->delete_by_brkpt($bp); } $self->{clear}; } sub find($$) { my ($self, $index) = @_; return undef unless $index =~ /^\d+$/; for my $bp (@{$self->{list}}) { next unless $bp; return $bp if $bp->id eq $index; } return undef; } sub delete($$) { my ($self, $index) = @_; my $bp = $self->find($index); if (defined ($bp)) { $self->delete_by_brkpt($bp); return $bp; } else { return undef; } } sub delete_by_brkpt($$) { my ($self, $delete_bp) = @_; for my $candidate (@{$self->{list}}) { next unless defined $candidate; if ($candidate eq $delete_bp) { $candidate = undef; $self->{dbgr} && $self->{dbgr}->delete_bp($delete_bp); return $delete_bp; } } return undef; } sub add($$) { my ($self, $brkpt) = @_; push @{$self->{list}}, $brkpt; return $brkpt; } sub compact($) { my $self = shift; my @new_list = (); for my $brkpt (@{$self->{list}}) { next unless defined $brkpt; push @new_list, $brkpt; } $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 $brkpt (@{$self->{list}}) { $max = $brkpt->id if $brkpt->id > $max; } return $max; } sub size($) { my $self = shift; $self->compact(); return scalar @{$self->{list}}; } sub reset($) { my $self = shift; for my $bp (@{$self->{list}}) { $self->{dbgr}->delete_bp($bp); } $self->{list} = []; } unless (caller) { eval <<'EOE'; sub bp_status($$) { my ($brkpts, $i) = @_; printf "list size: %s\n", $brkpts->size(); printf "max: %d\n", $brkpts->max() // -1; print $brkpts->inspect(); print "--- ${i} ---\n"; } EOE require Devel::Trepan::Core; my $dbgr = Devel::Trepan::Core->new; my $brkpts = Devel::Trepan::BrkptMgr->new($dbgr); bp_status($brkpts, 0); my $brkpt1 = DBBreak->new( type=>'brkpt', condition=>'1', id=>1, hits => 0, enabled => 1, negate => 0, filename => __FILE__, line_num => __LINE__ ); $brkpts->add($brkpt1); bp_status($brkpts, 1); my $brkpt2 = DBBreak->new( type=>'brkpt', condition=>'x>5', id=>2, hits => 0, enabled => 0, Negate => 0, filename => __FILE__, line_num => __LINE__ ); $brkpts->add($brkpt2); bp_status($brkpts, 2); $brkpts->delete_by_brkpt($brkpt1); bp_status($brkpts, 3); my $brkpt3 = DBBreak->new( type=>'brkpt', condition=>'y eq x', id=>3, hits => 0, enabled => 1, negate => 1, filename => __FILE__, line_num => __LINE__ ); $brkpts->add($brkpt3); bp_status($brkpts, 4); print "id 3 found is", $brkpts->find(3), "\n"; print "id 4 is undef\n" unless defined $brkpts->find(4); print "id 'a' is undef\n" unless defined $brkpts->find('a'); # p brkpts.delete(2) # p brkpts[2] # bp_status(brkpts, 3) # # Two of the same breakpoints but delete 1 and see that the # # other still stays # offset = frame.pc_offset # b2 = Trepan::Breakpoint.new(iseq, offset) # brkpts << b2 # bp_status(brkpts, 4) # b3 = Trepan::Breakpoint.new(iseq, offset) # brkpts << b3 # bp_status(brkpts, 5) # brkpts.delete_by_brkpt(b2) # bp_status(brkpts, 6) # brkpts.delete_by_brkpt(b3) # bp_status(brkpts, 7) } 1;