File Coverage

blib/lib/Tie/Array/Iterable.pm

Criterion	Covered	Total	%
statement	129	190	67.8
branch	26	40	65.0
condition	5	19	26.3
subroutine	23	36	63.8
pod	10	10	100.0
total	193	295	65.4

#!/usr/bin/perl -w

package Tie::Array::Iterable;

#=============================================================================
#
# $Id: Iterable.pm,v 0.03 2001/11/16 02:27:56 mneylon Exp $
# $Revision: 0.03 $
# $Author: mneylon $
# $Date: 2001/11/16 02:27:56 $
# $Log: Iterable.pm,v $
# Revision 0.03  2001/11/16 02:27:56  mneylon
# Fixed packing version variables
#
# Revision 0.01.01.2  2001/11/16 02:12:14  mneylon
# Added code to clean up iterators after use
# clear_iterators() now not needed, simply returns 1;
#
# Revision 0.01.01.1  2001/11/15 01:41:19  mneylon
# Branch from 0.01 for new features
#
# Revision 0.01  2001/11/11 18:36:10  mneylon
# Initial Release
#
#
#=============================================================================

use 5.006;
use strict;
use Tie::Array;

use Tie::Array::Iterable::ForwardIterator;
use Tie::Array::Iterable::BackwardIterator;

BEGIN {
    use Exporter   ();
    use vars       qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
    ( $VERSION ) = '$Revision: 0.03 $ ' =~ /\$Revision:\s+([^\s]+)/;
    @ISA         = qw( Exporter Tie::StdArray );
    @EXPORT      = qw( );
	@EXPORT_OK   = qw( iterate_from_start iterate_from_end );
    %EXPORT_TAGS = ( quick=>[ qw( iterate_from_start iterate_from_end ) ] );
}

sub new {
	my $class = shift;
	my @self;
	tie @self, $class, \@_;
	return bless \@self, $class;
}

sub TIEARRAY {
	my $class = shift;
	my $arrayref = shift || [];
	my %data = (
		array => $arrayref,
		forward_iters => [],
		backward_iters => [] );
	return bless \%data, $class;
}

sub FETCH {
	my $self = shift;
	my $index = shift;
	return $self->{ array }->[ $index ];
}

sub STORE {
	my $self = shift;
	my $index = shift;
	my $value = shift;
	$self->{ array }->[ $index ] = $value;
}

sub FETCHSIZE {
	my $self = shift;
	return scalar @{ $self->{ array } };
}

sub STORESIZE {
	my $self  = shift;
	my $count = shift;
	if ( $count > $self->FETCHSIZE() ) {
		foreach ( $count - $self->FETCHSIZE() .. $count ) {
			$self->STORE( $_, '' );
		}
	} elsif ( $count < $self->FETCHSIZE() ) {
		foreach ( 0 .. $self->FETCHSIZE() - $count - 2 ) {
			$self->POP();
		}
	}
}

sub EXTEND {
	my $self = shift;
	my $count = shift;
	$self->STORESIZE( $count );
}

sub EXISTS {
	my $self = shift;
	my $index = shift;
	return exists $self->{ array }->[ $index ];
}

sub CLEAR {
	my $self = shift;
	$self->{ array } = [];
	foreach my $iter ( $self->_get_forward_iters() ) {
		$iter->set_index( 0 );
	}
	foreach my $iter ( $self->_get_backward_iters() ) {
		$iter->set_index( 0 );
	}
	return 1;
}

sub PUSH {
	my $self = shift;
	my @list = @_;
	my $last = $self->FETCHSIZE();
	$self->STORE( $last + $_, $list[$_] ) foreach 0 .. $#list;
	foreach my $iter ( $self->_get_forward_iters() ) {
		if ( $iter->index() == $last ) {
			$iter->set_index( $last + scalar @list );
		}
	}
	foreach my $iter ( $self->_get_backward_iters() ) {
		if ( $iter->index() == $last ) {
			$iter->set_index( $last + scalar @list );
		}
	}
	return $self->FETCHSIZE();
}

sub POP {
	my $self = shift;
	foreach my $iter ( $self->_get_forward_iters() ) {
		if ( $iter->index() >= $self->FETCHSIZE() ) {
			$iter->set_index( $iter->index()-1 );
		}
	}
	foreach my $iter ( $self->_get_backward_iters() ) {
		if ( $iter->index() >= $self->FETCHSIZE() ) {
			$iter->set_index( $iter->index()-1 );
		}
	}

	return pop @{ $self->{ array } };
}

sub UNSHIFT {
	my $self = shift;
	my @list = @_;
	my $size = scalar( @list );
	# make room for our list
	@{$self->{ array }}[ $size .. $#{$self->{ array }} + $size ]
		= @{$self->{ array }};
	$self->STORE( $_, $list[$_] ) foreach 0 .. $#list;
	foreach my $iter ( $self->_get_forward_iters() ) {
		if ( $iter->index() > 0 ) {
			$iter->set_index( $iter->index() + scalar @list );
		}
	}
	foreach my $iter ( $self->_get_backward_iters() ) {
		if ( $iter->index() > 0 ) {
			$iter->set_index( $iter->index() + scalar @list );
		}
	}

}

sub SHIFT {
	my $self = shift;
	foreach my $iter ( $self->_get_forward_iters() ) {
		if ( $iter->index() > 0 ) {
			$iter->set_index( $iter->index()-1 );
		}
	}
	foreach my $iter ( $self->_get_backward_iters() ) {
		if ( $iter->index() > 0 ) {
			$iter->set_index( $iter->index()-1 );
		}
	}
	return shift @{ $self->{ array } };
}

sub SPLICE {
	my $self   = shift;
	my $offset = shift || 0;
	if ( $offset < 0 ) {
		$offset = $self->FETCHSIZE() + $offset + 1;
	}
	my $length = shift;
	if ( $length == 0 && $length ne "0" ) {
		$length = $self->FETCHSIZE() - $offset;
	}
	my @list   = @_;

	# Do the splice first:
	my @data = splice @{ $self->{ array } }, $offset, $length, @list;

	foreach my $iter ( $self->_get_forward_iters() ) {
		# If beyond the splice point...
		if ( $iter->index() > $offset ) {
			# If outside of the offset boundary
			if ( $iter->index() > $offset + $length ) {
				# Simply adjust the counter
				$iter->set_index( $iter->index() +
					( scalar @list - $length ) );
			} else {
				# Push the iter back to the offset point
				$iter->set_index( $offset );
			}
		}
	}
	foreach my $iter ( $self->_get_backward_iters() ) {
		# If beyond the splice point...
		if ( $iter->index() > $offset ) {
			# If outside of the offset boundary
			if ( $iter->index() > $offset + $length ) {
				# Simply adjust the counter
				$iter->set_index( $iter->index() +
					( scalar @list - $length ) );
			} else {
				# Push the iter back to the offset point
				$iter->set_index( $offset + scalar @list + 1 );
			}
		}
	}
	return splice @data;
}

sub from_start () {
	my $self = shift;
	my $iter = new Tie::Array::Iterable::ForwardIterator( $self, 0 );
	push @{ tied(@$self)->{ forward_iters } }, $iter->_id();
	return $iter;
}

sub forward_from  {
	my $self = shift;
	my $pos = shift;
	if ( $pos == 0 && $pos ne "0" ) {
		$pos = 0;
	}
	die "Position must be in array bounds"
		unless $pos >= 0 && $pos < scalar @$self;
	my $iter = new Tie::Array::Iterable::ForwardIterator( $self, $pos );
	push @{ tied(@$self)->{ forward_iters } }, $iter->_id();
	return $iter;
}

sub from_end () {
	my $self = shift;
	my $iter = new Tie::Array::Iterable::BackwardIterator( $self,
		scalar @$self );
	push @{ tied(@$self)->{ backward_iters } }, $iter->_id();
	return $iter;
}

sub backward_from {
	my $self = shift;
	my $pos = shift;
	if ( $pos == 0 && $pos ne "0" ) {
		$pos = scalar @$self;
	}
	die "Position must be in array bounds"
		unless $pos >= 0 && $pos <= scalar @$self;
	my $iter = new Tie::Array::Iterable::BackwardIterator( $self, $pos );
	push @{ tied(@$self)->{ backward_iters } }, $iter->_id();
	return $iter;
}

# This function is no longer necessary

sub clear_iterators {
	1;
}


sub iterate_from_start {
	my $array = new Tie::Array::Iterable( @_ );
	return $array->from_start();
}

sub iterate_from_end {
	my $array = new Tie::Array::Iterable( @_ );
	return $array->from_end();
}

sub iterate_forward_from {
    my $pos = shift;
	my $array = new Tie::Array::Iterable( @_ );
	return $array->forward_from( $pos );
}

sub iterate_backward_from {
    my $pos = shift;
	my $array = new Tie::Array::Iterable( @_ );
	return $array->backward_from( $pos );
}

sub _get_forward_iters {
	my $self = shift;
	return grep { $_ }
	       map { Tie::Array::Iterable::ForwardIterator::_lookup( $_ ) }
		   @{ $self->{ forward_iters } };
}

sub _get_backward_iters {
	my $self = shift;
	return grep { $_ }
	       map { Tie::Array::Iterable::BackwardIterator::_lookup( $_ ) }
		   @{ $self->{ backward_iters } };
}

sub _remove_forward_iterator {
	my $self = shift;
	my $id = shift;
	use Data::Dumper;
	tied(@$self)->{ forward_iters } = [
		grep { $_ != $id }
		@{ tied(@$self)->{ forward_iters } } ];
}

sub _remove_backward_iterator {
	my $self = shift;
	my $id = shift;
	tied(@$self)->{ backward_iters } = [
		grep { $_ != $id }
		@{ tied(@$self)->{ backward_iters } } ];
}

1;
__END__