File Coverage

blib/lib/Set/Product/PP.pm

Criterion	Covered	Total	%
statement	34	34	100.0
branch	7	8	87.5
condition	6	7	85.7
subroutine	6	6	100.0
pod	1	1	100.0
total	54	56	96.4

package Set::Product::PP;

use strict;
use warnings;

use Carp qw(croak);
use Exporter qw(import);
use Scalar::Util qw(reftype);

our @EXPORT_OK = qw(product);

sub product (&@) {
    my ($sub, @in) = @_;

    croak 'Not a subroutine reference'
        unless 'CODE' eq (reftype($sub) || '');
    croak 'Not an array reference'
        if grep { 'ARRAY' ne (reftype($_) || '') } @in;
    return if ! @in or grep { ! @$_ } @in;

    my @out = map { $in[$_]->[0] } 0 .. $#in;
    my @idx = (0) x @in;

    for (my $i = 0; $i >= 0; ) {
        $sub->(@out);
        for ($i=$#in; $i >= 0; $i--) {
            $idx[$i]++;
            if ($idx[$i] > $#{$in[$i]}) {
                $idx[$i] = 0;
                $out[$i] = $in[$i]->[0];
            }
            else {
                $out[$i] = $in[$i]->[$idx[$i]];
                last;
            }
        }
    }
}


1;

__END__