File Coverage

blib/lib/Encode/Base32/Crockford.pm

Criterion	Covered	Total	%
statement	59	59	100.0
branch	24	24	100.0
condition	3	4	75.0
subroutine	11	11	100.0
pod	5	5	100.0
total	102	103	99.0

package Encode::Base32::Crockford;
{
  $Encode::Base32::Crockford::VERSION = '2.112991';
}

use warnings;
use strict;

use base qw(Exporter);
our @EXPORT_OK = qw(
	base32_encode base32_encode_with_checksum
	base32_decode base32_decode_with_checksum
	normalize
);
our %EXPORT_TAGS = ( 'all' => \@EXPORT_OK );

use Carp qw(croak);
use Scalar::Util qw(looks_like_number);

my %SYMBOLS;

# Note: regular digits do not include I, L, O or U. See spec in documentation.
@SYMBOLS{0..9,'A'..'H','J','K','M','N','P'..'T','V'..'Z'} = 0..31;

# checksum symbols only from here
@SYMBOLS{'*','~','$','=','U'} = 32..36;

my %SYMBOLS_INVERSE = reverse %SYMBOLS;

sub base32_encode {
        my $number = shift;

        die qq("$number" isn't a number) unless looks_like_number($number);

        return '0' unless $number;

        my @digits;

        # Cut a long story short: keep dividing by 32. Use the remainders to make the
        # digits of the converted number, right to left; the quotient goes to the next
        # iteration to be divided again. When the quotient hits zero, i.e. there's not
        # enough for 32 to be a divisor, the value being divided is the final digit.
        while ($number) {
                my $remainder = $number % 32;
                $number = int($number / 32);
                push @digits, $SYMBOLS_INVERSE{$remainder};
        }

        return join('', reverse @digits) || '0';
}

sub base32_encode_with_checksum {
	my $number = shift;

	my $modulo = $number % 37;

	return base32_encode($number) . $SYMBOLS_INVERSE{$modulo};
}

sub normalize {
	my ($string, $options) = @_;

	my $orig_string = $string;

	$string = uc($string);
	_normalize_actions($orig_string, $string, $options->{"mode"}) if $string ne $orig_string;

	# fix possible transcription errors and remove chunking symbols
	_normalize_actions($orig_string, $string, $options->{"mode"}) if $string =~ tr/IiLlOo-/111100/d;

	$string;
}

# Actions to carry out if normalize() is operating in a particular mode.
sub _normalize_actions {
	my ($old_string, $new_string, $mode) = @_;

	$mode ||= '';

	warn qq(String "$old_string" corrected to "$new_string") if $mode eq "warn";
	die  qq(String "$old_string" requires normalization) if $mode eq "strict";
}

sub base32_decode {
	my ($string, $options) = @_;

	croak "string is undefined" if not defined $string;
	croak "string is empty" if $string eq '';

	$string = normalize($string, $options);

	my $valid;

	if ($options->{"is_checksum"}) {
		die qq(Checksum "$string" is too long; should be one character)
			if length($string) > 1;

		$valid = qr/^[A-Z0-9\*\~\$=U]$/;

	} else {
		# 'U' is only valid as a checksum symbol.
		$valid = qr/^[A-TV-Z0-9]+$/;
	}

	croak qq(String "$string" contains invalid characters) if $string !~ /$valid/;


	my $total = 0;

	# For each base32 digit B of position P counted (using zero-based counting)
	# from right in a number, its decimal value D is calculated with the
	# following expression:
	# 	D = B * 32^P.
	# As any number raised to the power of 0 is 1, we can define an "offset" value
	# of 1 for the first digit calculated and simply multiply the offset by 32
	# after deriving the value for each digit.

	foreach my $symbol (split(//, $string)) {
		$total = $total * 32 + $SYMBOLS{$symbol};
	}

	$total;
}

sub base32_decode_with_checksum {
	my ($string, $options) = @_;
	my $check_string = $string;

	my $checksum = substr($check_string, (length($check_string) - 1), 1, "");

	my $value = base32_decode($check_string, $options);
	my $checksum_value = base32_decode($checksum, { "is_checksum" => 1 });
	my $modulo = $value % 37;

	croak qq(Checksum symbol "$checksum" is not correct for value "$check_string".)
		if $checksum_value != $modulo;

	$value;
}

1;

__END__