The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package RingBuffer;
#
# Written by Travis Kent Beste
# Tue Oct 28 10:38:33 CDT 2008

use 5.008008;
use strict;
use warnings;

require Exporter;

use Carp;
our $AUTOLOAD;  # it's a package global

our @ISA = qw(Exporter);

# Items to export into callers namespace by default. Note: do not export
# names by default without a very good reason. Use EXPORT_OK instead.
# Do not simply export all your public functions/methods/constants.

# This allows declaration	use RingBuffer ':all';
# If you do not need this, moving things directly into @EXPORT or @EXPORT_OK
# will save memory.
our %EXPORT_TAGS = ( 'all' => [ qw(
	
) ] );

our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );

our @EXPORT = qw(
	
);

our $VERSION = ( qw$Revision: 5 $ )[1];

=head1 NAME

RingBuffer - Perl extension for creating a ring buffer of any size with any object as the ring data.

=head1 SYNOPSIS

  use RingBuffer;
  my $buffer            = [];
  my $ringsize          = 256;
  my $overwrite         = 0;
  my $printextendedinfo = 0;
  my $r = new RingBuffer(
    Buffer            => $buffer,
    RingSize          => $ringsize,
    Overwrite         => $overwrite,
		PrintExtendedInfo => $printextendedinfo,
	);

  # initialize the ring, in this case with an array
  $r->ring_init(); # will create 256 ring buffer of array objects

  # remove an object from the ring
  my $obj = $r->ring_remove();

  # add an object to the front of the ring
  # this is usually used for putting items back on the ring
  $r->ring_add_to_front($obj);

  # peek at the next item on the ring
  my $obj = $r->ring_peek();

  # clear out the ring, also zeros out the data
  $r->ring_clear();

=cut

=head1 DESCRIPTION

This software create a ring buffer of E<lt>nE<gt> length.  You can store any type of 
object inside the buffer that you create.  Description of the functions are listed below:

=over 4

=cut

sub new {
	my $class = shift;
	my %args  = @_; 

	my %fields = (
		buffer            => $args{'Buffer'},
		ringsize          => $args{'RingSize'},
		size              => 0,
		head              => 0,
		tail              => 0,
		overwrite         => $args{'Overwrite'},
		printextendedinfo => $args{'PrintExtendedInfo'},
	);

	my $self = {
		%fields,
		_permitted => \%fields,
	};
	bless $self, $class;
      
	return $self;
} 

sub AUTOLOAD {
	my $self = shift;
	my $type = ref($self) or croak "$self is not an object";

	my $name = $AUTOLOAD;
	$name =~ s/.*://;   # strip fully-qualified portion

	unless (exists $self->{_permitted}->{$name} ) {
		croak "Can't access `$name' field in class $type";
	}

	if (@_) {
		return $self->{$name} = shift;
	} else {
		return $self->{$name};
	}
}

sub DESTROY {
	my $self = shift;

	$self->SUPER::DESTROY if $self->can("SUPER::DESTROY");
}

#----------------------------------------#
# private functions
#----------------------------------------#

#--------------------#
# Calculate the next value for the ring head index.
#--------------------#
sub _ring_next_head {
	my $self      = shift;
  my $next_head = 0;

	# Get next value for head, and wrap if necessary.
	$next_head = $self->head + 1;


	if ($next_head >= $self->ringsize) {
		$next_head = 0;
	}

	return($next_head);
}

#--------------------#
# Calculate the next value for the ring tail index.
#--------------------#
sub _ring_next_tail {
	my $self = shift;
  my $next_tail = 0;

	# Get next value for tail, and wrap if necessary.
	$next_tail = $self->tail + 1;

	if ($next_tail >= $self->size) {
		$next_tail = 0;
	}

	return($next_tail);
}

#----------------------------------------#
# public functions
#----------------------------------------#

=item $r->ring_init();

	Initialize the ring with your object passed to the
the 'Buffer=><obj>' argument.

=cut
#--------------------#
# Initialize a ring buffer.
#--------------------#
sub ring_init {
	my $self = shift;

	# Set the buffer type
	if ($self->{'buffer'} =~ /array/i) {
		for(my $i = 0; $i < $self->ringsize; $i++) {
			$self->{'buffer'}[$i] = 0;
		}
	} else {
		# the object type
		$self->{'buffer'} =~ /(.*)=/;
		my $type = $1;

		# first import (like 'use <module_name>') but doesn't need to be bareword
		import $type;

		# now call new for the array of objects
		for(my $i = 0; $i < $self->size(); $i++) {
			$self->{buffer}[$i] = $type->new();
		}
	}

	# Clear the ring buffer.
	$self->ring_clear();

	return 1;
}

=item $r->ring_clear();

	Clear the ring of all objects.

=cut
#--------------------#
# Clear the ring buffer and indices.
#--------------------#
sub ring_clear {
	my $self = shift;

	for(my $i = 0; $i < $self->ringsize; $i++) {
		${$self->buffer}[$i] = 0;
	}

	$self->{head} = 0;
	$self->{tail} = 0;
	$self->{size} = 0;
}

=item $r->ring_add();

	Add an object to the buffer of the ring.

=cut
#--------------------#
# Add a byte to the ring buffer.
#--------------------#
sub ring_add {
	my $self      = shift;
	my $data      = shift;
	my $next_head = 0;
	my $next_tail = 0;

	# Check for room in the ring buffer.
	$next_head = $self->_ring_next_head();

	if ($self->size == $self->ringsize) {
		#print "possible overflow!\n";

		if ($self->overwrite) {
			#print "overwrite enabled\n";

			# Add data to buffer and increase the head index.
			${$self->buffer}[$self->head] = $data;
			$self->head($next_head);
			# no size increase

		} else {
			#print "overwrite disabled\n";

		}
	} else {

		# Add data to buffer and increase the head index.
		${$self->buffer}[$self->head] = $data;
		$self->head($next_head);
		# size increase
		$self->{size}++;

	}

	return 1;
}

=item $r->ring_remove();

	Remove an object from the ring and return it.

=cut
#--------------------#
# Remove a data byte from the ring buffer. If no data, returns 0.
#--------------------#
sub ring_remove {
	my $self = shift;
	my $data = 0;

	# Check for any data in the ring buffer.
	if ($self->size) {
		# Remove data byte.
		$data = ${$self->buffer}[$self->tail];

		# zero out the byte when it gets removed, only for development, not for production
		${$self->buffer}[$self->tail] = 0;

		# Get next value for ring tail index, wrap if necessary.
		$self->tail($self->tail + 1);
		if($self->tail >= $self->ringsize) {
			$self->tail(0);
		}

		# descrease the size
		$self->{size}--;
	}

	return($data);
}

=item $r->ring_size();

	Return the size of the ring, takes into account the wrapping
around of the ring.

=cut
#--------------------#
# get the ring size
#--------------------#
sub ring_size {
	my $self = shift;

	return $self->size;
}

=item $r->ring_add_to_front();

	Add a piece of data to the front of the ring

=cut
#--------------------#
# add a byte to the front or tail of the ring
#--------------------#
sub ring_add_to_front {
	my $self      = shift;
	my $data      = shift;
	my $next_tail = 0;

	# Check for room in the ring buffer.
	$next_tail = $self->tail;
	if ($next_tail > 0) {
		$next_tail--;
	} else {
		$next_tail = $self->ringsize - 1;
	}

	if($next_tail != $self->head) {
		# Add data to buffer and increase the head index.
		${$self->buffer}[$next_tail] = $data;
		$self->tail($next_tail);

		$self->{size}++;
	}

	return 1;
}

=item $r->ring_change();

	Change a piece of data in the ring at the current head location.

=cut
#--------------------#
# change a piece of data in the ring
#--------------------#
sub ring_change {
	my $self          = shift;
	my $data          = shift;
	my $previous_head = 0;

	# Check for any data in the ring buffer.
	if($self->head == $self->tail) {
		return;
	}

	if ($self->head > 0) {
		$previous_head = $self->head - 1;
	} else {
		$previous_head = $self->size - 1;
	}

	${$self->buffer}[$previous_head] = $data;
}

=item $r->ring_peek();

	Take a look at the item on the ring to be returned,
but do not remove it from the ring.

=cut
#--------------------#
# peek at a byte in the ring buffer
#--------------------#
sub ring_peek {
	my $self = shift;
  my $data = 0;

	# Check for any data in the ring buffer.
	if ($self->size) {
		# get data byte.
		$data = ${$self->buffer}[$self->tail];
	}

	return($data);
}

=item $r->ring_print();

	Print the contents of the ring.  Could be a huge printout
if you make the ring size large.  Also you can set the variable 
'PrintExtendedInfo' and get the head and tail on a seperate line.

=cut
#--------------------#
# print contents of the buffer
#--------------------#
sub ring_print {
	my $self = shift;

	printf "size:%02d ", $self->size;
	printf "head:%02d ", $self->head;
	printf "tail:%02d ", $self->tail;
	print "| ";
	for(my $r_cntr = 0; $r_cntr < $self->ringsize; $r_cntr++) {
		printf "%02x ", ${$self->buffer}[$r_cntr];
	}
	print "\n";

	if ($self->printextendedinfo) {
		print "                        | ";
		for(my $r_cntr = 0; $r_cntr < $self->ringsize; $r_cntr++) {
			if ( ($self->head == $r_cntr) && ($self->tail == $r_cntr) ) {
				printf "%2s ", 'th';
			} elsif ($self->head == $r_cntr) {
				printf "%2s ", 'h';
			} elsif ($self->tail == $r_cntr) {
				printf "%2s ", 't';
			} else {
				printf "%2d ", $r_cntr;
			}
		}
		print "\n";
	}

	return 1;
}

1;

__END__

=back

=head2 EXPORT

None by default.

=head1 BUGS

None that I know of right now.

=head1 SEE ALSO

perl(1).

I also have a website where you can find the latest versions of this software:

=over 4

=item http://www.travisbeste.com/software/perl/RingBuffer

=back

=head1 AUTHOR

Please e-mail me with problems, bug fixes, comments and complaints.

Travis Kent Beste, E<lt>travis@tencorners.comE<gt>

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2008 by Travis Kent Beste

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.8.8 or,
at your option, any later version of Perl 5 you may have available.


=cut