#
# Algorithm/Iters.pm
#

use strict;
use warnings;


use Algorithm::Loops ();
use Exporter         ();


package Algorithm::Iters;


BEGIN {
   our $VERSION = '1.2.0';

   our @EXPORT_OK = qw( NestedIters );
   *import = \&Exporter::import;
}


# Import helpers:
*_Croak = \&Algorithm::Loops::_Croak;
*_Type  = \&Algorithm::Loops::_Type;
*isa    = \&UNIVERSAL::isa;


sub _NI_Args
{
    my $loops= shift(@_);
    isa( $loops, "ARRAY" )  or  _Croak(
        "First argument must be an array reference,",
        " not ", _Type($loops) );

    my $n= 1;
    for my $loop (  @$loops  ) {
        if(  ! isa( $loop, "ARRAY" )
         &&  ! isa( $loop, "CODE" )  ) {
            _Croak( "Invalid type for loop $n specification (",
                _Type($loop), ")" );
        }
        $n++;
    }

    my( $opts )= @_;
    if(  isa( $opts, "HASH" )  ) {
        shift @_;
    } else {
        $opts= {};
    }

    my $code;
    if(  0 == @_  ) {
        $code= 0;
    } elsif(  1 != @_  ) {
        _Croak( "Too many arguments" );
    } else {
        $code= pop @_;
        isa($code,"CODE")  or  _Croak(
            "Expected CODE reference not ", _Type($code) );
    }

    my $when= delete($opts->{OnlyWhen})
        ||  sub { @_ == @$loops };

    if(  keys %$opts  ) {
        _Croak( "Unrecognized option(s): ",
            join ' ', keys %$opts );
    }

    return( $loops, $code, $when );
}


sub _NI_Iter
{
    my( $loops, $code, $when )= @_;

    return  sub { return }
        if  ! @$loops;

    my @loops;
    my @iters;
    my @list;
    my $i= -1;

    foreach (@$loops) {
        if(  isa( $_, 'CODE' )  ) {
            push(@loops, $_);
        } else {
            my @arr = @$_;
            push(@loops, sub { [ @arr ] });
        }
    }

    return  sub {
        while( 1 ) {
            # Prepare to append one more value:
            if(  $i < $#loops  ) {
                ++$i;
                local( $_ )= $list[-1];
                $iters[$i]= $loops[$i]->(@list);

                if(  isa( $iters[$i], 'ARRAY' )  ) {
                    my @arr = @{$iters[$i]};
                    $iters[$i] = sub { pop @arr };
                }
            }

            # Increment furthest value, chopping if done there:
            my $val;
            while( 1 ) {
                $val = $iters[$i]->();
                last     if  defined $val;
                pop @list;
                return   if  --$i < 0;
            }

            $list[$i]= $val;

            my $act;
            $act= !ref($when) ? $when : do {
                local( $_ )= $list[-1];
                $when->(@list);
            };
            return @list   if  $act;
        }
    };

}


sub NestedIters
{
    my( $loops, $code, $when )= _NI_Args( @_ );

    my $iter= _NI_Iter( $loops, $code, $when );

    if(  ! $code  ) {
        if(  ! defined wantarray  ) {
            _Croak( "Useless in void context",
                " when no code given" );
        }
        return $iter;
    }

    my @ret;
    my @list;
    while(  @list = $iter->()   ) {
        @list= $code->( @list );
        if(  wantarray  ) {
            push @ret, @list;
        } else {
            $ret[0] += @list;
        }
    }
    return wantarray ? @ret : ( $ret[0] || 0 );
}


1;
[download]

#!/usr/bin/perl

#
# example.pl
#

use strict;
use warnings;


use Algorithm::Iters qw( NestedIters );


sub returns_an_iter1 {
   my $i = 0;
   sub { $i == 3 ? undef : ++$i }
}

sub returns_an_iter2 {
   my @data = ('y', 'n');
   sub { pop @data }
}

sub returns_an_iter3 {
   my $i = 0;
   sub { $i == 4 ? undef : ++$i * 7 }
}

sub print_values {
   local $, = ", ";
   local $\ = "\n";
   print @_;
}

NestedIters(
   [
      \&returns_an_iter1,
      \&returns_an_iter2,
      \&returns_an_iter3,
   ],
   \&print_values
);

# Also works
# ==========
# 
# print("\n");
# 
# NestedIters(
#    [
#       \&returns_an_iter1,
#       sub { [ 'y', 'n' ] },
#       \&returns_an_iter3,
#    ],
#    \&print_values
# );
# 
# print("\n");
# 
# NestedIters(
#    [
#       \&returns_an_iter1,
#       [ 'y', 'n' ],
#       \&returns_an_iter3,
#    ],
#    \&print_values
# );
[download]

1, y, 7
1, y, 14
1, y, 21
1, y, 28
1, n, 7
1, n, 14
1, n, 21
1, n, 28
2, y, 7
2, y, 14
2, y, 21
2, y, 28
2, n, 7
2, n, 14
2, n, 21
2, n, 28
3, y, 7
3, y, 14
3, y, 21
3, y, 28
3, n, 7
3, n, 14
3, n, 21
3, n, 28
[download]