File Coverage

blib/lib/Number/Encode.pm

Criterion	Covered	Total	%
statement	9	55	16.3
branch	0	16	0.0
condition	0	3	0.0
subroutine	3	5	60.0
pod	2	2	100.0
total	14	81	17.2

package Number::Encode;

require 5.005_62;
use strict;
use warnings;
use Digest::MD5 qw(md5);

require Exporter;

our @ISA = qw(Exporter);

our %EXPORT_TAGS = ( 'all' => [ qw(nonuniform uniform) ] );

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

our $VERSION = '1.00';

sub uniform ($) {
    my $data = shift;
    my $char = 0;
    my $carry = 0;
    my $cbits = 0;
    my $hsh = '';

    for my $c (split(//, $data))
    {

	$carry <<= 8;
	$carry += ord($c);
	$cbits += 8;

	while ($cbits >= 4) {

	    my $n;

	    if ($cbits >= 4) {	# More than 4 bits available
		$n = $carry & 0xF;
		if ($n > 9) {
		    $n ^= vec(md5($hsh . $carry . $n), $n, 4);
		    $n &= 0x7 if $n > 9;
		}
		$carry >>= 4;
		$cbits -= 4;
	    }

	    $hsh .= chr(ord('0') + $n);
	}
    }

    if ($cbits) {
	$hsh .= chr(ord('0') + $carry);
    }

    return $hsh;
}

sub nonuniform ($) {
    my $data = shift;
    my $char = 0;
    my $carry = 0;
    my $cbits = 0;
    my $hsh = '';

    for my $c (split(//, $data))
    {
	$carry <<= 256;
	$carry += ord($c);
	$cbits += 8;

	while ($cbits >= 4) {

	    my $n;

	    if ($cbits >= 4) {	# More than 4 bits available
		$n = $carry & 0xF;
		if ($n <= 9) {
		    $carry >>= 4;
		    $cbits -= 4;
		}
	    }

	    if ($cbits == 3 or $n > 9) {
		$n = $carry & 0x7;
		$carry >>= 3;
		$cbits -= 3;
	    }
	    $hsh .= chr(ord('0') + $n);
	}
    }

    if ($cbits) {
	$hsh .= chr(ord('0') + $carry);
    }

    return $hsh;
}

1;
__END__