File Coverage

blib/lib/Algorithm/Odometer/Gray.pm
Criterion Covered Total %
statement 48 48 100.0
branch 16 16 100.0
condition 3 3 100.0
subroutine 7 7 100.0
pod 0 1 0.0
total 74 75 98.6


line stmt bran cond sub pod time code
1             #!perl
2 1     1   807 use warnings;
  1         2  
  1         26  
3 1     1   5 use strict;
  1         2  
  1         35  
4              
5             # SEE THE END OF THIS FILE FOR AUTHOR, COPYRIGHT AND LICENSE INFORMATION
6              
7             { package Algorithm::Odometer::Gray;
8             our $VERSION = "0.02";
9 1     1   4 use Carp;
  1         3  
  1         98  
10             use overload '<>' => sub {
11 24     24   8645 my $self = shift;
12 24 100       43 return $self->() unless wantarray;
13 1         2 my @all;
14 1         3 while (defined( my $x = $self->() ))
15 6         12 { push @all, $x }
16 1         8 return @all;
17 1     1   7 };
  1         1  
  1         7  
18             sub new { ## no critic (RequireArgUnpacking)
19 6     6 0 3517 my $class = shift;
20 6 100       86 croak "no wheels specified" unless @_;
21 5         12 my @w = @_;
22             croak "all wheels must have at least two positions"
23 5 100       7 if grep {@$_<2} @w;
  11         194  
24 3         8 my @c = (0) x @w;
25 3         7 my @f = 0 .. @w;
26 3         7 my @o = (1) x @w;
27 3         3 my $done;
28             return bless sub {
29 33 100   33   1074 if ($done) { @c = (0) x @w; @f = 0 .. @w; @o = (1) x @w; $done=0; return }
  3         6  
  3         5  
  3         4  
  3         6  
  3         6  
30 30         57 my @cur = map {$w[$_][$c[$_]]} 0..$#w;
  78         117  
31 30 100       52 if ($f[0]==@w) { $done=1 }
  3         5  
32             else {
33 27         29 my $j = $f[0]; $f[0] = 0;
  27         33  
34 27         31 $c[$j] += $o[$j];
35 27 100 100     52 if ( $c[$j]==0 || $c[$j]==$#{$w[$j]} ) {
  20         49  
36 18         22 $o[$j] = -$o[$j];
37 18         23 $f[$j] = $f[$j+1];
38 18         24 $f[$j+1] = $j+1;
39             }
40             }
41 30 100       52 return wantarray ? @cur : join '', map {defined()?$_:''} @cur;
  75 100       159  
42 3         17 }, $class;
43             }
44             }
45              
46             1;
47             __END__