File Coverage

blib/lib/Math/BaseArith.pm

Criterion	Covered	Total	%
statement	57	57	100.0
branch	17	26	65.3
condition	5	6	83.3
subroutine	7	7	100.0
pod	0	2	0.0
total	86	98	87.7

package Math::BaseArith;

use 5.006;
use strict;
use warnings;
use integer;
use Carp;

require Exporter;

our @ISA = qw(Exporter);

our($debug) = 0;

# Items to export into callers namespace by default. Note: do not export
# names by default without a very good reason. Use EXPORT_OK instead.
# Do not simply export all your public functions/methods/constants.

# This allows declaration	use Math::BaseArith ':all';
# If you do not need this, moving things directly into @EXPORT or @EXPORT_OK
# will save memory.
our %EXPORT_TAGS = ( 'all' => [ qw(
	encode
	decode
	$Math::BaseArith::debug
) ] );

our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );

our @EXPORT = qw(
	encode
	decode
);
our $VERSION = '1.00';

#######################################################################

sub encode {
	croak "Function called in void context" unless defined wantarray;

	my $value = shift; # value to be encoded
	my $b_listRef = shift; # list of base values

	my @b_list = @$b_listRef; # copy the base value list
	my @r_list;
	my @radix_list = (1);

	print STDERR "encode($value ,[@$b_listRef])"
		if $Math::BaseArith::debug >= 1;

	my $r = 0;
	my $b = 1;

	# Compute the radix divisors from the base list, and put in reverse order
	# [1760,3,12] miles/yards/feet/inches becomes [63360,5280,1760]
	# [2,2,2,2] becomes [16,8,4,2]
	do {
		$b *= pop @b_list;
		unshift @radix_list, $b;
	} while @b_list;

	my $i = 0;
	foreach $b (@radix_list) {
		$i++;
		if ($b > $value) {
			printf STDERR "%10d%10d%10d%10d\n", $b,$value,$r,$value%$b
				if $Math::BaseArith::debug >= 2;
			push @r_list, 0 if $i > 1;
			next;
		}
		my $r = $b ? int($value/$b) : 0;
		printf STDERR "%10d%10d%10d%10d\n", $b,$value,$r,$b?$value%$b:0 if $Math::BaseArith::debug >= 2;
		push @r_list, $r;
		$value %= $b if $b;
	}

	shift @r_list while (scalar(@r_list) > scalar(@$b_listRef));

	return wantarray ? @r_list : \@r_list;
}

#######################################################################

sub decode {
	my $r_listRef = shift; # list of representation values
	my $b_listRef = shift; # list of base values

	print STDERR "decode([@$r_listRef],[@$b_listRef])"
		if $Math::BaseArith::debug >= 1;

	if ( scalar(@$r_listRef) > scalar(@$b_listRef) &&
		 scalar(@$b_listRef) != 1 )
	{
		carp "length error";
		return;
	}

	my $value = 0;
	my $b = 1;
	my $base = 1;
	my $r;

	do {
		$r = pop @$r_listRef;
		$value += $r * $base;
		printf STDERR "%10d%10d%10d%10d\n", $r,$b,$base,$value
			if $Math::BaseArith::debug >= 2;
		$b = pop @$b_listRef || $b;
		$base *= $b;
	} while @$r_listRef;
	$value;
}

1;
__END__