File Coverage

blib/lib/Algorithm/Odometer/Gray.pm

Criterion	Covered	Total	%
statement	49	49	100.0
branch	16	16	100.0
condition	3	3	100.0
subroutine	8	8	100.0
pod	0	2	0.0
total	76	78	97.4

#!perl
use warnings;
use strict;

# SEE THE END OF THIS FILE FOR AUTHOR, COPYRIGHT AND LICENSE INFORMATION

{ package Algorithm::Odometer::Gray;
	our $VERSION = "0.04";
	use Carp;
	use overload '<>' => sub {
		my $self = shift;
		return $self->() unless wantarray;
		my @all;
		while (defined( my $x = $self->() ))
			{ push @all, $x }
		return @all;
	};
	sub new {  ## no critic (RequireArgUnpacking)
		my $class = shift;
		return bless odometer_gray(@_), $class;
	}
	sub odometer_gray {  ## no critic (RequireArgUnpacking)
		croak "no wheels specified" unless @_;
		my @w = @_;
		croak "all wheels must have at least two positions"
			if grep {@$_<2} @w;
		my @c = (0) x @w;
		my @f =  0 .. @w;
		my @o = (1) x @w;
		my $done;
		return sub {
			if ($done) { @c = (0) x @w; @f =  0 .. @w; @o = (1) x @w; $done=0; return }
			my @cur = map {$w[$_][$c[$_]]} 0..$#w;
			if ($f[0]==@w) { $done=1 }
			else {
				my $j = $f[0]; $f[0] = 0;
				$c[$j] += $o[$j];
				if ( $c[$j]==0 || $c[$j]==$#{$w[$j]} ) {
					$o[$j] = -$o[$j];
					$f[$j] = $f[$j+1];
					$f[$j+1] = $j+1;
				}
			}
			return wantarray ? @cur : join '', map {defined()?$_:''} @cur;
		};
	}
}

1;
__END__