File Coverage

blib/lib/Array/Iterator.pm

Criterion	Covered	Total	%
statement	76	78	97.4
branch	43	44	97.7
condition	4	6	66.6
subroutine	20	21	95.2
pod	8	13	61.5
total	151	162	93.2

package Array::Iterator;

use strict;
use warnings;

our $VERSION = '0.12'; # VERSION

### constructor

sub new {
	my ($_class, @array) = @_;
	(@array)
        || die "Insufficient Arguments : you must provide something to iterate over";
	my $class = ref($_class) || $_class;
	my $_array;
	if (scalar @array == 1) {
		if (ref $array[0] eq "ARRAY") {
		    $_array = $array[0];
		}
		elsif (ref $array[0] eq "HASH") {
		    die "Incorrect type : HASH reference must contain the key __array__"
		        unless exists $array[0]->{__array__};
		    die "Incorrect type : __array__ value must be an ARRAY reference"
		        unless ref $array[0]->{__array__} eq 'ARRAY';
		    $_array = $array[0]->{__array__};
		}
		else {
		    die "Incorrect Type : the argument must be an array or hash reference";
		}
	}
	else {
		$_array = \@array;
	}
	my $iterator = {
        _current_index => 0,
        _length => 0,
        _iteratee => [],
        _iterated => 0,
        };
	bless($iterator, $class);
	$iterator->_init(scalar(@{$_array}), $_array);
	return $iterator;
}

### methods

# private methods

sub _init {
	my ($self, $length, $iteratee) = @_;
	(defined($length) && defined($iteratee))
        || die "Insufficient Arguments : you must provide an length and an iteratee";
	$self->{_current_index} = 0;
	$self->{_length} = $length;
	$self->{_iteratee} = $iteratee;
}

# protected method

# this can be used in a subclass to access the value

# we need to alter this so its an lvalue
sub _current_index : lvalue {
    (UNIVERSAL::isa((caller)[0], __PACKAGE__))
        || die "Illegal Operation : This method can only be called by a subclass";
    $_[0]->{_current_index}
}

# this we should never need to alter
# so we dont make it a lvalue
sub _iteratee {
    (UNIVERSAL::isa((caller)[0], __PACKAGE__))
        || die "Illegal Operation : This method can only be called by a subclass";
    $_[0]->{_iteratee}
}

# we move this from a private method
# to a protected one, and check our access
# as well
sub _getItem {
    (UNIVERSAL::isa((caller)[0], __PACKAGE__))
        || die "Illegal Operation : This method can only be called by a subclass";
	my ($self, $iteratee, $index) = @_;
	return $iteratee->[$index];
}

sub _get_item { my $self = shift; $self->_getItem(@_) }

# we need to alter this so its an lvalue
sub _iterated : lvalue {
    (UNIVERSAL::isa((caller)[0], __PACKAGE__))
        || die "Illegal Operation : This method can only be called by a subclass";
    $_[0]->{_iterated}
}

# public methods

# this defines the interface
# an iterator object will have

sub iterated {
    my ($self) = @_;
    return $self->{_iterated};
}

sub has_next {
	my ($self, $n) = @_;

    if(not defined $n) { $n = 1 }
    elsif(not $n)      { die "has_next(0) doesn't make sense, did you mean current()?" }
    elsif($n < 0)      { die "has_next() with negative argument doesn't make sense, perhaps you should use a BiDirectional iterator" }

    my $idx = $self->{_current_index} + ($n - 1);

	return ($idx < $self->{_length}) ? 1 : 0;
}

sub hasNext { my $self = shift; $self->has_next(@_) }

sub next {
	my ($self) = @_;
    ($self->{_current_index} < $self->{_length})
        || die "Out Of Bounds : no more elements";
        $self->{_iterated} = 1;
	return $self->_getItem($self->{_iteratee}, $self->{_current_index}++);
}

sub get_next {
	my ($self) = @_;
        $self->{_iterated} = 1;
    return undef unless ($self->{_current_index} < $self->{_length});
	return $self->_getItem($self->{_iteratee}, $self->{_current_index}++);
}

sub getNext { my $self = shift; $self->get_next(@_) }

sub peek {
	my ($self, $n) = @_;

    if(not defined $n) { $n = 1 }
    elsif(not $n)      { die "peek(0) doesn't make sense, did you mean get_next()?" }
    elsif($n < 0)      { die "peek() with negative argument doesn't make sense, perhaps you should use a BiDirectional iterator" }

    my $idx = $self->{_current_index} + ($n - 1);

    return undef unless ($idx < $self->{_length});
	return $self->_getItem($self->{_iteratee}, $idx);
}

sub current {
	my ($self) = @_;
	return $self->_getItem($self->{_iteratee}, $self->currentIndex());
}

sub current_index {
	my ($self) = @_;
	return ($self->{_current_index} != 0) ? $self->{_current_index} - 1 : 0;
}

sub currentIndex { my $self = shift; $self->current_index(@_) }

sub get_length {
    my ($self) = @_;
    return $self->{_length};
}

sub getLength { my $self = shift; $self->get_length(@_) }

1;
# ABSTRACT: A simple class for iterating over Perl arrays

__END__