File Coverage

blib/lib/List/Indexed.pm

Criterion	Covered	Total	%
statement	114	121	94.2
branch	23	32	71.8
condition	9	24	37.5
subroutine	17	17	100.0
pod	15	15	100.0
total	178	209	85.1

package List::Indexed;

$VERSION = "1.0";


################################################################################

# PUBLIC INTERFACE

################################################################################


sub new
{
	my $class = shift();

	my $obj = { };
	bless($obj, $class);

	$obj->clear();
	return $obj;
}


sub find
{
	my $obj = shift();
	my ($key) = @_;

	my $position = 0;
	foreach my $k (@{$obj->{'keys'}})
	{
		if ($k eq $key) {
			return $position;
		}
		$position++;
	}
	return undef;
}


sub read
{
	my $obj = shift();
	my ($key) = @_;

	my $element;
	if (defined $key)
	{
		my $position = $obj->find($key);
		if (defined $position) {
			$element = $obj->{'elements'}->[$position];
		}
		return $element;
	}
	else
	{
		my $position = $obj->{'pointer'};
		if (defined $obj->{'keys'}->[$position]) {
			($key, $element) = ($obj->{'keys'}->[$position], $obj->{'elements'}->[$position]);
			$obj->{'pointer'}++;
		}
		return ($key, $element);
	}
}


sub read_at
{
	my $obj = shift();
	my ($position) = @_;

	if (defined $position &&
		defined $obj->{'keys'}->[$position])
	{
		return ($obj->{'keys'}->[$position], $obj->{'elements'}->[$position]);
	}
	return (undef, undef);
}


sub add
{
	my $obj = shift();
	my ($key, $element) = @_;

	if (defined $key ||
		defined $element)
	{
		push(@{$obj->{'keys'}}, $key);
		push(@{$obj->{'elements'}}, $element);
		return 1;
	}
	return 0;
}


sub insert_at
{
	my $obj = shift();
	my ($position, $key, $element) = @_;

	if (defined $position &&
		(defined $key || defined $element))
	{
		$position = $obj->_limit_position($position);

		splice(@{$obj->{'keys'}}, $position, 0, $key);
		splice(@{$obj->{'elements'}}, $position, 0, $element);
		return 1;
	}
	return 0;
}


sub insert_after
{
	my $obj = shift();
	my ($position, $key, $element) = @_;

	if (defined $position &&
		(defined $key || defined $element))
	{
		$position = $obj->_limit_position($position + 1);

		splice(@{$obj->{'keys'}}, $position, 0, $key);
		splice(@{$obj->{'elements'}}, $position, 0, $element);
		return 1;
	}
	return 0;
}


sub remove
{
	my $obj = shift();
	my ($key) = @_;

	my $element;
	if (defined $key)
	{
		my $position = $obj->find($key);
		if (defined $position) {
			$element = $obj->{'elements'}->[$position];
			$obj->_remove_position($position);
		}
		return $element;
	}
	else {
		($key, $element) = (shift(@{$obj->{'keys'}}), shift(@{$obj->{'elements'}}));
		return ($key, $element);
	}
}


sub remove_at
{
	my $obj = shift();
	my ($position) = @_;

	if (defined $position &&
		defined $obj->{'keys'}->[$position])
	{
		my ($key, $element) = ($obj->{'keys'}->[$position], $obj->{'elements'}->[$position]);
		$obj->_remove_position($position);
		return ($key, $element);
	}
	return (undef, undef);
}


sub replace
{
	my $obj = shift();
	my ($key, $element) = @_;

	if (defined $key)
	{
		my $position = $obj->find($key);
		if (defined $position) {
			$obj->{'elements'}->[$position] = $element;
			return 1;
		}
	}
	return 0;
}


sub replace_at
{
	my $obj = shift();
	my ($position, $element) = @_;

	if (defined $position &&
		defined $obj->{'keys'}->[$position])
	{
		$obj->{'elements'}->[$position] = $element;
		return 1;
	}
	return 0;
}


sub reset
{
	my $obj = shift();

	$obj->{'pointer'} = 0;
}


sub size
{
	my $obj = shift();

	return @{$obj->{'keys'}};
}


sub empty
{
	my $obj = shift();

	return (@{$obj->{'keys'}} == 0);
}


sub clear
{
	my $obj = shift();

	$obj->{'keys'} = [];
	$obj->{'elements'} = [];
	$obj->{'pointer'} = 0;
}


################################################################################

# PRIVATE IMPLEMENTATION

################################################################################


sub _remove_position
{
	my $obj = shift();
	my $position = shift();

	splice(@{$obj->{'keys'}}, $position, 1);
	splice(@{$obj->{'elements'}}, $position, 1);
}


sub _limit_position
{
	my $obj = shift();
	my $position = shift();

	if ($position < 0) {
		return 0;
	}
	elsif ($position > @{$obj->{'keys'}}) {
		return scalar(@{$obj->{'keys'}});
	}
	else {
		return $position;
	}
}


1;

__END__