use strict;
use warnings;
my $num=shift || abort("enter a number\ne.g. $0 345");
if ($num !~/^[0-9]{1,16}$/){abort('Number must be a positive integer')
+;}
print "Number: $num\n";
my $enc=encodeBase31($num);
print "Base31: $enc\n";
my $dec=decodeBase31($enc);
print "Decoded: $dec\n";
exit;
################
sub encodeBase31{
    # Base31 encoding removes problems that may arise where a number e
+ncoded spells something not very nice
    my $decimal=shift || return "No number to encode to base31";
    my $string = '';
    my $base = 31;
    $decimal=strip($decimal);
    if ($decimal !~/^[0-9]{1,16}$/){
        return 'Value must be a positive integer';
        }
    #maximum character string is 36 characters
    my $charset = '0123456789BCDFGHJKLMNPQRSTVWXYZ';
    do {
        #get remainder after dividing by BASE
        my $remainder = $decimal % $base;
        # get CHAR from array
        my $char      = substr($charset, $remainder, 1);
        #prepend to output
        $string    = "$char$string";
        $decimal   = ($decimal - $remainder) / $base;
       }
    while ($decimal > 0);
    return $string;
    }
###############
sub decodeBase31{
    my $string=shift;
    if(!length(strip($string))){return "No base31 string to decode";}
    #uppercase the string
    $string=uc($string);
    my $decimal = 0;
    my $base=31;
    #maximum character string is 36 characters
    my $charset = '0123456789BCDFGHJKLMNPQRSTVWXYZ';
    do {
        #extract leading character
        my $char   = substr($string, 0, 1);
        #drop leading character
        $string = substr($string, 1);
        #get offset in $charset
        my $pos = index($charset, $char);
        if ($pos == -1) {
            return "Illegal character ($char) in INPUT string";
          }
        $decimal = ($decimal * $base) + $pos;
        } 
    while(length($string));
    return $decimal;
    }
###############
sub strip{
    #usage: $str=strip($str);
    #info: strips off beginning and endings returns, newlines, tabs, a
+nd spaces
    my $str=shift;
    if(length($str)==0){return;}
    $str=~s/^[\r\n\s\t]+//s;
    $str=~s/[\r\n\s\t]+$//s;
    return $str;
    }
###############
sub abort{
    my $msg=shift;
    print "$msg\n";
    exit;
    }
[download]