package URN;

use warnings;
use strict;

use Carp;

my %table = (
    '0' => 1,
    '1' => 2,
    '2' => 3,
    '3' => 4,
    '4' => 5,
    '5' => 6,
    '6' => 7,
    '7' => 8,
    '8' => 9,
    '9' => 41,
    'a' => 18,
    'b' => 14,
    'c' => 19,
    'd' => 15,
    'e' => 16,
    'f' => 21,
    'g' => 22,
    'h' => 23,
    'i' => 24,
    'j' => 25,
    'k' => 42,
    'l' => 26,
    'm' => 27,
    'n' => 13,
    'o' => 28,
    'p' => 29,
    'q' => 31,
    'r' => 12,
    's' => 32,
    't' => 33,
    'u' => 11,
    'v' => 34,
    'w' => 35,
    'x' => 36,
    'y' => 37,
    'z' => 38,
    '+' => 49,
    ':' => 17,
    '-' => 39,
    '/' => 45,
    '_' => 43,
    '.' => 47,
);

sub gen {
    my $str = shift;

    my $num = '';
    foreach my $char ( split //, $str ) {
        if ( !exists $table{$char} ) {
            croak "invalid character '$char' within URN";
        }
        $num .= $table{$char};
    }

    my $i = 1;
    my $ps;
    foreach my $digit ( split //, $num ) {
        $ps += $digit * $i;
        $i++;
    }

    my $q = int( $ps / (substr $num, -1, 1) );
    return $str . substr( $q, -1, 1 );
}

1;
__END__
