#!/usr/bin/perl -w
# encode0.pl - Don Yang (uguu.org)
#
# 09/06/08

use strict;
use constant BASE => 90;  # Any integer from 85 to 94 will work

# Encode 32 bit number in 5 characters
sub Encode32($)
{
   my ($x) = @_;
   my $e = $x % BASE;
   my $d = ($x /= BASE) % BASE;
   my $c = ($x /= BASE) % BASE;
   my $b = ($x /= BASE) % BASE;
   my $a = $x / BASE;
   return pack 'C*', $a + 33, $b + 33, $c + 33, $d + 33, $e + 33;
}

# Encode 4 bytes to 5 characters
sub Encode($)
{
   my ($input) = @_;

   if( length $input < 4 )
   {
      my $p = Encode32(unpack 'V', $input . "\0\0\0");
      return chr(122 + length($input)) . substr($p, 1);
   }
   return Encode32(unpack 'V', $input);
}

# Decode 5 characters to a 32 bit number
sub Decode32(@)
{
   my ($a, $b, $c, $d, $e) = @_;
   return (((($a - 33) * BASE +
              $b - 33) * BASE +
              $c - 33) * BASE +
              $d - 33) * BASE +
              $e - 33;
}

# Decode 5 characters to 4 bytes
sub Decode($)
{
   my ($input) = @_;
   if( ord($input) > 122 )
   {
      my $length = ord($input) - 122;
      my $code = pack 'V', Decode32(33, (unpack 'xC4', $input));
      return substr($code, 0, $length);
   }
   return pack 'V', Decode32(unpack 'C5', $input);
}

# Test Encode/Decode pairs
sub TestUnit($)
{
   my ($input) = @_;
   my ($encoded) = Encode($input);
   if( length($encoded) != 5 || Decode($encoded) ne $input )
   {
      my $error = "FAIL:";
      foreach my $byte (unpack 'C*', $input)
      {
         $error .= sprintf ' %02x', $byte;
      }
      die "$error\n";
   }
}

sub Test()
{
   for(my $i = 0; $i < 256; $i++)
   {
      my $ic = chr($i);
      for(my $j = 0; $j < 256; $j++)
      {
         my $jc = chr($i);

         # Test 4 byte sequences
         TestUnit($ic . $jc . "\0\0");
         TestUnit($ic . "\0" . $jc . "\0");
         TestUnit($ic . "\0\0" . $jc);
         TestUnit("\0" . $ic . $jc . "\0");
         TestUnit("\0" . $ic . "\0" . $jc);
         TestUnit("\0\0" . $ic . $jc);

         # Test 3 byte sequences
         TestUnit($ic . $jc . "\0");
         TestUnit($ic . "\0" . $jc);
         TestUnit("\0" . $ic . $jc);

         # Test 2 byte sequences
         TestUnit($ic . $jc);
      }

      # Test 1 byte sequence
      TestUnit($ic);
   }
}

Test();