Add debug utils and more tests

lib/Data/YUID.pm

@@ -2,10 +2,38 @@
 
 package Data::YUID;
 use strict;
+use warnings;
+use Data::YUID::Generator;
 
 use 5.006.001;
 our $VERSION = '0.04';
 
+sub debug_id {
+    my $class = shift;
+    my $id = shift;
+    return "timestamp:~ serial:~ host:~" unless defined $id;
+    my $f = shift || "0x\%x";
+    return sprintf "timestamp:$f serial:$f host:$f", $class->_id_parts($id);
+}
+
+sub _id_parts {
+    Data::YUID::Generator->decompose($_[1]);
+}
+
+sub timestamp {
+    my @parts = shift->_id_parts(@_);
+    return $parts[0];
+}
+
+sub serial {
+    my @parts = shift->_id_parts(@_);
+    return $parts[1];
+}
+sub host {
+    my @parts = shift->_id_parts(@_);
+    return $parts[2];
+}
+
 1;
 __END__
 
@@ -30,6 +58,14 @@ Data::YUID - Distributed ID generator ("Yet another Unique ID")
         );
     my $id = $client->get_id;
 
+    ## some utilities (useful for debugging)
+    my $id = $generator->get_id;
+    say Data::YUID->as_string($id);
+    # timestamp:15855749 serial:ffc host:fbdd
+    say Data::YUID->host($id);
+    say Data::YUID->timestamp($id);
+    say Data::YUID->serial($id);
+
 =head1 DESCRIPTION
 
 I<Data::YUID> ("Yet another Unique ID") is an ID allocation engine that can

lib/Data/YUID/Generator.pm

@@ -14,10 +14,13 @@ use fields qw(host_id start_time current_time min_id max_id ids make_id);
 
 use constant EPOCH_OFFSET => 946684800; # Sat, Jan 1 2000 00:00 GMT
 
+## |             timestamp             |   serial   |      host     |
+## |              36 bits              |     12     |       16      |
 use constant HOST_ID_BITS => 16;
 use constant TIME_BITS => 36;
 use constant SERIAL_BITS => 64 - HOST_ID_BITS - TIME_BITS;
 
+use constant HOST_SHIFT => HOST_ID_BITS;
 use constant TIME_SHIFT => HOST_ID_BITS + SERIAL_BITS;
 use constant SERIAL_SHIFT => HOST_ID_BITS;
 
@@ -29,6 +32,7 @@ use constant TIME_MAX_SHIFTED => TIME_MAX << TIME_SHIFT;
 use constant SERIAL_MAX => (1 << SERIAL_BITS) - 1;
 use constant SERIAL_MAX_SHIFTED => SERIAL_MAX << SERIAL_SHIFT;
 
+use constant HOST_MAX => (1 << HOST_ID_BITS) - 1;
 BEGIN {
     use Config;
     unless ($Config{use64bitint}) {
@@ -109,5 +113,15 @@ sub get_id ($) {
     return $self->{ ids }->{ $key };
 }
 
+## deconstruct an id in its composing part, using id order:
+## (ts, serial, host)
+sub decompose {
+    my $class = shift;
+    my $id = shift;
+    my $ts     =   $id >> TIME_SHIFT;
+    my $serial = ( $id >> HOST_SHIFT ) & SERIAL_MAX;
+    my $host   =   $id  & HOST_MAX;
+    return ($ts, $serial, $host);
+}
 
 1;

t/01-generator.t

@@ -1,12 +1,82 @@
 # $Id$
 
 use strict;
+use Data::YUID;
 use Data::YUID::Generator;
-use Test::More tests => 3;
-
-my $gen = Data::YUID::Generator->new;
-isa_ok($gen, 'Data::YUID::Generator');
-my $id1 = $gen->get_id;
-ok($id1);
-my $id2 = $gen->get_id;
-isnt($id1, $id2);
+use Test::More 'no_plan';
+use Time::HiRes;
+
+## basic test
+{
+    my $gen = Data::YUID::Generator->new;
+    isa_ok($gen, 'Data::YUID::Generator');
+    my $id1 = $gen->get_id;
+    ok($id1);
+    my $id2 = $gen->get_id;
+    isnt($id1, $id2);
+}
+
+## test component of the id
+{
+    my $gen = Data::YUID::Generator->new;
+    my $id1 = $gen->get_id;
+    my $id2 = $gen->get_id;
+
+    is (Data::YUID->host($id1), Data::YUID->host($id2)), "same host";
+    my $serial1 = Data::YUID->serial($id1);
+    my $serial2 = Data::YUID->serial($id2);
+    my $ts1 = Data::YUID->timestamp($id1);
+    my $ts2 = Data::YUID->timestamp($id2);
+
+    if ($ts1 == $ts2) {
+        is $serial1, 0, "First serial";
+        is $serial2, $serial1 + 1, "next one";
+    }
+    else {
+        is $serial1, 0, "First serial";
+        is $serial2, 0, "First serial of different ts";
+    }
+}
+
+## Now exhaust serial
+{
+    my $gen = Data::YUID::Generator->new;
+    my $prev_ts;
+    my $tries = 5;
+    AGAIN:
+    $tries--;
+    for (0..Data::YUID::Generator->SERIAL_MAX) {
+        my $id = $gen->get_id;
+        my $serial = Data::YUID->serial($id);
+        $prev_ts = Data::YUID->timestamp($id) unless $prev_ts;
+        if ($_ && $serial != $_) {
+            my $ts = Data::YUID->timestamp($id);
+            is $ts, $prev_ts, "switched over second boundary";
+            is $serial, 0, "so serial is 0 again";
+            $prev_ts = undef;
+            if ($tries == 0) {
+                fail "cpu too slow to go over serial in less than a second";
+                last;
+            }
+            diag "let's do it again";
+            goto AGAIN;
+        }
+    }
+    my $id = $gen->get_id;
+    if (! $id) {
+        is $id, undef, "serial exhausted $prev_ts";
+        (undef, my $us) = Time::HiRes::gettimeofday;
+        my $diff = 1_000_000 - $us + 1;
+        diag "sleeping until next sec ($diff µs)";
+        Time::HiRes::usleep($diff);
+    }
+    else {
+        my $ts = Data::YUID->timestamp($id);
+        is $ts, $prev_ts + 1, "switched over sec boundary after loop";
+    }
+    $id = $gen->get_id;
+    my $ts = Data::YUID->timestamp($id);
+    isnt $id, undef, "can generate ids again $ts";
+}
+
+#done_testing();