view release on metacpan or  search on metacpan

lib/Array/Iterator.pm  view on Meta::CPAN

  my $i = Array::Iterator->new({ __array__ => \@array });

=cut

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 {
			# One element array
			$_array = \@array;
		}
	} else {
		$_array = \@array;
	}
	my $iterator = {
		_current_index => 0,
		_length => 0,
		_iteratee => [],
		_iterated => 0,	# -1 when going backwards, +1 when going forwards
        };
	bless($iterator, $class);
	return $iterator->_init(scalar(@{$_array}), $_array);
}

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;

	# Store a private copy to prevent modifications
	$self->{_iteratee} = [@{$iteratee}];

	return $self;
}

=head2 _current_index

An lvalue-ed subroutine that allows access to the iterator's internal pointer.
This can be used in a subclass to access the value.

=cut

# We need to alter this so it's 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}
}

=head2 _iteratee

This returns the item being iterated over, in our case an array.

=cut

# This we should never need to alter so we don't 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];
}

=head2 _get_item ($iteratee, $index)

This method is used by all other routines to access items. Given the iteratee
and an index, it will return the item being stored in the C<$iteratee> at the index
of C<$index>.

=cut

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

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

=head2 iterated

Access to the _iterated status, for subclasses

=cut

sub iterated {
	my $self = shift;

	return $self->{_iterated};
}

=head2 has_next([$n])

This method returns a boolean. True (1) if there are still more elements in
the iterator, false (0) if there are not.

Takes an optional positive integer (E<gt> 0) that specifies the position you
want to check. This allows you to check if there an element at an arbitrary position.
Think of it as an ordinal number you want to check:

  $i->has_next(2);  # 2nd next element
  $i->has_next(10); # 10th next element

Note that C<has_next(1)> is the same as C<has_next()>.

Throws an exception if C<$n> E<lt>= 0.

=cut

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;
}

=head2 hasNext

Alternative name for has_next

=cut

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

=head2 next