Iterator-Simple-0.07/0000755000175000017500000000000013212262105014240 5ustar michaelmichaelIterator-Simple-0.07/t/0000755000175000017500000000000013212262105014503 5ustar michaelmichaelIterator-Simple-0.07/t/25_islice.t0000644000175000017500000000174213212257136016462 0ustar michaelmichaeluse Test::More tests => 7; use strict; use warnings; use Iterator::Simple qw(:all); my $itr; { my $ary = [qw(a b c d e f g h i j)]; $itr = islice($ary, 2, 8); is_deeply list($itr) => [qw(c d e f g h)], 'islice'; } { my $ary = [qw(a b c d e f g h i j)]; $itr = islice($ary, 2, 8, 2); is_deeply list($itr) => [qw(c e g)], 'islice with step'; } { my $ary = [qw(a b c d e f g h i j)]; $itr = islice($ary, 1, 8, 2); is_deeply list($itr) => [qw(b d f h)], 'islice with step2'; } { my $ary = [qw(a b c d e f g h i j)]; $itr = islice($ary, 4, undef, 2); is_deeply list($itr) => [qw(e g i )], 'islice with step without $end'; } { my $ary = [qw(a b c d e f g h i j)]; $itr = ihead(5, $ary); is_deeply list($itr) => [qw(a b c d e)], 'ihead'; } { my $ary = [qw(a b c d e f g h i j)]; $itr = iskip(5, $ary); is_deeply list($itr) => [qw(f g h i j)], 'iskip'; } { my $ary = [qw(1 0 3 7)]; $itr = islice($ary, 0, 3); is_deeply list($itr) => [qw(1 0 3)], 'islice including 0'; } Iterator-Simple-0.07/t/22_ifilter.t0000755000175000017500000000164312437437260016656 0ustar michaelmichaeluse Test::More tests=>5; use strict; use warnings; use Iterator::Simple qw(:all); my $itr; { $itr = [1,2,'STR',4, 52, 'foo', 12, 3]; eval { no warnings 'numeric'; $itr = ifilter $itr, sub{ if($_ eq 'STR') { return iter([ split '', $_]); } elsif($_ >= 1 and $_ < 11) { return $_ + 10; } elsif($_ >= 11 and $_ <= 21) { return; #skip } elsif($_ > 21) { return $_ % 10; } else { return $_ } }; }; is($@, '', 'ifilter creation'); ok is_iterator($itr), 'ifilter confirm'; is_deeply list($itr) => [11,12,'S','T','R',14, 2, 'foo', 13], 'ifilter result'; } { $itr = [ 1, 2, 3 ]; eval { $itr = ifilter $itr, bless({ code => sub { $_ + 1 } } => 'ifiltertest'); }; is($@, '', 'ifilter creation'); is_deeply list($itr) => [ 2, 3, 4 ], 'ifilter result'; } package ifiltertest; use overload ( '&{}' => '_call', fallback => 1, ); sub _call { shift->{code} } Iterator-Simple-0.07/t/40_defval.t0000755000175000017500000000165612437437260016465 0ustar michaelmichaeluse Test::More tests => 7; use strict; use warnings; use Iterator::Simple qw(:all); my $itr; { $_ = 'DUMMY'; list(igrep { $_ % 5 } [1..20]); is($_, 'DUMMY', 'preserve $_ value after igrep'); list(imap { $_ + 2 } [1..20]); is($_, 'DUMMY', 'preserve $_ value after imap'); $itr = ifilter [1 .. 20], sub { if($_ % 5 == 0) { return iter([1 .. $_]); #inflate } elsif($_ % 3 == 0) { return; #skip } else { return $_; } }; list($itr); is($_, 'DUMMY', 'preserve $_ value after ifilter'); list(izip(['dogs', 'cats', 'pigs'], ['bowow','mew','oink'])); is($_, 'DUMMY', 'preserve $_ value after izip'); list(ichain ['blah', 'bla', 'bl'], ['foo', 'bar', 'baz']); is($_, 'DUMMY', 'preserve $_ value after ichain'); list(ienumerate(['foo','bar','baz'])); is($_, 'DUMMY', 'preserve $_ value after ienumerate'); list(islice([1..100], 3, 20, 2)); is($_, 'DUMMY', 'preserve $_ value after islice'); } Iterator-Simple-0.07/t/10_basic.t0000755000175000017500000000161012437437257016276 0ustar michaelmichaeluse Test::More tests => 5; use strict; use warnings; use Iterator::Simple qw(:all); sub mk_itr { my($start, $max) = @_; my $cur = $start; iterator { return if $cur > $max; return $cur++; } } my $itr; #1 ok( mk_itr(1,5), 'iterator creation' ); #2 { $itr = mk_itr(2,8); my @res; while(defined(my $r = $itr->next)) { push @res, $r } is_deeply ( \@res, [2,3,4,5,6,7,8], 'next method'); } #3 { $itr = mk_itr(3,6); my @res; while(defined(my $r = $itr->())) { push @res, $r } is_deeply ( \@res, [3,4,5,6], 'direct execute' ); } #4 { $itr = mk_itr(11,15); is_deeply ( list($itr), [11,12,13,14,15], 'listize' ); } #5 { $itr = mk_itr(1,5); my @res; while(<$itr>) { push @res, $_; } is_deeply ( \@res, [1,2,3,4,5], '"<>" overload' ); } # @{} overloads could cause confusion ##6 #{ # $itr = mk_itr(12,17); # is_deeply ( [@{$itr}], [12,13,14,15,16,17], '"@{}" overload' ); #} Iterator-Simple-0.07/t/24_imisc.t0000755000175000017500000000144412437437260016325 0ustar michaelmichaeluse Test::More tests => 6; use strict; use warnings; use Iterator::Simple qw(:all); my $itr; #1-2 ichain { my $ary = [1,2,3]; my $aryiter = iter(['foo','bar','baz']); my $ioiter = iter(\*DATA); ok(($itr = ichain($ary, $aryiter, $ioiter)), 'ichain creation'); is_deeply list($itr) => [1,2,3,'foo','bar','baz',"dog\n", "cat\n", "cow\n"], 'ichain result' } #1-3 izip { my $ary1 = ['dog','cat','cow']; my $ary2 = ['inu','neko','ushi', 'what?']; ok(($itr = izip($ary1, $ary2)), 'izip creation'); is_deeply list($itr) => [['dog','inu'],['cat','neko'],['cow', 'ushi']], 'izip result' } #1-4 ienumrate { my $ary = ['foo', 'bar', 'baz']; ok(($itr = ienumerate($ary)), 'ienumerate creattion'); is_deeply list($itr) => [[0,'foo'],[1,'bar'],[2,'baz']], 'ienumerate result'; } __DATA__ dog cat cow Iterator-Simple-0.07/t/12_list.t0000755000175000017500000000266712437437260016201 0ustar michaelmichaeluse Test::More tests => 8; use strict; use warnings; use Iterator::Simple qw(list iterator); { my $now = 0; my $itr = iterator { return if $now > 5; return $now++; }; is_deeply list($itr), [0,1,2,3,4,5], 'list(iterator)'; } { my @ary = ('dogs', 'cats','cow'); is_deeply list(\@ary), ['dogs', 'cats', 'cow'], 'list(ARRAY REF)'; } { is_deeply list(\*DATA), ["foo\n", "bar\n", "baz\n"], 'list(GLOB)'; } { my $foo = Foo->new(); is_deeply list($foo), ['hoge', 'hage'], 'list(@{} overloaded)'; } { my $bar = Bar->new(); is_deeply list($bar) , [0,1,2,3], 'list(__iter__ implemented)'; } { my $baz = Baz->new(); is_deeply list($baz) , [0,1,2,3,4,5], 'list(<> overloaded)'; } { my $fiz = Fiz->new(); is_deeply list($fiz) , [0,1,2,3,4,5,6,7], 'list(next implemented)'; } { is_deeply list(), [], 'list()'; } { package Foo; sub new { bless {i => 0}, $_[0]; } use overload ( '@{}' => sub { [ 'hoge', 'hage'] }, ); } { package Bar; use Iterator::Simple qw(iterator); sub new { bless {i => 0}, $_[0]; } sub __iter__ { my($self) = @_; my $k = 0; iterator { return if $k > 3; return $k++; } } } { package Baz; sub new { bless {i => 0}, $_[0]; } use overload ( '<>' => sub { my($self) = @_; return if $self->{i} > 5; return $self->{i}++; } ); } { package Fiz; sub new { bless {i => 0}, $_[0]; } sub next { my($self) = @_; return if $self->{i} > 7; return $self->{i}++; } } __END__ foo bar baz Iterator-Simple-0.07/t/23_iflatten.t0000755000175000017500000000102212437437260017016 0ustar michaelmichaeluse Test::More tests => 4; use strict; use warnings; use Iterator::Simple qw(:all); my $itr; { my $aryiter = iter([ 'foo', 'bar', iter(['hoge','hage']), 1, 2]); $itr = iflatten $aryiter; ok is_iterator($itr), 'iflatten creation'; is_deeply list($itr) => ['foo', 'bar','hoge','hage',1,2], 'iflatten result'; } { my $ary = [ 'foo', 'bar', iter(['hoge','hage']), 1, 2]; $itr = iflatten $ary; ok is_iterator($itr), 'iterable source'; is_deeply list($itr) => ['foo', 'bar','hoge','hage',1,2], 'iterable source result'; } Iterator-Simple-0.07/t/11_iter.t0000755000175000017500000000355612437437260016166 0ustar michaelmichaeluse Test::More tests => 14; use strict; use warnings; use Iterator::Simple qw(:all); my $itr; #1-2 iarray($arrayref) { ok(($itr = iarray [10,2,3,'foo',5]), 'iarray creation'); my @res; while(<$itr>) { push @res, $_; } is_deeply \@res => [10,2,3,'foo',5], 'iarray result'; } #3-4 iter($arrayref) { ok(($itr = iter([10,'foo','bar','buz'])), 'arrayref iter creation'); is_deeply list($itr) => [10, 'foo', 'bar', 'buz'], 'arrayref iter result'; } #5-6 iter($iohandle) { use IO::Handle; ok(($itr = iter(\*DATA)), 'GLOB iter creation'); is_deeply list($itr) => ["foo\n", "bar\n", "10\n", "who\n"], 'GLOB iter result'; } #7-8 iter($__iter__implemented_object) { my $foo = Foo->new(1,2,'three',4,5); ok(($itr = iter($foo)), '__iter__ method iter creation'); is_deeply list($itr) => ['1_', '2_', 'three_', '4_', '5_'], '__iter__ method iter creation'; } #9-10 iter($<>overloaded_object) { my $bar = Bar->new('bow-wow', 'oink', 'quack'); ok(($itr = iter($bar)), '"<>" overload iter creation' ); is_deeply list($itr) => ['bow-wow', 'oink', 'quack'], '"<>" overload iter creation'; } #11-12 iter($code); { my @array = ('a','b','c'); my $foo = sub { shift @array; }; ok(($itr = iter($foo)), 'code ref iter creation'); is_deeply list($itr) => ['a', 'b', 'c'] , 'code ref iter result'; } #13-14 iter() { ok(($itr = eval{iter()}), 'empty iter creation'); is_deeply list($itr) => [], 'empty iter result'; } { package Foo; use Iterator::Simple qw(iterator); sub new { my $class = shift; bless [@_], $class; } sub __iter__ { my($self) = @_; my $idx =0; iterator { return unless exists $self->[$idx]; return $self->[$idx++] . '_'; } } } { package Bar; my $i = 0; use overload ( '<>' => sub { my $s = shift; $s->{events}[$s->{pointer}++] } ); sub new { my $class =shift; bless { events => [@_], pointer => 0 }, $class; } } __DATA__ foo bar 10 who Iterator-Simple-0.07/t/00_compile.t0000755000175000017500000000011412437437257016642 0ustar michaelmichaeluse strict; use Test::More tests => 1; BEGIN { use_ok 'Iterator::Simple' } Iterator-Simple-0.07/t/30_oo.t0000755000175000017500000000125512437437260015633 0ustar michaelmichaeluse Test::More tests => 3; use strict; use warnings; use Iterator::Simple qw(iter list); my $itr; { $itr = iter(['foo','bar'])->enumerate; $itr = iter([1,$itr ,3,4]); $itr = $itr->flatten(); $itr = $itr->chain(iter ['dog','cat']); is_deeply list($itr) => [1,[0,'foo'],[1,'bar'],3,4,'dog','cat'], 'misc filter method'; } { my $trans1 = sub { $_ ** 2 }; my $trans2 = sub { ":$_" }; $itr = iter([1,2,3,4,5]); $itr = $itr->filter($trans1)->filter($trans2); is_deeply list($itr) => [':1', ':4', ':9', ':16', ':25'], 'general filter'; $itr = iter([1,2,3,4,5]); $itr = $itr | $trans1 | $trans2; is_deeply list($itr) => [':1', ':4', ':9', ':16', ':25'], 'pipe overload'; } Iterator-Simple-0.07/t/21_mapgrep.t0000755000175000017500000000124212437437260016645 0ustar michaelmichaeluse Test::More tests=>7; use strict; use warnings; use Iterator::Simple qw(:all); my $itr; #1 ok($itr = iarray ['foo','bar','bazz','fizz'] ); #2-3 { $itr = iarray ['foo','bar','bazz','fizz']; ok(($itr = imap { $_ . '_' } $itr ), 'imap creation'); is_deeply(list($itr), [qw(foo_ bar_ bazz_ fizz_)], 'imap result'); } #4-5 { $itr = iarray ['foo','bar','bazz','fizz']; ok(($itr = igrep { /^b/ } $itr ), 'igrep creation'); is_deeply(list($itr), [qw(bar bazz)], 'igrep result'); } #6-7 { $itr = iarray ['foo','bar','bazz','fizz']; ok(($itr = igrep { /^_b/ } imap { '_' . $_ } $itr ), 'chain creation'); is_deeply(list($itr), [qw(_bar _bazz)], 'chain result'); } Iterator-Simple-0.07/lib/0000755000175000017500000000000013212262105015006 5ustar michaelmichaelIterator-Simple-0.07/lib/Iterator/0000755000175000017500000000000013212262105016577 5ustar michaelmichaelIterator-Simple-0.07/lib/Iterator/Simple.pm0000644000175000017500000004474513212261653020413 0ustar michaelmichaelpackage 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.07'; $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(defined($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__ =head1 NAME Iterator::Simple - Simple iterator and utilities =head1 SYNOPSIS use Iterator::Simple; sub foo { my $max = shift; my $i = 0; iterator { return if $i > $max; $i++; } } my $iterator = foo(20); # yields 0,1,2, ..., 19, 20; $iterator = imap { $_ + 2 } $iterator; # yields 2,3,4,5, ... ,20,21,22 $iterator = igrep { $_ % 2 } $iterator; # yields 3,5,7,9, ... ,17,19,21 # iterable object $iterator = iter([qw(foo bar baz)]); # iterator from array ref $iterator = iter(IO::File->new($filename)); # iterator from GLOB # filters $iterator = ichain($itr1, $itr2); # chain iterators; $iterator = izip($itr1, $itr2); # zip iterators; $iterator = ienumerate $iterator; # add index; # general filter $iterator = ifilter $iterator, sub { return $_ if /^A/; return; } # how to iterate while(defined($_ = $iterator->())) { print; } while(defined($_ = $iterator->next)) { print; } while() { print; } =head1 DESCRIPTION Iterator::Simple is yet another general-purpose iterator utilities. Rather simple, but powerful and fast iterator. =head1 FUNCTIONS Iterator::Simple doesn't export any functions by default. please import them like: use Iterator::Simple qw(iter list imap); For all functions: use Iterator::Simple qw(:all); =over 4 =item iterator { CODE } Iterator constructor. CODE returns a value on each call, and if it is exhausted, returns undef. Therefore, you cannot yields undefined value as a meaning value. If you want, you could use L module which can do that. Generally, you can implement iterator as a closure like: use Iterator::Simple qw(iterator); sub fibonacci { my($s1, $s2, $max) = @_; iterator { my $rv; ($rv, $s1, $s2) = ($s1, $s2, $s1 + $s2); return if $rv > $max; return $rv; } } my $iterator = fiboacci(1, 1, 1000); You can iterate it in several ways: =over 2 =item * just call it while(defined($_ = $iterator->())) { print "$_\n"; } =item * C method while(defined($_ = $iterator->next)) { print "$_\n"; } =item * <> operator while(<$iterator>) { print "$_\n"; } =back =item is_iterator($object) If C<$object> is an iterator created by Iterator::Simple, returns true. False otherwise. =item iter($object) This function auto detects what $object is, and automatically turns it into an iterator. Supported objects are: =over 2 =item * Iterator made with Iterator::Simple. =item * Object that implements C<__iter__> method. =item * Object that overloads '<>' or has C method. =item * Object that overloads '&{}'.(as iterator function.) =item * Object that overloads '@{}'.(with C) =item * ARRAY reference. (C) =item * CODE reference. (as iterator function.) =item * GLOB reference. =item * nothing (C.) (empty iterator.) =back If it fails to convert, runtime error. =item is_iterable($object) return true if C<$object> can be converted with C =item list($object) This function converts C<$object> into single array referece. =over 2 =item * ARRAY reference. =item * GLOB reference. =item * Iterator made with Iterator::Simple. =item * Object that overloads '@{}' operator. =item * Object that implements '__iter__' method. =item * Object that overloads '<>' operator or has C method. =item * nothing (i.e. list() returns []); =back If it fails to convert, runtime error. Note that after C, that iterator is not usable any more. =item imap { CODE } $iterable This is the iterator version of C. Returns an iterator which yields the value from source iterator modified by CODE. =item igrep { CODE } $iterable This is the iterator version of C. Returns an iterator which yields the value from source iterator only when CODE returns true value. =item iflatten $iterable When C<$iterable> yields another iterator, iterate it first. $subitr = iter([10, 11,12]); $source = iter([ 1, 2, $subitr, 4]); $flattened = iflatten $source; # yields 1, 2, 10, 11, 12, 4. =item ifilter $iterable, sub{ CODE } This is the combination of imap, igrep, iflatten. it supports modify (imap) , skip (igrep), and inflate (iflatten). but it should be faster than combination of them. For example: $combination = iflatten imap { $_ eq 'baz' ? iter(['whoa', 'who']) : ":$_:" } igrep { $_ ne 'bar' } iter [ 'foo', 'bar', 'baz', 'fiz' ]; $itr = iter [ 'foo', 'bar', 'baz', 'fiz' ]; $filterd = ifilter $itr, sub { return if $_ eq 'bar'; #skip return iter(['whoa', 'who']) if $_ eq 'baz'; #inflate return ":$_:"; # modify }; Both of them will yields C<':foo:', 'whoa', 'who', ':fiz:'>. =item ichain($iterable, $iterable2, ...) This function returns an iterator which chains one or more iterators. Iterates each iterables in order as is, until each iterables are exhausted. Example: $itr1 = iter(['foo', 'bar', 'baz']); $itr2 = iter(['hoge', 'hage']); $chained = ichain($itr1, $itr2); # yields 'foo', 'bar', 'baz', 'hoge', 'hage'. =item ienumerate($iterable) This function returns an iterator yields like: $ary = iter(['foo', 'bar', 'baz', ... ]); $iter = ienumerate $ary; # yields [0, 'foo'], [1, 'bar'], [2, 'baz'], ... =item izip($iterable, $iterable2, ...); Accepts one or more iterables, returns an iterator like: $animals = iter(['dogs', 'cats', 'pigs']); $says = iter(['bowwow', 'mew', 'oink']); $zipped = izip($animals, $says); # yields ['dogs','bowwow'], ['cats','mew'], ['pigs', 'oink']. Note that when one of source iterables is exhausted, zipped iterator will be exhausted also. =item islice($iterable, $start, $end, $step) Same as islice of itertools in Python. If C<$end> is undef or negative value, it iterates source until it is exhausted. C<$step> defaults to 1. 0 or negative step value is prohibited. $iter = iter([0,1,2,3,4,5,6,7,8,9,10,11,12]); $sliced = islice($iter, 3, 13, 2); # yields 3, 5, 7, 9, 11. =item ihead($count, $iterable) islice($iterable, 0, $count, 1); =item iskip($count, $iterable) islice($iterable, $count, undef, 1); =item iarray($arrayref); Turns array reference into an iterator. Used in C. You do not have to use this function directly, because C is sufficient. =back =head1 OO INTERFACE Iterator used in Iterator::Simple is just a code reference blessed in Iterator::Simple::Iterator. This class implements several method and overloads some operators. =over 4 =item Itrator::Simple::Iterator->new($coderef) Just bless $coderef in Iterator::Simple::Iterator and returns it. =item $iterator->next Call underlying code. =item $iterator->__iter__ Returns self. You don't need to use this. =item Overloaded operators. =over 2 =item * Read filehandle operator '<>' Overloading '<>' makes this possible like: print while <$iterator>; =item * Pipe.. bit_OR? .. No, pipe! $iterator | $coderef1 | $coderef2; is equivalent to: $iterator->filter($coderef1)->filter($coderef2); is equivalent to: ifilter(ifilter($iterator, $coderef1), $coderef2); =back =item $iterator->filter($coderef) =item $iterator->flatten() =item $iterator->chain($another, ..) =item $iterator->zip($another, ..) =item $iterator->enumerate() =item $iterator->slice($start, $end, $step) =item $iterator->head($count) =item $iterator->skip($count) For example, $iterator->flatten() is equivalent to C. =back =head1 TIPS All iterator transformation function calls C function on all source iterables. So you can pass just array reference, GLOB ref, etc. These examples completely do the right thing: imap { $_ + 2 } [1, 2, 3, ... ]; ienumerate(\*STDIN); # DBIx::Class::ResultSet has 'next' method. ifilter $dbic_resultset, sub {CODE}; You can implement C<__iter__> method on your objects in your application. By doing that, your object will be Iterator::Simple friendly :). Note that C<__iter__> method must return an iterator. =head1 Why Not Iterator.pm There is another iterator module in CPAN, named L and L made by Eric J. Roode that is great solution. Why yet another iterator module? The answer is *Speed*. You use iterator because you have too many data to manipulate in memory, therefore iterator could be called thousands of times, speed is important. For this simple example: use Iterator::Util qw(iarray imap igrep); for(1 .. 100) { my $itr = igrep { $_ % 2 } imap { $_ + 2 } iarray([1 .. 1000]); my @result; while($itr->isnt_exhausted) { push @result, $itr->value; } } meanwhile: use Iterator::Simple qw(iarray imap igrep); for(1 .. 100) { my $itr = igrep { $_ % 2 } imap { $_ + 2 } iarray([1 .. 1000]); my @result; while(defined($_ = $itr->())) { push @result, $_; } } Iterator::Simple is about ten times faster! That is natural because Iterator::Simple iterator is just a code reference, while Iterator.pm iterator is full featured class instance. But Iterator::Simple is sufficient for usual demands. One of most downside of Iterator::Simple is, you cannot yields undef value as a meaning value, because Iterator::Simple thinks it as a exhausted sign. If you need to do that, you have to yield something which represents undef value. Also, Iterator::Simple cannot determine iterator is exhausted until next iteration, while Iterator.pm has 'is(nt)_exhausted' method which is useful in some situation. =head1 AUTHOR Rintaro Ishizaki Erintaro@cpan.orgE =head1 LICENSE This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 SEE ALSO =over 2 =item * L - Feature rich another iterator class. =item * L - Utilities which uses L. Many of filter functions are from this module. =back =cut Iterator-Simple-0.07/MANIFEST0000755000175000017500000000071612437437257015424 0ustar michaelmichaelChanges inc/Module/Install.pm inc/Module/Install/Base.pm inc/Module/Install/Can.pm inc/Module/Install/Fetch.pm inc/Module/Install/Makefile.pm inc/Module/Install/Metadata.pm inc/Module/Install/Win32.pm inc/Module/Install/WriteAll.pm lib/Iterator/Simple.pm Makefile.PL MANIFEST This list of files META.yml README t/00_compile.t t/10_basic.t t/11_iter.t t/12_list.t t/21_mapgrep.t t/22_ifilter.t t/23_iflatten.t t/24_imisc.t t/25_islice.t t/30_oo.t t/40_defval.t Iterator-Simple-0.07/Makefile.PL0000755000175000017500000000022612437437257016241 0ustar michaelmichaeluse inc::Module::Install; name 'Iterator-Simple'; all_from 'lib/Iterator/Simple.pm'; build_requires 'Test::More'; requires 'Scalar::Util'; WriteAll; Iterator-Simple-0.07/Changes0000755000175000017500000000133513212261674015552 0ustar michaelmichaelRevision history for Perl extension Iterator::Simple 0.07 Thu Dec 7 2017 - Fix for rt bug #107612 submitted by KENO (islice stopped on false, not undef) 0.06 Wed Jan 23 2013 - Eliminated use of UNIVERSAL::isa, deprecated as of Perl 5.12. 0.05 Fri Apr 27 2008 - Fixed bad logic for determing callable object. Thanks to Hans Dieter Pearcey. 0.04 Wed Jul 25 2007 - In iarray(), Do not fix the length of array.(No performance hit) - Don't UNIVERSAL::can() as a function. - list() and iter() rewritten. - is_iterable() added. 0.03 Tue Jun 12 09:44:12 2007 - Documentation fix 0.02 Tue Jun 12 09:31:50 2007 - Several documentation fix 0.01 Wed Jun 6 11:03:41 2007 - original version Iterator-Simple-0.07/META.yml0000644000175000017500000000071113212257310015512 0ustar michaelmichael--- abstract: Simple iterator and utilities author: Rintaro Ishizaki build_requires: Test::More: 0 distribution_type: module generated_by: Module::Install version 0.67 license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.3.html version: 1.3 name: Iterator-Simple no_index: directory: - inc - t requires: Scalar::Util: 0 repository: https://github.com/Vivtek/Iterator-Simple version: 0.07 Iterator-Simple-0.07/README0000755000175000017500000000102312437437257015143 0ustar michaelmichaelThis is Perl module Iterator::Simple. INSTALLATION Iterator::Simple installation is straightforward. If your CPAN shell is set up, you should just be able to do % cpan Iterator::Simple Download it, unpack it, then build it as per the usual: % perl Makefile.PL % make && make test Then install it: % make install DOCUMENTATION Iterator::Simple documentation is available as in POD. So you can do: % perldoc Iterator::Simple to read the documentation online with your favorite pager. Rintaro Ishizaki Iterator-Simple-0.07/inc/0000755000175000017500000000000013212262105015011 5ustar michaelmichaelIterator-Simple-0.07/inc/Module/0000755000175000017500000000000013212262105016236 5ustar michaelmichaelIterator-Simple-0.07/inc/Module/Install/0000755000175000017500000000000013212262105017644 5ustar michaelmichaelIterator-Simple-0.07/inc/Module/Install/Metadata.pm0000755000175000017500000002152712437437257021760 0ustar michaelmichael#line 1 package Module::Install::Metadata; use strict 'vars'; use Module::Install::Base; use vars qw{$VERSION $ISCORE @ISA}; BEGIN { $VERSION = '0.67'; $ISCORE = 1; @ISA = qw{Module::Install::Base}; } my @scalar_keys = qw{ name module_name abstract author version license distribution_type perl_version tests installdirs }; my @tuple_keys = qw{ build_requires requires recommends bundles }; sub Meta { shift } sub Meta_ScalarKeys { @scalar_keys } sub Meta_TupleKeys { @tuple_keys } foreach my $key (@scalar_keys) { *$key = sub { my $self = shift; return $self->{values}{$key} if defined wantarray and !@_; $self->{values}{$key} = shift; return $self; }; } foreach my $key (@tuple_keys) { *$key = sub { my $self = shift; return $self->{values}{$key} unless @_; my @rv; while (@_) { my $module = shift or last; my $version = shift || 0; if ( $module eq 'perl' ) { $version =~ s{^(\d+)\.(\d+)\.(\d+)} {$1 + $2/1_000 + $3/1_000_000}e; $self->perl_version($version); next; } my $rv = [ $module, $version ]; push @rv, $rv; } push @{ $self->{values}{$key} }, @rv; @rv; }; } # configure_requires is currently a null-op sub configure_requires { 1 } # Aliases for build_requires that will have alternative # meanings in some future version of META.yml. sub test_requires { shift->build_requires(@_) } sub install_requires { shift->build_requires(@_) } # Aliases for installdirs options sub install_as_core { $_[0]->installdirs('perl') } sub install_as_cpan { $_[0]->installdirs('site') } sub install_as_site { $_[0]->installdirs('site') } sub install_as_vendor { $_[0]->installdirs('vendor') } sub sign { my $self = shift; return $self->{'values'}{'sign'} if defined wantarray and ! @_; $self->{'values'}{'sign'} = ( @_ ? $_[0] : 1 ); return $self; } sub dynamic_config { my $self = shift; unless ( @_ ) { warn "You MUST provide an explicit true/false value to dynamic_config, skipping\n"; return $self; } $self->{'values'}{'dynamic_config'} = $_[0] ? 1 : 0; return $self; } sub all_from { my ( $self, $file ) = @_; unless ( defined($file) ) { my $name = $self->name or die "all_from called with no args without setting name() first"; $file = join('/', 'lib', split(/-/, $name)) . '.pm'; $file =~ s{.*/}{} unless -e $file; die "all_from: cannot find $file from $name" unless -e $file; } $self->version_from($file) unless $self->version; $self->perl_version_from($file) unless $self->perl_version; # The remaining probes read from POD sections; if the file # has an accompanying .pod, use that instead my $pod = $file; if ( $pod =~ s/\.pm$/.pod/i and -e $pod ) { $file = $pod; } $self->author_from($file) unless $self->author; $self->license_from($file) unless $self->license; $self->abstract_from($file) unless $self->abstract; } sub provides { my $self = shift; my $provides = ( $self->{values}{provides} ||= {} ); %$provides = (%$provides, @_) if @_; return $provides; } sub auto_provides { my $self = shift; return $self unless $self->is_admin; unless (-e 'MANIFEST') { warn "Cannot deduce auto_provides without a MANIFEST, skipping\n"; return $self; } # Avoid spurious warnings as we are not checking manifest here. local $SIG{__WARN__} = sub {1}; require ExtUtils::Manifest; local *ExtUtils::Manifest::manicheck = sub { return }; require Module::Build; my $build = Module::Build->new( dist_name => $self->name, dist_version => $self->version, license => $self->license, ); $self->provides(%{ $build->find_dist_packages || {} }); } sub feature { my $self = shift; my $name = shift; my $features = ( $self->{values}{features} ||= [] ); my $mods; if ( @_ == 1 and ref( $_[0] ) ) { # The user used ->feature like ->features by passing in the second # argument as a reference. Accomodate for that. $mods = $_[0]; } else { $mods = \@_; } my $count = 0; push @$features, ( $name => [ map { ref($_) ? ( ref($_) eq 'HASH' ) ? %$_ : @$_ : $_ } @$mods ] ); return @$features; } sub features { my $self = shift; while ( my ( $name, $mods ) = splice( @_, 0, 2 ) ) { $self->feature( $name, @$mods ); } return $self->{values}->{features} ? @{ $self->{values}->{features} } : (); } sub no_index { my $self = shift; my $type = shift; push @{ $self->{values}{no_index}{$type} }, @_ if $type; return $self->{values}{no_index}; } sub read { my $self = shift; $self->include_deps( 'YAML', 0 ); require YAML; my $data = YAML::LoadFile('META.yml'); # Call methods explicitly in case user has already set some values. while ( my ( $key, $value ) = each %$data ) { next unless $self->can($key); if ( ref $value eq 'HASH' ) { while ( my ( $module, $version ) = each %$value ) { $self->can($key)->($self, $module => $version ); } } else { $self->can($key)->($self, $value); } } return $self; } sub write { my $self = shift; return $self unless $self->is_admin; $self->admin->write_meta; return $self; } sub version_from { my ( $self, $file ) = @_; require ExtUtils::MM_Unix; $self->version( ExtUtils::MM_Unix->parse_version($file) ); } sub abstract_from { my ( $self, $file ) = @_; require ExtUtils::MM_Unix; $self->abstract( bless( { DISTNAME => $self->name }, 'ExtUtils::MM_Unix' )->parse_abstract($file) ); } sub _slurp { my ( $self, $file ) = @_; local *FH; open FH, "< $file" or die "Cannot open $file.pod: $!"; do { local $/; }; } sub perl_version_from { my ( $self, $file ) = @_; if ( $self->_slurp($file) =~ m/ ^ use \s* v? ([\d_\.]+) \s* ; /ixms ) { my $v = $1; $v =~ s{_}{}g; $self->perl_version($1); } else { warn "Cannot determine perl version info from $file\n"; return; } } sub author_from { my ( $self, $file ) = @_; my $content = $self->_slurp($file); if ($content =~ m/ =head \d \s+ (?:authors?)\b \s* ([^\n]*) | =head \d \s+ (?:licen[cs]e|licensing|copyright|legal)\b \s* .*? copyright .*? \d\d\d[\d.]+ \s* (?:\bby\b)? \s* ([^\n]*) /ixms) { my $author = $1 || $2; $author =~ s{E}{<}g; $author =~ s{E}{>}g; $self->author($author); } else { warn "Cannot determine author info from $file\n"; } } sub license_from { my ( $self, $file ) = @_; if ( $self->_slurp($file) =~ m/ ( =head \d \s+ (?:licen[cs]e|licensing|copyright|legal)\b .*? ) (=head\\d.*|=cut.*|) \z /ixms ) { my $license_text = $1; my @phrases = ( 'under the same (?:terms|license) as perl itself' => 'perl', 1, 'GNU public license' => 'gpl', 1, 'GNU lesser public license' => 'gpl', 1, 'BSD license' => 'bsd', 1, 'Artistic license' => 'artistic', 1, 'GPL' => 'gpl', 1, 'LGPL' => 'lgpl', 1, 'BSD' => 'bsd', 1, 'Artistic' => 'artistic', 1, 'MIT' => 'mit', 1, 'proprietary' => 'proprietary', 0, ); while ( my ($pattern, $license, $osi) = splice(@phrases, 0, 3) ) { $pattern =~ s{\s+}{\\s+}g; if ( $license_text =~ /\b$pattern\b/i ) { if ( $osi and $license_text =~ /All rights reserved/i ) { warn "LEGAL WARNING: 'All rights reserved' may invalidate Open Source licenses. Consider removing it."; } $self->license($license); return 1; } } } warn "Cannot determine license info from $file\n"; return 'unknown'; } 1; Iterator-Simple-0.07/inc/Module/Install/WriteAll.pm0000755000175000017500000000162412437437257021757 0ustar michaelmichael#line 1 package Module::Install::WriteAll; use strict; use Module::Install::Base; use vars qw{$VERSION $ISCORE @ISA}; BEGIN { $VERSION = '0.67'; $ISCORE = 1; @ISA = qw{Module::Install::Base}; } sub WriteAll { my $self = shift; my %args = ( meta => 1, sign => 0, inline => 0, check_nmake => 1, @_ ); $self->sign(1) if $args{sign}; $self->Meta->write if $args{meta}; $self->admin->WriteAll(%args) if $self->is_admin; if ( $0 =~ /Build.PL$/i ) { $self->Build->write; } else { $self->check_nmake if $args{check_nmake}; unless ( $self->makemaker_args->{'PL_FILES'} ) { $self->makemaker_args( PL_FILES => {} ); } if ($args{inline}) { $self->Inline->write; } else { $self->Makefile->write; } } } 1; Iterator-Simple-0.07/inc/Module/Install/Makefile.pm0000755000175000017500000001351112437437257021747 0ustar michaelmichael#line 1 package Module::Install::Makefile; use strict 'vars'; use Module::Install::Base; use ExtUtils::MakeMaker (); use vars qw{$VERSION $ISCORE @ISA}; BEGIN { $VERSION = '0.67'; $ISCORE = 1; @ISA = qw{Module::Install::Base}; } sub Makefile { $_[0] } my %seen = (); sub prompt { shift; # Infinite loop protection my @c = caller(); if ( ++$seen{"$c[1]|$c[2]|$_[0]"} > 3 ) { die "Caught an potential prompt infinite loop ($c[1]|$c[2]|$_[0])"; } # In automated testing, always use defaults if ( $ENV{AUTOMATED_TESTING} and ! $ENV{PERL_MM_USE_DEFAULT} ) { local $ENV{PERL_MM_USE_DEFAULT} = 1; goto &ExtUtils::MakeMaker::prompt; } else { goto &ExtUtils::MakeMaker::prompt; } } sub makemaker_args { my $self = shift; my $args = ($self->{makemaker_args} ||= {}); %$args = ( %$args, @_ ) if @_; $args; } # For mm args that take multiple space-seperated args, # append an argument to the current list. sub makemaker_append { my $self = sShift; my $name = shift; my $args = $self->makemaker_args; $args->{name} = defined $args->{$name} ? join( ' ', $args->{name}, @_ ) : join( ' ', @_ ); } sub build_subdirs { my $self = shift; my $subdirs = $self->makemaker_args->{DIR} ||= []; for my $subdir (@_) { push @$subdirs, $subdir; } } sub clean_files { my $self = shift; my $clean = $self->makemaker_args->{clean} ||= {}; %$clean = ( %$clean, FILES => join(' ', grep length, $clean->{FILES}, @_), ); } sub realclean_files { my $self = shift; my $realclean = $self->makemaker_args->{realclean} ||= {}; %$realclean = ( %$realclean, FILES => join(' ', grep length, $realclean->{FILES}, @_), ); } sub libs { my $self = shift; my $libs = ref $_[0] ? shift : [ shift ]; $self->makemaker_args( LIBS => $libs ); } sub inc { my $self = shift; $self->makemaker_args( INC => shift ); } my %test_dir = (); sub _wanted_t { /\.t$/ and -f $_ and $test_dir{$File::Find::dir} = 1; } sub tests_recursive { my $self = shift; if ( $self->tests ) { die "tests_recursive will not work if tests are already defined"; } my $dir = shift || 't'; unless ( -d $dir ) { die "tests_recursive dir '$dir' does not exist"; } require File::Find; %test_dir = (); File::Find::find( \&_wanted_t, $dir ); $self->tests( join ' ', map { "$_/*.t" } sort keys %test_dir ); } sub write { my $self = shift; die "&Makefile->write() takes no arguments\n" if @_; my $args = $self->makemaker_args; $args->{DISTNAME} = $self->name; $args->{NAME} = $self->module_name || $self->name || $self->determine_NAME($args); $args->{VERSION} = $self->version || $self->determine_VERSION($args); $args->{NAME} =~ s/-/::/g; if ( $self->tests ) { $args->{test} = { TESTS => $self->tests }; } if ($] >= 5.005) { $args->{ABSTRACT} = $self->abstract; $args->{AUTHOR} = $self->author; } if ( eval($ExtUtils::MakeMaker::VERSION) >= 6.10 ) { $args->{NO_META} = 1; } if ( eval($ExtUtils::MakeMaker::VERSION) > 6.17 and $self->sign ) { $args->{SIGN} = 1; } unless ( $self->is_admin ) { delete $args->{SIGN}; } # merge both kinds of requires into prereq_pm my $prereq = ($args->{PREREQ_PM} ||= {}); %$prereq = ( %$prereq, map { @$_ } map { @$_ } grep $_, ($self->build_requires, $self->requires) ); # merge both kinds of requires into prereq_pm my $subdirs = ($args->{DIR} ||= []); if ($self->bundles) { foreach my $bundle (@{ $self->bundles }) { my ($file, $dir) = @$bundle; push @$subdirs, $dir if -d $dir; delete $prereq->{$file}; } } if ( my $perl_version = $self->perl_version ) { eval "use $perl_version; 1" or die "ERROR: perl: Version $] is installed, " . "but we need version >= $perl_version"; } $args->{INSTALLDIRS} = $self->installdirs; my %args = map { ( $_ => $args->{$_} ) } grep {defined($args->{$_})} keys %$args; my $user_preop = delete $args{dist}->{PREOP}; if (my $preop = $self->admin->preop($user_preop)) { $args{dist} = $preop; } my $mm = ExtUtils::MakeMaker::WriteMakefile(%args); $self->fix_up_makefile($mm->{FIRST_MAKEFILE} || 'Makefile'); } sub fix_up_makefile { my $self = shift; my $makefile_name = shift; my $top_class = ref($self->_top) || ''; my $top_version = $self->_top->VERSION || ''; my $preamble = $self->preamble ? "# Preamble by $top_class $top_version\n" . $self->preamble : ''; my $postamble = "# Postamble by $top_class $top_version\n" . ($self->postamble || ''); local *MAKEFILE; open MAKEFILE, "< $makefile_name" or die "fix_up_makefile: Couldn't open $makefile_name: $!"; my $makefile = do { local $/; }; close MAKEFILE or die $!; $makefile =~ s/\b(test_harness\(\$\(TEST_VERBOSE\), )/$1'inc', /; $makefile =~ s/( -I\$\(INST_ARCHLIB\))/ -Iinc$1/g; $makefile =~ s/( "-I\$\(INST_LIB\)")/ "-Iinc"$1/g; $makefile =~ s/^(FULLPERL = .*)/$1 "-Iinc"/m; $makefile =~ s/^(PERL = .*)/$1 "-Iinc"/m; # Module::Install will never be used to build the Core Perl # Sometimes PERL_LIB and PERL_ARCHLIB get written anyway, which breaks # PREFIX/PERL5LIB, and thus, install_share. Blank them if they exist $makefile =~ s/^PERL_LIB = .+/PERL_LIB =/m; #$makefile =~ s/^PERL_ARCHLIB = .+/PERL_ARCHLIB =/m; # Perl 5.005 mentions PERL_LIB explicitly, so we have to remove that as well. $makefile =~ s/("?)-I\$\(PERL_LIB\)\1//g; # XXX - This is currently unused; not sure if it breaks other MM-users # $makefile =~ s/^pm_to_blib\s+:\s+/pm_to_blib :: /mg; open MAKEFILE, "> $makefile_name" or die "fix_up_makefile: Couldn't open $makefile_name: $!"; print MAKEFILE "$preamble$makefile$postamble" or die $!; close MAKEFILE or die $!; 1; } sub preamble { my ($self, $text) = @_; $self->{preamble} = $text . $self->{preamble} if defined $text; $self->{preamble}; } sub postamble { my ($self, $text) = @_; $self->{postamble} ||= $self->admin->postamble; $self->{postamble} .= $text if defined $text; $self->{postamble} } 1; __END__ #line 363 Iterator-Simple-0.07/inc/Module/Install/Can.pm0000755000175000017500000000337412437437257020741 0ustar michaelmichael#line 1 package Module::Install::Can; use strict; use Module::Install::Base; use Config (); ### This adds a 5.005 Perl version dependency. ### This is a bug and will be fixed. use File::Spec (); use ExtUtils::MakeMaker (); use vars qw{$VERSION $ISCORE @ISA}; BEGIN { $VERSION = '0.67'; $ISCORE = 1; @ISA = qw{Module::Install::Base}; } # check if we can load some module ### Upgrade this to not have to load the module if possible sub can_use { my ($self, $mod, $ver) = @_; $mod =~ s{::|\\}{/}g; $mod .= '.pm' unless $mod =~ /\.pm$/i; my $pkg = $mod; $pkg =~ s{/}{::}g; $pkg =~ s{\.pm$}{}i; local $@; eval { require $mod; $pkg->VERSION($ver || 0); 1 }; } # check if we can run some command sub can_run { my ($self, $cmd) = @_; my $_cmd = $cmd; return $_cmd if (-x $_cmd or $_cmd = MM->maybe_command($_cmd)); for my $dir ((split /$Config::Config{path_sep}/, $ENV{PATH}), '.') { my $abs = File::Spec->catfile($dir, $_[1]); return $abs if (-x $abs or $abs = MM->maybe_command($abs)); } return; } # can we locate a (the) C compiler sub can_cc { my $self = shift; my @chunks = split(/ /, $Config::Config{cc}) or return; # $Config{cc} may contain args; try to find out the program part while (@chunks) { return $self->can_run("@chunks") || (pop(@chunks), next); } return; } # Fix Cygwin bug on maybe_command(); if ( $^O eq 'cygwin' ) { require ExtUtils::MM_Cygwin; require ExtUtils::MM_Win32; if ( ! defined(&ExtUtils::MM_Cygwin::maybe_command) ) { *ExtUtils::MM_Cygwin::maybe_command = sub { my ($self, $file) = @_; if ($file =~ m{^/cygdrive/}i and ExtUtils::MM_Win32->can('maybe_command')) { ExtUtils::MM_Win32->maybe_command($file); } else { ExtUtils::MM_Unix->maybe_command($file); } } } } 1; __END__ #line 157 Iterator-Simple-0.07/inc/Module/Install/Fetch.pm0000755000175000017500000000463012437437257021265 0ustar michaelmichael#line 1 package Module::Install::Fetch; use strict; use Module::Install::Base; use vars qw{$VERSION $ISCORE @ISA}; BEGIN { $VERSION = '0.67'; $ISCORE = 1; @ISA = qw{Module::Install::Base}; } sub get_file { my ($self, %args) = @_; my ($scheme, $host, $path, $file) = $args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return; if ( $scheme eq 'http' and ! eval { require LWP::Simple; 1 } ) { $args{url} = $args{ftp_url} or (warn("LWP support unavailable!\n"), return); ($scheme, $host, $path, $file) = $args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return; } $|++; print "Fetching '$file' from $host... "; unless (eval { require Socket; Socket::inet_aton($host) }) { warn "'$host' resolve failed!\n"; return; } return unless $scheme eq 'ftp' or $scheme eq 'http'; require Cwd; my $dir = Cwd::getcwd(); chdir $args{local_dir} or return if exists $args{local_dir}; if (eval { require LWP::Simple; 1 }) { LWP::Simple::mirror($args{url}, $file); } elsif (eval { require Net::FTP; 1 }) { eval { # use Net::FTP to get past firewall my $ftp = Net::FTP->new($host, Passive => 1, Timeout => 600); $ftp->login("anonymous", 'anonymous@example.com'); $ftp->cwd($path); $ftp->binary; $ftp->get($file) or (warn("$!\n"), return); $ftp->quit; } } elsif (my $ftp = $self->can_run('ftp')) { eval { # no Net::FTP, fallback to ftp.exe require FileHandle; my $fh = FileHandle->new; local $SIG{CHLD} = 'IGNORE'; unless ($fh->open("|$ftp -n")) { warn "Couldn't open ftp: $!\n"; chdir $dir; return; } my @dialog = split(/\n/, <<"END_FTP"); open $host user anonymous anonymous\@example.com cd $path binary get $file $file quit END_FTP foreach (@dialog) { $fh->print("$_\n") } $fh->close; } } else { warn "No working 'ftp' program available!\n"; chdir $dir; return; } unless (-f $file) { warn "Fetching failed: $@\n"; chdir $dir; return; } return if exists $args{size} and -s $file != $args{size}; system($args{run}) if exists $args{run}; unlink($file) if $args{remove}; print(((!exists $args{check_for} or -e $args{check_for}) ? "done!" : "failed! ($!)"), "\n"); chdir $dir; return !$?; } 1; Iterator-Simple-0.07/inc/Module/Install/Win32.pm0000755000175000017500000000341612437437257021137 0ustar michaelmichael#line 1 package Module::Install::Win32; use strict; use Module::Install::Base; use vars qw{$VERSION $ISCORE @ISA}; BEGIN { $VERSION = '0.67'; $ISCORE = 1; @ISA = qw{Module::Install::Base}; } # determine if the user needs nmake, and download it if needed sub check_nmake { my $self = shift; $self->load('can_run'); $self->load('get_file'); require Config; return unless ( $^O eq 'MSWin32' and $Config::Config{make} and $Config::Config{make} =~ /^nmake\b/i and ! $self->can_run('nmake') ); print "The required 'nmake' executable not found, fetching it...\n"; require File::Basename; my $rv = $self->get_file( url => 'http://download.microsoft.com/download/vc15/Patch/1.52/W95/EN-US/Nmake15.exe', ftp_url => 'ftp://ftp.microsoft.com/Softlib/MSLFILES/Nmake15.exe', local_dir => File::Basename::dirname($^X), size => 51928, run => 'Nmake15.exe /o > nul', check_for => 'Nmake.exe', remove => 1, ); if (!$rv) { die <<'END_MESSAGE'; ------------------------------------------------------------------------------- Since you are using Microsoft Windows, you will need the 'nmake' utility before installation. It's available at: http://download.microsoft.com/download/vc15/Patch/1.52/W95/EN-US/Nmake15.exe or ftp://ftp.microsoft.com/Softlib/MSLFILES/Nmake15.exe Please download the file manually, save it to a directory in %PATH% (e.g. C:\WINDOWS\COMMAND\), then launch the MS-DOS command line shell, "cd" to that directory, and run "Nmake15.exe" from there; that will create the 'nmake.exe' file needed by this module. You may then resume the installation process described in README. ------------------------------------------------------------------------------- END_MESSAGE } } 1; Iterator-Simple-0.07/inc/Module/Install/Base.pm0000755000175000017500000000203512437437257021103 0ustar michaelmichael#line 1 package Module::Install::Base; $VERSION = '0.67'; # Suspend handler for "redefined" warnings BEGIN { my $w = $SIG{__WARN__}; $SIG{__WARN__} = sub { $w }; } ### This is the ONLY module that shouldn't have strict on # use strict; #line 41 sub new { my ($class, %args) = @_; foreach my $method ( qw(call load) ) { *{"$class\::$method"} = sub { shift()->_top->$method(@_); } unless defined &{"$class\::$method"}; } bless( \%args, $class ); } #line 61 sub AUTOLOAD { my $self = shift; local $@; my $autoload = eval { $self->_top->autoload } or return; goto &$autoload; } #line 76 sub _top { $_[0]->{_top} } #line 89 sub admin { $_[0]->_top->{admin} or Module::Install::Base::FakeAdmin->new; } sub is_admin { $_[0]->admin->VERSION; } sub DESTROY {} package Module::Install::Base::FakeAdmin; my $Fake; sub new { $Fake ||= bless(\@_, $_[0]) } sub AUTOLOAD {} sub DESTROY {} # Restore warning handler BEGIN { $SIG{__WARN__} = $SIG{__WARN__}->(); } 1; #line 138 Iterator-Simple-0.07/inc/Module/Install.pm0000755000175000017500000001761112437437257020237 0ustar michaelmichael#line 1 package Module::Install; # For any maintainers: # The load order for Module::Install is a bit magic. # It goes something like this... # # IF ( host has Module::Install installed, creating author mode ) { # 1. Makefile.PL calls "use inc::Module::Install" # 2. $INC{inc/Module/Install.pm} set to installed version of inc::Module::Install # 3. The installed version of inc::Module::Install loads # 4. inc::Module::Install calls "require Module::Install" # 5. The ./inc/ version of Module::Install loads # } ELSE { # 1. Makefile.PL calls "use inc::Module::Install" # 2. $INC{inc/Module/Install.pm} set to ./inc/ version of Module::Install # 3. The ./inc/ version of Module::Install loads # } use 5.004; use strict 'vars'; use vars qw{$VERSION}; BEGIN { # All Module::Install core packages now require synchronised versions. # This will be used to ensure we don't accidentally load old or # different versions of modules. # This is not enforced yet, but will be some time in the next few # releases once we can make sure it won't clash with custom # Module::Install extensions. $VERSION = '0.67'; } # Whether or not inc::Module::Install is actually loaded, the # $INC{inc/Module/Install.pm} is what will still get set as long as # the caller loaded module this in the documented manner. # If not set, the caller may NOT have loaded the bundled version, and thus # they may not have a MI version that works with the Makefile.PL. This would # result in false errors or unexpected behaviour. And we don't want that. my $file = join( '/', 'inc', split /::/, __PACKAGE__ ) . '.pm'; unless ( $INC{$file} ) { die <<"END_DIE"; Please invoke ${\__PACKAGE__} with: use inc::${\__PACKAGE__}; not: use ${\__PACKAGE__}; END_DIE } # If the script that is loading Module::Install is from the future, # then make will detect this and cause it to re-run over and over # again. This is bad. Rather than taking action to touch it (which # is unreliable on some platforms and requires write permissions) # for now we should catch this and refuse to run. if ( -f $0 and (stat($0))[9] > time ) { die << "END_DIE"; Your installer $0 has a modification time in the future. This is known to create infinite loops in make. Please correct this, then run $0 again. END_DIE } use Cwd (); use File::Find (); use File::Path (); use FindBin; *inc::Module::Install::VERSION = *VERSION; @inc::Module::Install::ISA = __PACKAGE__; sub autoload { my $self = shift; my $who = $self->_caller; my $cwd = Cwd::cwd(); my $sym = "${who}::AUTOLOAD"; $sym->{$cwd} = sub { my $pwd = Cwd::cwd(); if ( my $code = $sym->{$pwd} ) { # delegate back to parent dirs goto &$code unless $cwd eq $pwd; } $$sym =~ /([^:]+)$/ or die "Cannot autoload $who - $sym"; unshift @_, ($self, $1); goto &{$self->can('call')} unless uc($1) eq $1; }; } sub import { my $class = shift; my $self = $class->new(@_); my $who = $self->_caller; unless ( -f $self->{file} ) { require "$self->{path}/$self->{dispatch}.pm"; File::Path::mkpath("$self->{prefix}/$self->{author}"); $self->{admin} = "$self->{name}::$self->{dispatch}"->new( _top => $self ); $self->{admin}->init; @_ = ($class, _self => $self); goto &{"$self->{name}::import"}; } *{"${who}::AUTOLOAD"} = $self->autoload; $self->preload; # Unregister loader and worker packages so subdirs can use them again delete $INC{"$self->{file}"}; delete $INC{"$self->{path}.pm"}; } sub preload { my ($self) = @_; unless ( $self->{extensions} ) { $self->load_extensions( "$self->{prefix}/$self->{path}", $self ); } my @exts = @{$self->{extensions}}; unless ( @exts ) { my $admin = $self->{admin}; @exts = $admin->load_all_extensions; } my %seen; foreach my $obj ( @exts ) { while (my ($method, $glob) = each %{ref($obj) . '::'}) { next unless $obj->can($method); next if $method =~ /^_/; next if $method eq uc($method); $seen{$method}++; } } my $who = $self->_caller; foreach my $name ( sort keys %seen ) { *{"${who}::$name"} = sub { ${"${who}::AUTOLOAD"} = "${who}::$name"; goto &{"${who}::AUTOLOAD"}; }; } } sub new { my ($class, %args) = @_; # ignore the prefix on extension modules built from top level. my $base_path = Cwd::abs_path($FindBin::Bin); unless ( Cwd::abs_path(Cwd::cwd()) eq $base_path ) { delete $args{prefix}; } return $args{_self} if $args{_self}; $args{dispatch} ||= 'Admin'; $args{prefix} ||= 'inc'; $args{author} ||= ($^O eq 'VMS' ? '_author' : '.author'); $args{bundle} ||= 'inc/BUNDLES'; $args{base} ||= $base_path; $class =~ s/^\Q$args{prefix}\E:://; $args{name} ||= $class; $args{version} ||= $class->VERSION; unless ( $args{path} ) { $args{path} = $args{name}; $args{path} =~ s!::!/!g; } $args{file} ||= "$args{base}/$args{prefix}/$args{path}.pm"; bless( \%args, $class ); } sub call { my ($self, $method) = @_; my $obj = $self->load($method) or return; splice(@_, 0, 2, $obj); goto &{$obj->can($method)}; } sub load { my ($self, $method) = @_; $self->load_extensions( "$self->{prefix}/$self->{path}", $self ) unless $self->{extensions}; foreach my $obj (@{$self->{extensions}}) { return $obj if $obj->can($method); } my $admin = $self->{admin} or die <<"END_DIE"; The '$method' method does not exist in the '$self->{prefix}' path! Please remove the '$self->{prefix}' directory and run $0 again to load it. END_DIE my $obj = $admin->load($method, 1); push @{$self->{extensions}}, $obj; $obj; } sub load_extensions { my ($self, $path, $top) = @_; unless ( grep { lc $_ eq lc $self->{prefix} } @INC ) { unshift @INC, $self->{prefix}; } foreach my $rv ( $self->find_extensions($path) ) { my ($file, $pkg) = @{$rv}; next if $self->{pathnames}{$pkg}; local $@; my $new = eval { require $file; $pkg->can('new') }; unless ( $new ) { warn $@ if $@; next; } $self->{pathnames}{$pkg} = delete $INC{$file}; push @{$self->{extensions}}, &{$new}($pkg, _top => $top ); } $self->{extensions} ||= []; } sub find_extensions { my ($self, $path) = @_; my @found; File::Find::find( sub { my $file = $File::Find::name; return unless $file =~ m!^\Q$path\E/(.+)\.pm\Z!is; my $subpath = $1; return if lc($subpath) eq lc($self->{dispatch}); $file = "$self->{path}/$subpath.pm"; my $pkg = "$self->{name}::$subpath"; $pkg =~ s!/!::!g; # If we have a mixed-case package name, assume case has been preserved # correctly. Otherwise, root through the file to locate the case-preserved # version of the package name. if ( $subpath eq lc($subpath) || $subpath eq uc($subpath) ) { open PKGFILE, "<$subpath.pm" or die "find_extensions: Can't open $subpath.pm: $!"; my $in_pod = 0; while ( ) { $in_pod = 1 if /^=\w/; $in_pod = 0 if /^=cut/; next if ($in_pod || /^=cut/); # skip pod text next if /^\s*#/; # and comments if ( m/^\s*package\s+($pkg)\s*;/i ) { $pkg = $1; last; } } close PKGFILE; } push @found, [ $file, $pkg ]; }, $path ) if -d $path; @found; } sub _caller { my $depth = 0; my $call = caller($depth); while ( $call eq __PACKAGE__ ) { $depth++; $call = caller($depth); } return $call; } 1;