File Coverage

blib/lib/Iterator/Simple.pm

Criterion	Covered	Total	%
statement	170	188	90.4
branch	75	92	81.5
condition	8	19	42.1
subroutine	38	42	90.4
pod	16	16	100.0
total	307	357	85.9

package Iterator::Simple;

use strict;

use Carp;
#use UNIVERSAL qw(isa);
use Scalar::Util qw(blessed reftype);
use overload;
use base qw(Exporter);
use vars qw($VERSION @EXPORT_OK %EXPORT_TAGS);

use constant ITERATOR_CLASS => 'Iterator::Simple::Iterator';
$VERSION = '0.06';

$EXPORT_TAGS{basic} = [qw(iterator iter list is_iterator)];
$EXPORT_TAGS{utils} = [qw(
	ifilter iflatten ichain izip ienumerate
	islice ihead iskip imap igrep iarray
	is_iterable is_listable
)];

push @EXPORT_OK, @{$EXPORT_TAGS{basic}}, @{$EXPORT_TAGS{utils}};
$EXPORT_TAGS{all} = [@EXPORT_OK];

sub iterator(&) { ITERATOR_CLASS->new($_[0]);}

# name: iter
# synopsis: iter($object);
# description:
#   autodetect object type and turn it into iterator
# param: object: object to turn into iterator
# return: iterator
sub iter {
	if(not @_) {
		return iterator { return };
	}
	my($self) = @_;
	if(blessed $self) {
		if($self->isa(ITERATOR_CLASS)) {
			return $self;
		}
		my $method;
		if($method = $self->can('__iter__')) {
			return $method->($self);
		}
		if($method = overload::Method($self, '<>') || $self->can('next')) {
			return ITERATOR_CLASS->new(sub { $method->($self) });
		}
		if($method = overload::Method($self, '&{}')) {
			return ITERATOR_CLASS->new($method->($self));
		}
		if($method = overload::Method($self,'@{}')) {
			return iarray($method->($self));
		}
	}
	if(ref($self) eq 'ARRAY') {
		return iarray($self);
	}
	if(ref($self) eq 'CODE') {
		return ITERATOR_CLASS->new($self);
	}
	if(reftype($self) eq 'GLOB') {
		return ITERATOR_CLASS->new(sub { scalar <$self> });
	}

	croak sprintf "'%s' object is not iterable", (ref($self)||'SCALAR');
}

# name: is_iterable
# synopsis: iter($object);
# description:
#   returns given object is iterable or not.
# param: object
# return: iterator
sub is_iterable {
	my($self) = @_;
	return not not (
		(blessed($self) and (
			$self->isa(ITERATOR_CLASS)
			or $self->can('__iter__')
			or $self->can('next')
			or overload::Method($self, '<>')
			or overload::Method($self, '&{}')
			or overload::Method($self,'@{}')
		))
		or ref($self) eq 'ARRAY'
		or ref($self) eq 'CODE'
		or reftype($self) eq 'GLOB'
	);
}

# name: is_iterator
# synopsis: is_iterator($object);
# description:
#   reports Iterator::Simpler iterator object or not;
# param: object: some object;
# return: bool
sub is_iterator {
	blessed($_[0]) and $_[0]->isa(ITERATOR_CLASS);
}

# name: list
# synopsis: list($object)
# description:
#   autodetect object type and turn it into array reference
# param: object: object to turn into array
# return: array reference
sub list {
	if(not @_) {
		return [];
	}
	my($self) = @_;
	if(ref($self) eq 'ARRAY') {
		return $self;
	}
	if(reftype($self) eq 'GLOB') {
		return [<$self>];
	}
	if(blessed $self) {
		if($self->isa(ITERATOR_CLASS)) {
			my(@list, $val);
			push @list, $val while defined($val = $self->());
			return \@list;
		}
		my $method;
		if($method = overload::Method($self,'@{}')) {
			return $method->($self);
		}
		if($method = $self->can('__iter__')) {
			my(@list, $val);
			my $iter = $method->($self);
			push @list, $val while defined($val = $iter->());
			return \@list;
		}
		if($method = overload::Method($self, '<>') || $self->can('next')) {
			my(@list, $val);
			push @list, $val while defined($val = $method->($self));
			return \@list;
		}
	}
	croak sprintf "'%s' object could not be converted to array ref", (ref($self)||'SCALAR');
}

# name: ifilter
# synopsis: ifilter $iterable, sub { CODE };
# description:
#   filters another iterable object.
#   if filter code yields another iterator, iterate it until it
#   exhausted. if filter code yields undefined value, ignores it.
# param: source: source iterable object
# param: code: transformation code
# return: transformed iterator
sub ifilter {
	my($src, $code) = @_;
	$src = iter($src);
	if(ref($code) ne 'CODE' and ! overload::Method($code, '&{}')) {
		croak 'Second argument to ifilter must be callable.';
	}

	my $buf;

	ref($src)->new(sub {
		my $rv;
		if($buf) {
			return $rv if defined($rv = $buf->());
			undef $buf;
		}
		while(defined(local $_ = $src->())) {
			next unless defined($rv = $code->());
			return $rv unless eval {$rv->isa(ITERATOR_CLASS)};
			$buf = $rv;
			return $rv if defined($rv = $buf->());
			undef $buf;
		}
		return;
	});
}

# name: imap
# synopsis: imap { CODE } $iterable;
# description:
#   simplified version of ifilter, no skip, no inflate.
# param: code: transformation code;
# param: source: source iterable object
# return: transformed iterator;
sub imap(&$) {
	my($code, $src) = @_;
	$src = iter($src);
	ref($src)->new(sub {
		local $_ = $src->();
		return if not defined $_;
		return $code->();
	});
}

# name: igrep
# synopsis: igrep { CODE } $iterable;
# description:
#   iterator filter iterator
# param: code: filter condition
# param: source: source iterable object
# return: filtered iterator
sub igrep(&$) {
	my($code, $src) = @_;
	$src = iter($src);
	ref($src)->new(sub {
		while(defined(my $rv = $src->())) {
			local $_ = $rv;
			return $rv if $code->();
		}
		return;
	});
}

# name: iflatten
# synopsys: iflatten $iterable;
# description:
#   if source iterator yields another iterator, iterate it first.
# param: source: source iterable object
# return: flatten iterator
sub iflatten {
	my($src) = @_;
	$src = iter($src);

	my $buf;
	ref($src)->new(sub {
		my $rv;
		if($buf) {
			return $rv if defined($rv = $buf->());
			undef $buf;
		}
		while(1){
			$rv = $src->();
			return if not defined $rv;
			return $rv unless eval {$rv->isa(ITERATOR_CLASS)};
			$buf = $rv;
			return $rv if defined($rv = $buf->());
			undef $buf;
		}
	});
}

# name: ichain
# synopsis: ichain($iterable1, $iterable2,...)
# description:
#   iterate one or more iterater one by one.
# param: iteraters: one or more iterable object
# return: chained iterator
sub ichain {
	my @srcs = map { iter($_) } @_;
	if(@srcs == 1) {
		return $srcs[0];
	}
	ref($srcs[0])->new(sub{
		while(@srcs) {
			my $rv = $srcs[0]->();
			return $rv if defined $rv;
			shift @srcs;
		}
		return;
	});
}

# name: ienumerate
# sysopsis: ienumerate($iterable);
# description:
#   returns an iterator which yields $souce value with its index.
# param: iterable: source iterator
# return: iterator
sub ienumerate {
	my($src) = @_;
	$src = iter($src);
	my $idx = 0;

	ref($src)->new(sub{
		my $rv = $src->();
		return if not defined $rv;
		return [$idx++, $rv];
	});
}

# name: izip
# synopsis: izip($iterable, ...)
# description:
#   this function returns an iterator yields array reference,
#   where i-th array contains i-th element from each of the argument iterables.
# param: iterables: list of iterables;
# return: zipped iterator;
sub izip {
	my @srcs = map { iter($_) } @_;

	ref($srcs[0])->new(sub{
		my @rv;
		for my $src (@srcs) {
			my $rv = $src->();
			return if not defined $rv;
			push @rv, $rv;
		}
		return \@rv;
	});
}

# name: islice
# synopsis: isplice($iterable, $start, $end, $step);
# description:
#   this function returns an iterator,
# param: iterable: source iterable object
# param: start: how many first values are skipped
# param: end: last index of source iterator
# param: step: step
# return: sliced iterator
sub islice {
	my($src, $next, $end, $step) = @_;
	$next = defined $next  ? int($next) : 0;
	$end = defined $end ? int($end) : -1;
	$step = defined $step ? int($step) : 1;
	if($next == $end) {
		$next = -1;
	}

	$src = iter($src);
	my $idx = 0;

	ref($src)->new(sub{
		return if $next < 0;
		my $rv;
		while($rv = $src->()) {
			if($idx++ == $next) {
				$next += $step;
				if($end > 0 and $next >= $end) {
					$next = -1;
				}
				return $rv;
			}
		}
		return;
	});
}

sub ihead {islice($_[1], 0, $_[0]);}
sub iskip {islice($_[1], $_[0]);}

# name: iarray
# synopsis: iarray $array_ref;
# description:
#   creates iterator from array reference
# param: array_ref: source array reference
# return: iterator
sub iarray {
	my($ary) = @_;
	if(ref($ary) ne 'ARRAY') {
		croak 'Argument to iarray must be ARRAY reference';
	}
	my $idx = 0;

	iterator {
		return if $idx == @$ary;
		return $ary->[$idx++];
	};
}

# class Iterator::Simple::Iterator is underlying Iterator object.
# It is just a blessed subroutine reference.
{
	package Iterator::Simple::Iterator;

	use Carp;
	use overload (
		'<>'  => 'next',
		'|' => 'filter',
		fallback => 1,
	);

	sub new {
		if(ref($_[1]) ne 'CODE') {
			croak 'Parameter to iterator constructor must be code reference.';
		}
		bless $_[1], $_[0];
	}

	sub next { goto shift }

	sub __iter__ { $_[0] }

	*filter = \&Iterator::Simple::ifilter;
	*flatten = \&Iterator::Simple::iflatten;
	*chain = \&Iterator::Simple::ichain;
	*zip = \&Iterator::Simple::izip;
	*enumerate = \&Iterator::Simple::ienumerate;
	*slice  = \&Iterator::Simple::islice;
	sub head { Iterator::Simple::ihead($_[1], $_[0]); }
	sub skip { Iterator::Simple::iskip($_[1], $_[0]); }
}

1;
__END__