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


line stmt bran cond sub pod time code
1             package Permute::Named::Iter;
2              
3             our $DATE = '2016-09-25'; # DATE
4             our $VERSION = '0.03'; # VERSION
5              
6 1     1   424 use 5.010001;
  1         2  
7 1     1   3 use strict;
  1         0  
  1         14  
8 1     1   2 use warnings;
  1         2  
  1         17  
9              
10 1     1   3 use Exporter qw(import);
  1         1  
  1         271  
11             our @EXPORT_OK = qw(
12             permute_named_iter
13             );
14              
15             sub permute_named_iter {
16 3 50   3 1 1505 die "Please supply a non-empty list of key-specification pairs" unless @_;
17 3 50       8 die "Please supply an even-sized list" unless @_ % 2 == 0;
18              
19 3         3 my @keys;
20             my @values;
21 3         11 while (my ($key, $values) = splice @_, 0, 2) {
22 5         6 push @keys, $key;
23 5 100       12 $values = [$values] unless ref($values) eq 'ARRAY';
24 5 50       6 die "$key cannot contain empty values" unless @$values;
25 5         12 push @values, $values;
26             }
27              
28 3         6 my $state = [(0) x @keys];
29 3         3 my $state2 = 0; # 0,1,2
30             my $iter = sub {
31 13 100   13   43 if (!$state2) { # starting the first time, don't increment state yet
    50          
32 3         3 $state2 = 1;
33 3         8 goto L2;
34             } elsif ($state2 == 2) { # all permutation exhausted
35 0         0 return undef;
36             }
37 10         8 my $i = $#{$state};
  10         8  
38             L1:
39 10         15 while ($i >= 0) {
40 10 100       5 if ($state->[$i] >= $#{$values[$i]}) {
  10         15  
41 4 100       6 if ($i == 0) {
42 1         1 $state2 = 2;
43 1         2 return undef;
44             }
45 3         3 $state->[$i] = 0;
46 3         2 my $j = $i-1;
47 3         6 while ($j >= 0) {
48 3 100       3 if ($state->[$j] >= $#{$values[$j]}) {
  3         4  
49 2 50       3 if ($j == 0) { # all permutation exhausted
50 2         4 $state2 = 2;
51 2         2 return undef;
52             }
53 0         0 $state->[$j] = 0;
54 0         0 $j--;
55             } else {
56 1         1 $state->[$j]++;
57 1         2 last L1;
58             }
59             }
60 0         0 $i--;
61             } else {
62 6         5 $state->[$i]++;
63 6         6 last;
64             }
65             }
66             L2:
67 17         28 return { map { ($keys[$_] => $values[$_][ $state->[$_] ]) }
68 10         7 0..$#{$state} };
  10         12  
69 3         11 };
70 3         5 $iter;
71             }
72              
73             1;
74             # ABSTRACT: Permute multiple-valued key-value pairs
75              
76             __END__