base58.pl

use 5.016;

use Encode::Base58::GMP;
use Data::UUID;

# '11115QchsAWLTKggVhJEd'
# '00000000-ffff-ffff-0000-000000000000'

# 55b1a44d-e22b-4cf1-9c89-486d20c06adc
# 4da4b155 2be2 f14c 9c89 486d20c06adc
# say unpack "H*", pack "N",unpack"V",pack "H*", "4da4b155"

# PaA685CK7YdqgPiG9assQYu
# my $uuid = Data::UUID->new->from_string('00000000-ffff-ffff-0000-000000000000');
# say encode_base58("0x".unpack("H*",$uuid));
# my $bin = decode_base58("aA685CK7YdqgPiG9assQYu","flickr");
# say length $bin;
# say $bin;
# say Math::GMPz::Rmpz_get_str($bin,16);
# say unpack "H*",$bin;
# say "55b1a44d-e22b-4cf1-9c89-486d20c06adc";
# say unpack "H*",
# 	pack "N n a*",
# 	unpack "V v a*",
# 	pack "H8 H4 H4 H4 H12",
# 	split"-","55b1a44d-e22b-4cf1-9c89-486d20c06adc";

use DDP;

my $alb  = '123456789abcdefghijkmnopqrstuvwxyzABCDEFGHJKLMNPQRSTUVWXYZ';
my @nb58 = split //, $alb;
my @cb58 = map ord,@nb58;
my @dm58;
for (0..255) {
	$dm58[$_] = index $alb, chr($_);
}

sub e58($) {
	my @bin = unpack "C*", shift;
	use integer;
	my $zcount = 0;
	++$zcount while $zcount < @bin and !$bin[$zcount];
	my $size = (@bin - $zcount) * 138 / 100 + 1;
	
	my @buf;
	my ($i,$j,$high,$carry);
	for ($i = $zcount, $high = $size - 1; $i < @bin; ++$i, $high = $j) {
		for ($carry = $bin[$i], $j = $size - 1; ($j > $high) || $carry; --$j) {
			$carry += 256 * $buf[$j];
			$buf[$j] = $carry % 58;
			$carry /= 58;
		}
	}
	for ($j = 0; ($j < $size) && !$buf[$j]; ++$j) {}
	my @ret = (
		($nb58[0])x$zcount,
		(map { $nb58[$_] } @buf[$j..$size-1])
	);
	return join'',@ret;
}


sub d58($) {
	my @bin = unpack "C*", shift;
	use integer;
	my $outisz = (@bin + 3) / 4;
	my @outi = (0)x$outisz;
	
	my $bytesleft = @bin % 4;
	my $zeromask = $bytesleft ? (0xffffffff << ($bytesleft * 8)) : 0;
	
	my $zcount = 0;
	my ($i,$j);
	for ($i = 0; $i < @bin and $bin[$i] eq $cb58[0]; ++$i) {
		$zcount++;
	}
	my $c;
	for (; $i < @bin; $i++) {
		die "Bad char '$bin[$i]' at pos $i" if $dm58[$bin[$i]] == -1;
		$c = $dm58[$bin[$i]];
		for ($j=$outisz;$j--;) {
			my $t = $outi[$j] * 58 + $c;
			$c = ($t & 0x3f00000000) >> 32;
			$outi[$j] = $t & 0xffffffff;
		}
		if ($c) { die "XXX"; }
		if ($outi[0] & $zeromask) { die "YYY"; }
	}
	
	$j = 0;
	my @out;
	if ($bytesleft >= 3) {
		push @out, ($outi[0] & 0xff0000) >> 16;
	}
	if ($bytesleft >= 2) {
		push @out, ($outi[0] & 0xff00) >> 8;
	}
	if ($bytesleft >= 1) {
		push @out, ($outi[0] & 0xff);
		$j++;
	}
	
	for (; $j < $outisz; ++$j)
	{
		push @out, ($outi[$j] >> 0x18) & 0xff;
		push @out, ($outi[$j] >> 0x10) & 0xff;
		push @out, ($outi[$j] >>    8) & 0xff;
		push @out, ($outi[$j] >>    0) & 0xff;
	}
	
	my $skip;
	for ($i = 0; $i < @out; $i++) {
		last if $out[$i];
		++$skip;
	}
	splice @out,0,$skip - $zcount;
	
	return pack "C*",@out;
}

e58("09") eq '4ER' or die;
e58("\x{0}9\x{0}") eq '15kA' or die;
e58("\x{0}\x{0}\x{0}") eq '111' or die;
e58(pack"H*","00000000ffffffff0000000000000000") eq '11115QchsAWLTKggVhJEd' or die;

say unpack "H*",d58("11115QchsAWLTKggVhJEd");
d58("4ER") eq "09" or die;
d58("15kA") eq "\x{0}9\x{0}" or die;
d58("111") eq "\x{0}\x{0}\x{0}" or die;
d58("11115QchsAWLTKggVhJEd") eq pack"H*","00000000ffffffff0000000000000000" or die;

say e58(
		pack "V v v a*",
		unpack "N n n a*",
	pack "H8 H4 H4 H4 H12",
	split("-",'00000000-ffff-ffff-0000-000000000000'));

__END__

say id2uuid("PaA685CK7YdqgPiG9assQYu");
say uuid2id("55b1a44d-e22b-4cf1-9c89-486d20c06adc","P");

say id2uuid( '11115QchsAWLTKggVhJEd');
say uuid2id( '00000000-ffff-ffff-0000-000000000000');

sub id2uuid ($) {
	my $raw = substr($_[0],1);
	my $bin = decode_base58($raw,"flickr");
	return join "-",
		unpack "H8 H4 H4 H4 H12",
		pack "N n n a*",
		unpack "V v v a*",
		pack "H*", Math::GMPz::Rmpz_get_str($bin,16);
}

sub uuid2id ($;$) {
	my $uuid = $_[0];
	return $_[1].encode_base58("0x".
		unpack "H*",
		pack "V v v a*",
		unpack "N n n a*",
		pack "H8 H4 H4 H4 H12",
		split("-",$uuid),
		'flickr'
	);
}