File Coverage

lib/Data/RefQueue.pm

Criterion	Covered	Total	%
statement	24	106	22.6
branch	2	32	6.2
condition	1	6	16.6
subroutine	7	20	35.0
pod	1	17	5.8
total	35	181	19.3

package Data::RefQueue;
# Data::RefQueue - Queue system based on references and scalars.
# (c) 2002 - Ask Solem
# All rights reserved.
#
#   This program is free software; you can redistribute it and/or modify
#   it under the terms of the GNU General Public License version 2
#   as published by the Free Software Foundation.
#
#   This program is distributed in the hope that it will be useful,
#   but WITHOUT ANY WARRANTY; without even the implied warranty of
#   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#   GNU General Public License for more details.
#
#   You should have received a copy of the GNU General Public License
#   along with this program; if not, write to the Free Software
#   Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
#
#
# $Id: RefQueue.pm,v 1.1 2007/05/07 13:08:23 ask Exp $
# $Source: /opt/CVS/DataRefqueue/lib/Data/RefQueue.pm,v $
# $Author: ask $
# $HeadURL$
# $Revision: 1.1 $
# $Date: 2007/05/07 13:08:23 $
#####

use 5.006;
use strict;
use vars qw($VERSION $DEBUG);

$DEBUG = 0;

$VERSION = '0.4';

# ### prototypes
sub new;		# new RefQueue object.
sub set;		# set queue values.
sub setpos;		# set position.
sub getpos;		# get position.
sub size;		# return the number of elements in queue.
sub next;		# set position to next element.
sub prev;		# set position to previous element.
sub save;		# save current position and set pos to next.
sub reset;		# reset the position to the first element.
sub fetch;		# fetch current position.
sub queue;		# the queue itself.
sub filled;		# return all filled positions.
sub delete;		# delete (truncate) current element.
sub remove;		# remove this element.
sub cleanse;	# remove all positions not filled.
sub insert_at;  # find the element that contains 'key' and replace key with value.
sub not_filled;	# return all positions that isn't filled.

# #### data::refqueue new(string pkg, array values)
# Create a new RefQueue queue starting with @values.
#
sub new {
	my($class, @values) = @_;
	my $self = { };
	bless $self, $class;

	if (scalar @values) {
		$self->set(@values);
	}
	$self->reset;

	return $self;
}

# #### arrayref queue(data::refqueue q)
# The queue itself.
#
sub queue {
	my ($self) = @_;
	$self->{QUEUE} ||= [ ];
	return $self->{QUEUE};
}

# #### int setpos(data::refqueue q, int pos)
# Set current queue position.
# XXX: Wraps around if higher/lower than availible elements.
#
sub setpos {
	my ($self, $pos) = @_;
	my ($package, $filename, $line, $subroutine) = caller( );

	if ($pos >= 0) {

		if ($pos > $self->size) {
			$pos = 0;
		}
        elsif ($pos < 0) {
			$pos = $self->size;
		}

		$self->{POS} = $pos;
	}
}

# #### int getpos(data::refqueue q)
# Get current queue position.
#
sub getpos {
	my ($self) = @_;
	return $self->{POS};
}


# #### int size(data::refqueue q)
# Return the number of elements in the queue.
#
sub size {
	my ($self) = @_;
	my $q = $self->queue;
	return $#$q;
}

# #### void set(data::refqueue q, array values)
# Initialize queue, with values @values.
#
sub set {
	my ($self, @values) = @_;
	my $q = $self->queue;
	print {*STDERR} "SET ". join(", ", @values). "\n" if $DEBUG;
	@$q = @values;
}

# #### void next(data::refqueue q)
# Set position to the next availible position.
#
sub next {
	my ($self) = @_;
	my $pos = $self->getpos() + 1;
	$pos ||= 1;
	$self->setpos($pos);
}

# #### void next(data::refqueue q)
# Set position to the previous availible position.
#
sub prev {
	my ($self) = @_;
	my $pos = $self->getpos() - 1;
	$pos ||= 0;
	$self->setpos($pos);
}

# #### void reset(data::refqueue q)
# Set queue position to 0.
#
sub reset {
	my ($self) = @_;
	$self->{POS} = 0;
}

# #### void cleanse(data::refqueue q)
# Remove all positions not filled.
sub cleanse {
	my ($self) = @_;
	my $q = $self->queue;
	MAIN:
	while (1) {
		ELEMENT:
		for (my $qi; $qi <= $self->size; $qi++) {
			if (! ref $q->[$qi]) {
				$self->remove($self->setpos($qi));
                goto MAIN;
# We use iteration instead of recursion for performance.
# Therefore the goto.
			}
		}
		last MAIN;
	}
}

# #### arrayref not_filled(data::refqueue q)
# Return an array with the values not filled.
#
sub not_filled {
	my ($self) = @_;
	my $q = $self->queue;
	my @ret;
	for (my $qi = 0; $qi <= $self->size; $qi++) {
		if (! ref $q->[$qi]) {
			push @ret, $q->[$qi];
		}
	}
	return \@ret;
}

# #### arrayref filled(data::refqueue q)
# Return an array with the values filled.
#
sub filled {
	my ($self) = @_;
	my $q = $self->queue;
	my @ret;
	for (my $qi = 0; $qi <= $self->size; $qi++) {
		if (ref $q->[$qi]) {
			push @ret, $q->[$qi];
		}
	}
	return \@ret;
}

# #### void* fetch(data::refqueue q)
# Fetch the value in the current position.
#
sub fetch {
	my ($self) = @_;
	print {*STDERR} "FETCH AT ".$self->getpos(). "\n" if $DEBUG;
	return $self->queue->[$self->getpos()];
}

# #### void delete(data::refqueue q)
# Delete the contents of the current position.
#
sub delete {
	my ($self) = @_;
	print {*STDERR} "DELETE AT ".$self->getpos(). "\n" if $DEBUG;
	return delete $self->queue->[$self->getpos()];
}

# #### void save(data::refqueue q, void* value)
# Save something into the current position and set position
# to the next availible element in the queue.
#
sub save {
	my ($self, $value) = @_;
	print {*STDERR} "SAVE AT ".$self->getpos(). "\n" if $DEBUG;
	my $q = $self->queue;
	$q->[$self->getpos()] = $value;
	return $self->next;
}

# ### void remove(data::refqueue)
# Remove the current position entirely, decrementing
# the size of the queue by one.
#
sub remove {
	my ($self) = @_;
	my $q = $self->queue;
	my @copy;
	print {*STDERR} "REMOVE AT ".$self->getpos(). "\n" if $DEBUG;
	for (my $qi = 0; $qi <= $self->size; $qi++) {
		if ($qi != $self->getpos()) {
			push @copy, $q->[$qi];
		}
	}
	$self->set(@copy);
    return;
}

# ### int insert_at(data::refqueue q, void* key, void* value)
# Find the element that contains 'key' and replace key with value.
#
sub insert_at {
	my ($self, $key, $value) = @_;
	my $orig_pos = $self->getpos();
	my $q = $self->queue;
	print {*STDERR} "INSERT AT $key $value\n" if $DEBUG;
	for (my $qi = 0; $qi <= $self->size; $qi++) {
		if ($q->[$qi] eq $key) {
			print {*STDERR} "KEY '$key' IS AT ELEMENT NUMBER ;$qi;\n" if $DEBUG;
			$self->setpos($qi);
			$self->save($value);
			$self->setpos($orig_pos);
			return 1;
		}
	}
	return;
}

1;
__END__