#!/usr/bin/perl -w
# cn - a arbitrary precession number converter
#
# - 2004-07-29: first version
# - 2018-04-28: updated to run on modern perl installations without warnings
# Copyright: Guido Socher
#
$numofarg = scalar(@ARGV);
die("Too may arguments. cn -h for help.\n") if ( $numofarg > 2);
&help if ($numofarg < 1 || $ARGV[0] eq "-h" ) ;

# This is a converter program from number space x with baseX to 
# number space y with baseY
@tabley = (0,1,2,3,4,5,6,7,8,9,A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T,U,V);
$tablex = '0123456789ABCDEFGHIJKLMNOPQRSTUV';

# check input:
$inandoutbase = shift(@ARGV);
unless ($inandoutbase =~ m/^[123]?[dhboDHBO\d]:[dhboDHBO\d]\d?$/) {
    die("Wrong format of input/output base. cn -h or man cn for help.\n");
}
($basex,$basey) = split(/:/,$inandoutbase);
$basex = &translateandcheck($basex);
$basey = &translateandcheck($basey);
if (scalar(@ARGV) <= 0) {
    # read a single number form a pipe
    chop($numberx = <STDIN>);
} else {
    $numberx = shift(@ARGV);
}
die("ERROR: No number was specified on STDIN or commandline.\ncn -h or man cn for help.\n") unless ($numberx =~ m/^\w+$/);
$numberx =~ tr/a-z/A-Z/;
$regexp = '[^' . substr($tablex,0,$basex) . ']';
die("ERROR:Number space does not belong to specified input base.\ncn -h or man cn for help.\n") if ($numberx =~ m/$regexp/);
die("There is no need to convert zero. It's always zero.\n") if $numberx =~ s/^0+$//;
$numberx =~ s/^0+//;


unless ("$basex" eq "10") {
    # convert number space x to decimal
    # Idea: 1010 = 0*2 + 2*1 +0*4 + 8*1 = 10
    # read data in array:
    while ($numberx) {
        push(@numberdigits,chop($numberx));
    }
    foreach (@numberdigits) {
        $_ = index($tablex,$_);
    } 
    # start conversion:
    $power = "1";
    $numbery = "0";
    foreach (@numberdigits) {
        $numbery = &badd(&bmul($power,$_),$numbery);
        $power = &bmul($power,$basex);
    }
} else {
    # no conversion needed input already decimal
    $numbery = "$numberx";
}

unless ("$basey" eq "10") {
    # convert decimal to number space y
    # Idea: 14/2 = 7 remainder 0 , 7/2 = 3 rem 1 , 3/2 = 1 rem 1 , 1/2 = 0 rem 1 
    # => take remainders: 1110
    $i = 0;
    ($Quotient,$ergebnis[$i]) = &bdiv($numbery,$basey);
    while ($Quotient > 0.5) {
        $i ++;
        ($Quotient,$ergebnis[$i]) = &bdiv($Quotient,$basey);
        die("Infinite loop. Termination forced\n") if ($i > 6400);
    }
    foreach (@ergebnis) {
        $_ = $tabley[$_];
    } 
    $outputnumber = join('',reverse(@ergebnis));
}

# print always decimal value as it is generated anyway
$numbery =~ s/\+//;
print('dec :',$numbery," \n") if ($basex ne "10");
if ($basey eq "2") {
    print('bin :',$outputnumber,"\n");
} elsif ($basey eq "8") {
    print('oct :',$outputnumber,"\n");
} elsif ($basey eq "16") {
    print('hex :',$outputnumber,"\n");
} elsif ($basey ne "10") {
    print("In number space with base \"$basey\" :$outputnumber\n");
} 
#-----------------------------------------------------
sub translateandcheck($){
    my $base = shift;
    my %translate = ("h",16,"H",16,"d",10,"D",10,"b",2,"B",2,"o",8,"O",8);
    if ($base =~ m/^[hHbBdDoO]$/) {
        $translate{$base};
    } elsif ($base =~ m/^[123]?\d$/) {
        die ("Error: Base out of range ( only upto 32 ).\n") if ($base >= 33);
        die ("Error: Base out of range ( not smaller than 2 ).\n") if ($base <= 1);
        $base;
    } else {
        die ("Strange number base specification cn -h or man cn for help.\n");
    } 
} 
#-----------------------------------------------------
# math package for positiv large integers specially optimized for cn program.
# if a number is called small then it must not be larger than 1000 

#-----------------------------------------------------
sub intformat($){
# generate an array with blocks of 5 digits:
# 1231234512345 => 123 12345 12345
    my $string = shift;
    my @result=();
    my ($lengthofstring,$restofdigits,$countoffive);
    $lengthofstring = length($string);
    $restofdigits = $lengthofstring % 5;
    $countoffive = int($lengthofstring / 5);
    unless ($restofdigits) {
        $restofdigits = 5;
        $countoffive--;
    } # unless
    if ($countoffive >=0 ){
	    @result=unpack("a$restofdigits" . ("a5" x $countoffive),$string);
    }
    @result;
} # sub

#-----------------------------------------------------
sub bdiv($$){
# devide a large number by a small one
# 2400001/23 => 24/23 = 1 remainder 1 100001/23 = 4347 remainder 20 (4 digits => add 0)
# => 1 0 4347 rest 20
    my $lnum=shift;
    my $snum=shift;
    my ($quotient,$ii,$car,$result);
    my @result; my @numbersoffive;
    if (length($lnum) < 5) { #must be a string compare otherwise number
                             #will be converted to int and possibly change
        (int($lnum / $snum), $lnum % $snum);
    } else {
        @numbersoffive = &intformat($lnum);
        @result = (); $car = 0;
        foreach $ii (@numbersoffive) {
            $car *= 100000;
            $quotient = int(($ii + $car) / $snum);
            $quotient = substr('00000' . $quotient,-5);
            push(@result,$quotient);
            $car = ($ii + $car) % $snum;
        } # foreach
        # remove leading zeros
        $result = join('',@result);
        $result =~ s/^0+// unless ($result == 0);
        # return (quotient,reminder)
        ($result,$car);
    } # else
} # sub

#-----------------------------------------------------
sub bmul($$){
# multiply a large number and a small number
# 2400002*23 => 2*23 = 46 => 24*23 =552
# => 552 000 46
    my $lnum=shift;
    my $snum=shift;
    my ($prod,$car,$maxfivedigits,$result,$ii);
    my @numbersoffive;my @result;
    if (length($lnum) < 5) { #must be a string compare otherwise number
                             #will be converted to int and possibly change
        $lnum * $snum;
    } else {
        @numbersoffive = reverse(&intformat($lnum));
        @result = (); $car = 0;
        foreach $ii (@numbersoffive) {
            $prod = $ii * $snum + $car;
            $maxfivedigits = $prod - ($car = int($prod * (1/100000))) * 100000;
            $maxfivedigits = substr('00000' . $maxfivedigits,-5);
            unshift(@result,$maxfivedigits);
        } # foreach
        unshift(@result,$car) if ($car);
        # remove leading zeros
        $result = join('',@result);
        $result =~ s/^0+//;
        # return (product)
        $result;
    }
} 

#-----------------------------------------------------
sub badd($$){
    # add two lage numbers
    # 2400005 + 2399999 => 00005 + 99999 = 0 carry 1 => 24 + 1 + 23 = 48
    # => 48 00000
    # Stolen from Mark Biggar's perl library
    # The idea behind this algorithm is that the carry can not be larger
    # than 100000 if two five digit numbers are added
    my $sumone=shift;
    my $sumtwo=shift;
    my @x;my @y;my @result;
    my ($car,$x,$y,$result,$ii);
    @x = reverse(&intformat($sumone));
    @y = reverse(&intformat($sumtwo));
    $car = 0;
    for $x (@x) {
        last unless @y || $car;
        $ii = shift(@y);
        $ii =0 unless ($ii);
        $x = 0 unless ($x);  #to fix an undef bug
        $car = (($x += $ii + $car) >= 100000); #$car is 0 or 1
        $x -= 100000 if $car;
        # fill with zeros
        $x = substr('00000' . $x,-5);
    }
    for $y (@y) {
        last unless $car;
        $y -= 100000 if $car = (($y += $car) >= 100000);
        # fill with zeros
        $y = substr('00000' . $y,-5);
    }
    @result = reverse((@x,@y,$car));
    $result = join('',@result);
    # remove leading zeros
    $result =~ s/^0+//;
    # return (sum)
    $result;
} 
#-----------------------------------------------------
sub help(){
    print " cn converts numbers from a number space with a specified input base
 to numbers in number space with desired output base. Possible ranges for
 <inbase> and <outbase> are 2 to 32.

 Usage: cn <inbase>:<outbase> [ <number to convert> ]

 The following shortcuts/aliases are defined:
 \"h\" same as 16 (hexadecimal)
 \"d\" same as 10 (decimal)
 \"o\" same as 8  (octal)
 \"b\" same as 2  (binary)
 EXAMPLE: Convert hex A0 to the eqivalent octal number:
          cn h:o a0   or  cn 16:8 a0  or  cn 16:o A0
          or convert hex A0 to the binary equivalent:
          cn h:b a0   or  cn h:2 a0   or ...

 The program can handle numbers of arbitrary length.

 <number to convert> may be given at stdin.
";
exit 0;
}
#-----------------------------------------------------
__END__