File Coverage

blib/lib/RingBuffer.pm
Criterion Covered Total %
statement 97 136 71.3
branch 14 40 35.0
condition 0 3 0.0
subroutine 15 18 83.3
pod 9 10 90.0
total 135 207 65.2


line stmt bran cond sub pod time code
1             package RingBuffer;
2             #
3             # Written by Travis Kent Beste
4             # Tue Oct 28 10:38:33 CDT 2008
5              
6 1     1   22298 use 5.008008;
  1         4  
  1         38  
7 1     1   6 use strict;
  1         2  
  1         32  
8 1     1   4 use warnings;
  1         7  
  1         43  
9              
10             require Exporter;
11              
12 1     1   5 use Carp;
  1         1  
  1         1690  
13             our $AUTOLOAD; # it's a package global
14              
15             our @ISA = qw(Exporter);
16              
17             # Items to export into callers namespace by default. Note: do not export
18             # names by default without a very good reason. Use EXPORT_OK instead.
19             # Do not simply export all your public functions/methods/constants.
20              
21             # This allows declaration use RingBuffer ':all';
22             # If you do not need this, moving things directly into @EXPORT or @EXPORT_OK
23             # will save memory.
24             our %EXPORT_TAGS = ( 'all' => [ qw(
25            
26             ) ] );
27              
28             our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
29              
30             our @EXPORT = qw(
31            
32             );
33              
34             our $VERSION = ( qw$Revision: 5 $ )[1];
35              
36             =head1 NAME
37              
38             RingBuffer - Perl extension for creating a ring buffer of any size with any object as the ring data.
39              
40             =head1 SYNOPSIS
41              
42             use RingBuffer;
43             my $buffer = [];
44             my $ringsize = 256;
45             my $overwrite = 0;
46             my $printextendedinfo = 0;
47             my $r = new RingBuffer(
48             Buffer => $buffer,
49             RingSize => $ringsize,
50             Overwrite => $overwrite,
51             PrintExtendedInfo => $printextendedinfo,
52             );
53              
54             # initialize the ring, in this case with an array
55             $r->ring_init(); # will create 256 ring buffer of array objects
56              
57             # remove an object from the ring
58             my $obj = $r->ring_remove();
59              
60             # add an object to the front of the ring
61             # this is usually used for putting items back on the ring
62             $r->ring_add_to_front($obj);
63              
64             # peek at the next item on the ring
65             my $obj = $r->ring_peek();
66              
67             # clear out the ring, also zeros out the data
68             $r->ring_clear();
69              
70             =cut
71              
72             =head1 DESCRIPTION
73              
74             This software create a ring buffer of EnE length. You can store any type of
75             object inside the buffer that you create. Description of the functions are listed below:
76              
77             =over 4
78              
79             =cut
80              
81             sub new {
82 1     1 0 12 my $class = shift;
83 1         5 my %args = @_;
84              
85 1         10 my %fields = (
86             buffer => $args{'Buffer'},
87             ringsize => $args{'RingSize'},
88             size => 0,
89             head => 0,
90             tail => 0,
91             overwrite => $args{'Overwrite'},
92             printextendedinfo => $args{'PrintExtendedInfo'},
93             );
94              
95 1         9 my $self = {
96             %fields,
97             _permitted => \%fields,
98             };
99 1         4 bless $self, $class;
100            
101 1         4 return $self;
102             }
103              
104             sub AUTOLOAD {
105 185     185   204 my $self = shift;
106 185 50       357 my $type = ref($self) or croak "$self is not an object";
107              
108 185         194 my $name = $AUTOLOAD;
109 185         453 $name =~ s/.*://; # strip fully-qualified portion
110              
111 185 50       417 unless (exists $self->{_permitted}->{$name} ) {
112 0         0 croak "Can't access `$name' field in class $type";
113             }
114              
115 185 100       307 if (@_) {
116 9         19 return $self->{$name} = shift;
117             } else {
118 176         1038 return $self->{$name};
119             }
120             }
121              
122             sub DESTROY {
123 1     1   331 my $self = shift;
124              
125 1 50       100 $self->SUPER::DESTROY if $self->can("SUPER::DESTROY");
126             }
127              
128             #----------------------------------------#
129             # private functions
130             #----------------------------------------#
131              
132             #--------------------#
133             # Calculate the next value for the ring head index.
134             #--------------------#
135             sub _ring_next_head {
136 7     7   8 my $self = shift;
137 7         7 my $next_head = 0;
138              
139             # Get next value for head, and wrap if necessary.
140 7         34 $next_head = $self->head + 1;
141              
142              
143 7 50       26 if ($next_head >= $self->ringsize) {
144 0         0 $next_head = 0;
145             }
146              
147 7         11 return($next_head);
148             }
149              
150             #--------------------#
151             # Calculate the next value for the ring tail index.
152             #--------------------#
153             sub _ring_next_tail {
154 0     0   0 my $self = shift;
155 0         0 my $next_tail = 0;
156              
157             # Get next value for tail, and wrap if necessary.
158 0         0 $next_tail = $self->tail + 1;
159              
160 0 0       0 if ($next_tail >= $self->size) {
161 0         0 $next_tail = 0;
162             }
163              
164 0         0 return($next_tail);
165             }
166              
167             #----------------------------------------#
168             # public functions
169             #----------------------------------------#
170              
171             =item $r->ring_init();
172              
173             Initialize the ring with your object passed to the
174             the 'Buffer=>' argument.
175              
176             =cut
177             #--------------------#
178             # Initialize a ring buffer.
179             #--------------------#
180             sub ring_init {
181 1     1 1 5 my $self = shift;
182              
183             # Set the buffer type
184 1 50       12 if ($self->{'buffer'} =~ /array/i) {
185 1         10 for(my $i = 0; $i < $self->ringsize; $i++) {
186 16         60 $self->{'buffer'}[$i] = 0;
187             }
188             } else {
189             # the object type
190 0         0 $self->{'buffer'} =~ /(.*)=/;
191 0         0 my $type = $1;
192              
193             # first import (like 'use ') but doesn't need to be bareword
194 0         0 import $type;
195              
196             # now call new for the array of objects
197 0         0 for(my $i = 0; $i < $self->size(); $i++) {
198 0         0 $self->{buffer}[$i] = $type->new();
199             }
200             }
201              
202             # Clear the ring buffer.
203 1         7 $self->ring_clear();
204              
205 1         3 return 1;
206             }
207              
208             =item $r->ring_clear();
209              
210             Clear the ring of all objects.
211              
212             =cut
213             #--------------------#
214             # Clear the ring buffer and indices.
215             #--------------------#
216             sub ring_clear {
217 2     2 1 309 my $self = shift;
218              
219 2         9 for(my $i = 0; $i < $self->ringsize; $i++) {
220 32         29 ${$self->buffer}[$i] = 0;
  32         87  
221             }
222              
223 2         3 $self->{head} = 0;
224 2         5 $self->{tail} = 0;
225 2         5 $self->{size} = 0;
226             }
227              
228             =item $r->ring_add();
229              
230             Add an object to the buffer of the ring.
231              
232             =cut
233             #--------------------#
234             # Add a byte to the ring buffer.
235             #--------------------#
236             sub ring_add {
237 7     7 1 3242 my $self = shift;
238 7         10 my $data = shift;
239 7         8 my $next_head = 0;
240 7         9 my $next_tail = 0;
241              
242             # Check for room in the ring buffer.
243 7         14 $next_head = $self->_ring_next_head();
244              
245 7 50       29 if ($self->size == $self->ringsize) {
246             #print "possible overflow!\n";
247              
248 0 0       0 if ($self->overwrite) {
249             #print "overwrite enabled\n";
250              
251             # Add data to buffer and increase the head index.
252 0         0 ${$self->buffer}[$self->head] = $data;
  0         0  
253 0         0 $self->head($next_head);
254             # no size increase
255              
256             } else {
257             #print "overwrite disabled\n";
258              
259             }
260             } else {
261              
262             # Add data to buffer and increase the head index.
263 7         6 ${$self->buffer}[$self->head] = $data;
  7         23  
264 7         22 $self->head($next_head);
265             # size increase
266 7         10 $self->{size}++;
267              
268             }
269              
270 7         21 return 1;
271             }
272              
273             =item $r->ring_remove();
274              
275             Remove an object from the ring and return it.
276              
277             =cut
278             #--------------------#
279             # Remove a data byte from the ring buffer. If no data, returns 0.
280             #--------------------#
281             sub ring_remove {
282 1     1 1 431 my $self = shift;
283 1         4 my $data = 0;
284              
285             # Check for any data in the ring buffer.
286 1 50       6 if ($self->size) {
287             # Remove data byte.
288 1         2 $data = ${$self->buffer}[$self->tail];
  1         6  
289              
290             # zero out the byte when it gets removed, only for development, not for production
291 1         3 ${$self->buffer}[$self->tail] = 0;
  1         31  
292              
293             # Get next value for ring tail index, wrap if necessary.
294 1         6 $self->tail($self->tail + 1);
295 1 50       4 if($self->tail >= $self->ringsize) {
296 0         0 $self->tail(0);
297             }
298              
299             # descrease the size
300 1         3 $self->{size}--;
301             }
302              
303 1         3 return($data);
304             }
305              
306             =item $r->ring_size();
307              
308             Return the size of the ring, takes into account the wrapping
309             around of the ring.
310              
311             =cut
312             #--------------------#
313             # get the ring size
314             #--------------------#
315             sub ring_size {
316 0     0 1 0 my $self = shift;
317              
318 0         0 return $self->size;
319             }
320              
321             =item $r->ring_add_to_front();
322              
323             Add a piece of data to the front of the ring
324              
325             =cut
326             #--------------------#
327             # add a byte to the front or tail of the ring
328             #--------------------#
329             sub ring_add_to_front {
330 1     1 1 396 my $self = shift;
331 1         2 my $data = shift;
332 1         2 my $next_tail = 0;
333              
334             # Check for room in the ring buffer.
335 1         5 $next_tail = $self->tail;
336 1 50       4 if ($next_tail > 0) {
337 1         2 $next_tail--;
338             } else {
339 0         0 $next_tail = $self->ringsize - 1;
340             }
341              
342 1 50       4 if($next_tail != $self->head) {
343             # Add data to buffer and increase the head index.
344 1         2 ${$self->buffer}[$next_tail] = $data;
  1         3  
345 1         4 $self->tail($next_tail);
346              
347 1         1 $self->{size}++;
348             }
349              
350 1         10 return 1;
351             }
352              
353             =item $r->ring_change();
354              
355             Change a piece of data in the ring at the current head location.
356              
357             =cut
358             #--------------------#
359             # change a piece of data in the ring
360             #--------------------#
361             sub ring_change {
362 0     0 1 0 my $self = shift;
363 0         0 my $data = shift;
364 0         0 my $previous_head = 0;
365              
366             # Check for any data in the ring buffer.
367 0 0       0 if($self->head == $self->tail) {
368 0         0 return;
369             }
370              
371 0 0       0 if ($self->head > 0) {
372 0         0 $previous_head = $self->head - 1;
373             } else {
374 0         0 $previous_head = $self->size - 1;
375             }
376              
377 0         0 ${$self->buffer}[$previous_head] = $data;
  0         0  
378             }
379              
380             =item $r->ring_peek();
381              
382             Take a look at the item on the ring to be returned,
383             but do not remove it from the ring.
384              
385             =cut
386             #--------------------#
387             # peek at a byte in the ring buffer
388             #--------------------#
389             sub ring_peek {
390 1     1 1 334 my $self = shift;
391 1         4 my $data = 0;
392              
393             # Check for any data in the ring buffer.
394 1 50       6 if ($self->size) {
395             # get data byte.
396 1         1 $data = ${$self->buffer}[$self->tail];
  1         4  
397             }
398              
399 1         4 return($data);
400             }
401              
402             =item $r->ring_print();
403              
404             Print the contents of the ring. Could be a huge printout
405             if you make the ring size large. Also you can set the variable
406             'PrintExtendedInfo' and get the head and tail on a seperate line.
407              
408             =cut
409             #--------------------#
410             # print contents of the buffer
411             #--------------------#
412             sub ring_print {
413 1     1 1 317 my $self = shift;
414              
415 1         558 printf "size:%02d ", $self->size;
416 1         6 printf "head:%02d ", $self->head;
417 1         5 printf "tail:%02d ", $self->tail;
418 1         21 print "| ";
419 1         5 for(my $r_cntr = 0; $r_cntr < $self->ringsize; $r_cntr++) {
420 16         17 printf "%02x ", ${$self->buffer}[$r_cntr];
  16         38  
421             }
422 1         164 print "\n";
423              
424 1 50       10 if ($self->printextendedinfo) {
425 0         0 print " | ";
426 0         0 for(my $r_cntr = 0; $r_cntr < $self->ringsize; $r_cntr++) {
427 0 0 0     0 if ( ($self->head == $r_cntr) && ($self->tail == $r_cntr) ) {
    0          
    0          
428 0         0 printf "%2s ", 'th';
429             } elsif ($self->head == $r_cntr) {
430 0         0 printf "%2s ", 'h';
431             } elsif ($self->tail == $r_cntr) {
432 0         0 printf "%2s ", 't';
433             } else {
434 0         0 printf "%2d ", $r_cntr;
435             }
436             }
437 0         0 print "\n";
438             }
439              
440 1         2 return 1;
441             }
442              
443             1;
444              
445             __END__