File Coverage

blib/lib/UUID/Generator/PurePerl.pm

Criterion	Covered	Total	%
statement	90	95	94.7
branch	14	16	87.5
condition	4	6	66.6
subroutine	21	22	95.4
pod	5	10	50.0
total	134	149	89.9

package UUID::Generator::PurePerl;

use strict;
use warnings;
use 5.006;

our $VERSION = '0.04_02';

use Carp;
use Digest;
use Time::HiRes;
use UUID::Object;
use UUID::Generator::PurePerl::RNG;
use UUID::Generator::PurePerl::NodeID;
use UUID::Generator::PurePerl::Util;

sub new {
    my $class = shift;
    my $self  = bless {}, $class;

    return $self;
}

sub rng {
    my ($self) = @_;

    if (! defined $self->{rng}) {
        $self->{rng} = UUID::Generator::PurePerl::RNG->singleton();
    }

    return $self->{rng};
}

sub node_getter {
    my ($self) = @_;

    if (! defined $self->{node_getter}) {
        $self->{node_getter} = UUID::Generator::PurePerl::NodeID->singleton();
    }

    return $self->{node_getter};
}

sub get_timestamp {
    return Time::HiRes::time();
}

sub get_clk_seq {
    my $self = shift;
    my $node_id = shift;

    my $inc_seq = 0;

    my $ts = $self->get_timestamp();
    if (! defined $self->{last_ts} || $ts <= $self->{last_ts}) {
        $inc_seq ++;
    }
    $self->{last_ts} = $ts;

    if (! defined $self->{last_node}) {
        if (defined $node_id) {
            $inc_seq ++;
        }
    }
    else {
        if (! defined $node_id || $node_id ne $self->{last_node}) {
            $inc_seq ++;
        }
    }
    $self->{last_node} = $node_id;

    if (! defined $self->{clk_seq}) {
        $self->{clk_seq} = $self->_generate_clk_seq();
        return $self->{clk_seq} & 0x03ff;
    }

    if ($inc_seq) {
        $self->{clk_seq} = ($self->{clk_seq} + 1) % 65536;
    }

    return $self->{clk_seq} & 0x03ff;
}

sub _generate_clk_seq {
    my $self = shift;

    my @data;
    push @data, q{}  . $$;
    push @data, q{:} . Time::HiRes::time();

    return digest_as_16bit(@data);
}

sub generate_v1 {
    my $self = shift;

    my $node = $self->node_getter->node_id();
    my $ts   = $self->get_timestamp();

    return
        UUID::Object->create_from_hash({
            variant => 2,
            version => 1,
            node    => $node,
            time    => $ts,
            clk_seq => $self->get_clk_seq($node),
        });
}

sub generate_v1mc {
    my $self = shift;

    my $node = $self->node_getter->random_node_id();
    my $ts   = $self->get_timestamp();

    return
        UUID::Object->create_from_hash({
            variant => 2,
            version => 1,
            node    => $node,
            time    => $ts,
            clk_seq => $self->get_clk_seq(undef),
        });
}

sub generate_v4 {
    my ($self) = @_;

    my $b = q{};
    for (1 .. 4) {
        $b .= pack 'I', $self->rng->rand_32bit;
    }

    my $u = UUID::Object->create_from_binary($b);

    $u->variant(2);
    $u->version(4);

    return $u;
}

sub generate_v3 {
    my ($self, $ns, $data) = @_;

    return $self->_generate_digest(3, 'MD5', $ns, $data);
}

sub generate_v5 {
    my ($self, $ns, $data) = @_;

    return $self->_generate_digest(5, 'SHA-1', $ns, $data);
}

sub _generate_digest {
    my ($self, $version, $digest, $ns, $data) = @_;

    $ns = UUID::Object->new($ns)->as_binary;

    my $dg = Digest->new($digest);

    $dg->reset();

    $dg->add($ns);

    $dg->add($data);

    my $u = UUID::Object->create_from_binary($dg->digest);
    $u->variant(2);
    $u->version($version);

    return $u;
}

1;
__END__