File Coverage

lib/ULID/Tiny.pm

Criterion	Covered	Total	%
statement	98	99	98.9
branch	21	22	95.4
condition	11	13	84.6
subroutine	15	15	100.0
pod	2	2	100.0
total	147	151	97.3

package ULID::Tiny;

use strict;
use warnings;
use v5.16;

use Crypt::SysRandom qw(random_bytes);
use Time::HiRes qw(time);
use Fcntl qw(O_RDONLY);

use Exporter 'import';

our $VERSION = '1.0.0';

our @EXPORT    = qw(ulid ulid_date);
our @EXPORT_OK = qw(ulid ulid_date);

my @CROCKFORD_CHARS = split //, '0123456789ABCDEFGHJKMNPQRSTVWXYZ';

###############################################################################
# Public API
###############################################################################

sub ulid {
	my (%opts) = @_;

	my $ts;
	if (defined($opts{time})) {
		$ts = _encode_timestamp($opts{time});
	} else {
		$ts = _unixtime_ms_48bit();
	}

	my $rand = random_bytes(10);
	my $ret  = '';

	state $prev_ts   = 0;
	state $prev_ulid = "";

	if (!$opts{unique} && $prev_ts && ($ts eq $prev_ts)) {
		$ret = _crockford_increment($prev_ulid);
	} else {
		# 48 bits of timestamp + 80 bits of randomness
		my $raw = $ts . $rand;

		$ret = _crockford_encode($raw);
	}

	if (!$opts{unique}) {
		$prev_ts   = $ts;
		$prev_ulid = $ret;
	}

	if ($opts{binary}) {
		my $bits = _crockford_decode_bits($ret);
		$bits = substr($bits, 0, 128);
		return pack("B*", $bits);
	}

	return $ret;
}

# Extract the millisecond epoch timestamp from a ULID string
sub ulid_date {
	my ($ulid_str) = @_;

	if (!defined $ulid_str || length($ulid_str) != 26) {
		die "Invalid ULID: must be exactly 26 characters";
	}

	# The first 10 characters of a ULID encode the 48-bit timestamp.
	# 10 Crockford chars = 50 bits, but only the top 48 are the timestamp
	# (the encoder right-pads 2 zero bits to reach a multiple of 5).
	my $time_part = substr($ulid_str, 0, 10);
	my $raw       = _crockford_decode_int($time_part);
	my $ms        = $raw >> 2; # discard the 2 padding bits

	return $ms;
}

###############################################################################
# Internal functions
###############################################################################

sub _crockford_increment {
    my ($str) = @_;

    state %val;

	# Build the reverse mapping table (once)
	if (!scalar(%val)) {
		@val{@CROCKFORD_CHARS} = (0..$#CROCKFORD_CHARS);
	}

    my @out   = reverse split //, uc($str);
    my $carry = 1;

    for my $i (0 .. $#out) {
        last unless $carry;

        my $v  = $val{$out[$i]};
        $v    += $carry;

        if ($v >= 32) {
            $out[$i] = $CROCKFORD_CHARS[0];
            $carry   = 1;
        } else {
            $out[$i] = $CROCKFORD_CHARS[$v];
            $carry   = 0;
        }
    }

	if ($carry) {
		push(@out, '1');
	}

    return join('', reverse @out);
}

sub _crockford_encode {
    my ($bytes) = @_;
    my $bits    = unpack("B*", $bytes);
    my $result  = '';

    # Pad bits to multiple of 5
    my $pad = (5 - (length($bits) % 5)) % 5;
    $bits .= '0' x $pad;

    for (my $i = 0; $i < length($bits); $i += 5) {
        my $chunk = substr($bits, $i, 5);
        my $index = 0;
        for my $bit (split //, $chunk) {
            $index = ($index << 1) | $bit;
        }

        $result .= $CROCKFORD_CHARS[$index];
    }

    return $result;
}

# Decode a Crockford Base32 string to a decimal integer (for timestamps)
sub _crockford_decode_int {
    my ($str) = @_;

    state %val;
	if (!scalar(%val)) {
		@val{@CROCKFORD_CHARS} = (0..$#CROCKFORD_CHARS);
	}

    my $n = 0;
    for my $ch (split //, uc($str)) {
        $n = $n * 32 + ($val{$ch} // die "Invalid Crockford character: $ch");
    }

    return $n;
}

# Decode a Crockford Base32 string to a binary bit string
sub _crockford_decode_bits {
    my ($str) = @_;

    state %val;
	if (!scalar(%val)) {
		@val{@CROCKFORD_CHARS} = (0..$#CROCKFORD_CHARS);
	}

    my $bits = '';
    for my $ch (split //, uc($str)) {
        my $v = $val{$ch} // die "Invalid Crockford character: $ch";
        $bits .= sprintf("%05b", $v);
    }

    return $bits;
}

sub _unixtime_ms_48bit {
    my $ms = int(time() * 1000);

    return pack("H*", sprintf("%012X", $ms));
}

sub _encode_timestamp {
    my ($epoch_ms) = @_;

    return pack("H*", sprintf("%012X", int($epoch_ms)));
}

1;

__END__