File Coverage

blib/lib/Permute/Named/Iter.pm

Criterion	Covered	Total	%
statement	49	53	92.4
branch	15	20	75.0
condition			n/a
subroutine	6	6	100.0
pod	1	1	100.0
total	71	80	88.7

package Permute::Named::Iter;

our $DATE = '2015-10-01'; # DATE
our $VERSION = '0.02'; # VERSION

use 5.010001;
use strict;
use warnings;

use Exporter qw(import);
our @EXPORT_OK = qw(
                    permute_named_iter
            );

sub permute_named_iter {
    die "Please supply a non-empty list of key-specification pairs" unless @_;
    die "Please supply an even-sized list" unless @_ % 2 == 0;

    my @keys;
    my @values;
    while (my ($key, $values) = splice @_, 0, 2) {
        push @keys, $key;
        $values = [$values] unless ref($values) eq 'ARRAY';
        die "$key cannot contain empty values" unless @$values;
        push @values, $values;
    }

    my $state = [(0) x @keys];
    my $state2 = 0; # 0,1,2
    my $iter = sub {
        if (!$state2) { # starting the first time, don't increment state yet
            $state2 = 1;
            goto L2;
        } elsif ($state2 == 2) { # all permutation exhausted
            return undef;
        }
        my $i = $#{$state};
      L1:
        while ($i >= 0) {
            if ($state->[$i] >= $#{$values[$i]}) {
                if ($i == 0) {
                    $state2 = 2;
                    return undef;
                }
                $state->[$i] = 0;
                my $j = $i-1;
                while ($j >= 0) {
                    if ($state->[$j] >= $#{$values[$j]}) {
                        if ($j == 0) { # all permutation exhausted
                            $state2 = 2;
                            return undef;
                        }
                        $state->[$j] = 0;
                        $j--;
                    } else {
                        $state->[$j]++;
                        last L1;
                    }
                }
                $i--;
            } else {
                $state->[$i]++;
                last;
            }
        }
      L2:
        return { map { ($keys[$_] => $values[$_][ $state->[$_] ]) }
                     0..$#{$state} };
    };
    $iter;
}

1;
# ABSTRACT: Permute multiple-valued key-value pairs

__END__