File Coverage

lib/Devel/Trepan/DB/Display.pm
Criterion Covered Total %
statement 27 99 27.2
branch 0 20 0.0
condition n/a
subroutine 8 21 38.1
pod n/a
total 35 140 25.0


line stmt bran cond sub pod time code
1             # -*- coding: utf-8 -*-
2             # Copyright (C) 2011-2013 Rocky Bernstein <rocky@cpan.org>
3             # FIXME: Could combine manager code from breakpoints and display
4 12     12   82 use strict; use warnings; no warnings 'redefine';
  12     12   27  
  12     12   320  
  12         122  
  12         23  
  12         303  
  12         55  
  12         25  
  12         412  
5 12     12   60 use English qw( -no_match_vars );
  12         32  
  12         76  
6              
7 12     12   3210 use Class::Struct;
  12         25  
  12         82  
8 12     12   1112 use strict;
  12         26  
  12         16130  
9              
10             struct DBDisplay => {
11             number => '$', # display number
12             enabled => '$', # True if display is enabled
13             arg => '$', # What to display
14             fmt => '$', # Format to use in display
15             return_type => '$' # Kind of value expected in return
16             };
17              
18             package DBDisplay;
19             sub inspect($)
20             {
21 0     0   0 my $self = shift;
22 0         0 sprintf("number %s, enabled: %d, fmt: %s, arg: %s",
23             $self->number, $self->enabled, $self->fmt, $self->arg);
24             };
25              
26              
27             package Devel::Trepan::DB::DisplayMgr;
28              
29             sub new($$)
30             {
31 13     13   90 my ($class,$dbgr) = @_;
32 13         444 my $self = {max => 0};
33 13         64 $self->{dbgr} = $dbgr;
34 13         316 bless $self, $class;
35 13         136 $self->clear();
36 13         54 $self;
37             }
38              
39             sub clear($)
40             {
41 13     13   70 my $self = shift;
42 13         283 $self->{list} = [];
43 13         59 $self->{next_id} = 1;
44             }
45              
46             sub inspect($)
47             {
48 0     0     my $self = shift;
49 0           my $str = '';
50 0           for my $display (@{$self->{list}}) {
  0            
51 0 0         next unless defined $display;
52 0           $str .= $display->inspect . "\n";
53             }
54 0           $str;
55             }
56              
57             # Remove all breakpoints that we have recorded
58             sub DESTROY() {
59 0     0     my $self = shift;
60 0           for my $disp (@{$self->{list}}) {
  0            
61 0 0         $self->delete_by_display($disp) if defined($disp);
62             }
63 0           $self->{clear};
64             }
65              
66             sub find($$)
67             {
68             my ($self, $index) = @_;
69             for my $display (@{$self->{list}}) {
70             next unless $display;
71             return $display if $display->number eq $index;
72             }
73             return undef;
74             }
75              
76             sub delete($$)
77             {
78 0     0     my ($self, $index) = @_;
79 0           my $display = $self->find($index);
80 0 0         if (defined ($display)) {
81 0           $self->delete_by_display($display);
82 0           return $display;
83             } else {
84 0           return undef;
85             }
86             }
87              
88             sub delete_by_display($$)
89             {
90 0     0     my ($self, $delete_display) = @_;
91 0           for my $candidate (@{$self->{list}}) {
  0            
92 0 0         next unless defined $candidate;
93 0 0         if ($candidate eq $delete_display) {
94 0           $candidate = undef;
95 0           return $delete_display;
96             }
97             }
98 0           return undef;
99             }
100              
101             sub add($$;$)
102             {
103 0     0     my ($self, $display,$return_type) = @_;
104 0           $self->{max}++;
105 0 0         $return_type = '$' unless defined $return_type;
106 0           my $number = $self->{max};
107 0           my $disp = DBDisplay->new(
108             number => $number,
109             enabled => 1,
110             arg => $display,
111             fmt => '$',
112             return_type => $return_type);
113 0           push @{$self->{list}}, $disp;
  0            
114 0           return $disp;
115             }
116              
117             sub compact($)
118             {
119 0     0     my $self = shift;
120 0           my @new_list = ();
121 0           for my $display (@{$self->{list}}) {
  0            
122 0 0         next unless defined $display;
123 0           push @new_list, $display;
124             }
125 0           $self->{list} = \@new_list;
126 0           return $self->{list};
127             }
128              
129             sub is_empty($)
130             {
131 0     0     my $self = shift;
132 0           $self->compact();
133 0           return scalar(0 == @{$self->{list}});
  0            
134             }
135              
136             sub find($$)
137             {
138 0     0     my ($self, $num) = @_;
139 0           for my $display (@{$self->{list}}) {
  0            
140 0 0         return $display if $display->number == $num;
141             }
142 0           return undef;
143             }
144              
145             sub max($)
146             {
147 0     0     my $self = shift;
148 0           my $max = 0;
149 0           for my $display (@{$self->{list}}) {
  0            
150 0 0         $max = $display->number if $display->number > $max;
151             }
152 0           return $max;
153             }
154              
155             sub size($)
156             {
157 0     0     my $self = shift;
158 0           $self->compact();
159 0           return scalar @{$self->{list}};
  0            
160             }
161              
162             sub reset($)
163             {
164 0     0     my $self = shift;
165 0           $self->{list} = [];
166             }
167              
168              
169             unless (caller) {
170              
171             sub display_status($$)
172             {
173 0     0     my ($displays, $i) = @_;
174 0           printf "list size: %s\n", $displays->size();
175 0           my $max = $displays->max();
176 0 0         $max = -1 unless defined $max;
177 0           printf "max: %d\n", $max;
178 0           print $displays->inspect();
179 0           print "--- ${i} ---\n";
180             }
181              
182             eval "use rlib '..';";
183             require Devel::Trepan::Core;
184             my $dbgr = Devel::Trepan::Core->new;
185             my $displays = Devel::Trepan::DB::DisplayMgr->new($dbgr);
186             display_status($displays, 0);
187             my $display1 = DBDisplay->new(
188             number=>1, enabled => 1, arg => '$dbgr', fmt => '$'
189             );
190              
191             $displays->add($display1);
192             display_status($displays, 1);
193              
194             my $display2 = DBDisplay->new(
195             number=>2, enabled => 0, arg => '$displays', fmt => '$'
196             );
197             $displays->add($display2);
198             display_status($displays, 2);
199              
200             $displays->delete_by_display($display1);
201             display_status($displays, 3);
202              
203             my $display3 = DBDisplay->new(
204             number=>3, enabled => 1, arg => 'foo', fmt => '$'
205             );
206             $displays->add($display3);
207             display_status($displays, 4);
208              
209             }
210              
211             1;