package Data::SUID;

# Copyright (c) 2014-2015 Iain Campbell. All rights reserved.
#
# This work may be used and modified freely, but I ask that the copyright
# notice remain attached to the file. You may modify this module as you
# wish, but if you redistribute a modified version, please attach a note
# listing the modifications you have made.

=pod

=encoding utf-8

=head1 NAME

Data::SUID - Generates thread-safe sequential unique ids

=head1 VERSION

version 1.000007

=head1 SYNOPSIS

    use Data::SUID 'suid';              # Or use ':all' tag
    use Data::Dumper;

    $Data::Dumper::Indent = 0;
    $Data::Dumper::Terse  = 1;

    my $suid = suid();                  # Old school, or ...
    my $suid = Data::SUID->new();       # Do it OOP style

    print $suid->hex                    # 55de233819d51b1a8a67e0ac
    print $suid->dec                    # 26574773684474770905501261996
    print $suid->uuencode               # ,5=XC.!G5&QJ*9^"L
    print $suid->binary                 # 12 bytes of unreadable gibberish
    print $suid                         # 55de233819d51b1a8a67e0ac

    # Use the hex, dec, uuencode and binary methods as fire-and-forget
    # constructors, if you prefer:

    my $suid_hex = suid->hex;           # If you just want the goodies

=head1 DESCRIPTION

Use this package to generate thread-safe 12-byte sequential unique ids
modeled upon the MongoDB BSON ObjectId. Unlike traditional GUIDs, these
are somewhat more index-friendly and reasonably suited for use as
primary keys within database tables. They are guaranteed to have a high
level of uniqueness, given that they contain a timestamp, a host identifier
and an incremented sequence number.

=cut

use strict;
use warnings;
use threads;
use threads::shared;
use Crypt::Random          ();
use Exporter               ();
use Net::Address::Ethernet ();
use Math::BigInt try => 'GMP';
use Readonly;
use namespace::clean;
use overload '""' => 'hex';

our $VERSION = '1.000006';
$VERSION = eval($VERSION);

our @ISA         = qw(Exporter);
our @EXPORT_OK   = qw(suid);
our %EXPORT_TAGS = ( all => \@EXPORT_OK, ALL => \@EXPORT_OK );

=head1 METHODS

=head2 new

    $suid = Data::SUID->new();

Generates a new SUID object.

=cut


sub new
{
    my ($class) = @_;
    $class = ref($class) || __PACKAGE__;
    my $time = time();
    my $host = &_machine_ident;
    Readonly my $id => sprintf( '%08x%s%04x%s', $time, $host, $$, &_count );
    return bless( \$id, $class );
}

=head2 hex

    $string = $suid->hex();
    $string = Data::SUID->hex();
    $string = suid->hex();
    
Returns the SUID value as a 24-character hexadecimal string.

    $string = "$suid";

The SUID object's stringification operation has been overloaded to give this
value, too.

=cut


sub hex
{
    my ($self) = @_;
    $self = &new unless ref($self);
    return $$self;
}

=head2 dec

    $string = $suid->dec();
    $string = Data::SUID->dec();
    $string = suid->dec();

Returns the SUID value as a big integer.

=cut


sub dec
{
    my ($self) = @_;
    $self = &new unless ref($self);
    return Math::BigInt->new( '0x' . $$self );
}

=head2 uuencode

    $string = $suid->uuencode();
    $string = Data::SUID->uuencode();
    $string = suid->uuencode();

Returns the SUID value as a UUENCODED string.

=cut


sub uuencode
{
    my ($self) = @_;
    $self = &new unless ref($self);
    return pack( 'u', pack( 'H*', $$self ) );
}

=head2 binary

    $binstr = $suid->binary();
    $binstr = Data::SUID->binary();
    $binstr = suid->binary();

Returns the SUID value as 12 bytes of binary data.

=cut


sub binary
{
    use bytes;
    my ($self) = @_;
    $self = &new unless ref($self);
    return pack( 'H*', $$self );
}

=head1 EXPORTED FUNCTIONS

=head2 suid

    my $suid = suid();

Generates a new SUID object.

=cut


sub suid
{
    return __PACKAGE__->new(@_);
}

{
    my @ident : shared;
    my $ident : shared;

    lock @ident;
    lock $ident;

    # Don't want the 24-bit OUID!
    @ident = +( map 0+ $_, Net::Address::Ethernet::get_address() )[ 3, 4, 5 ];
    $ident = sprintf( '%02x%02x%02x', @ident );


    sub _machine_ident
    {
        return wantarray ? @ident : $ident;
    }
}

{
    my $count_width    = 24;
    my $count_mask     = 2**$count_width - 1;
    my $count_format   = '%0' . int( $count_width / 4 ) . 'x';
    my $count : shared = undef;


    sub _reset_count
    {
        my ( $class, $value ) = @_;

        lock $count;
        $count = undef;

        if ( defined $value ) {
            $count = $count_mask & ( 0+ abs($value) );
        }

        unless ( defined $count ) {
            my $random
              = Crypt::Random::makerandom( Strength => 1, Uniform => 1, Size => $count_width );

            # Can't share $random between threads, so coerce as string and
            # assign to count
            $count = "$random";
        }
        return $class;
    }


    sub _count
    {
        &_reset_count unless defined $count;
        my $result = sprintf( $count_format, $count );
        lock $count;
        $count = $count_mask & ( 1 + $count );
        return $result;
    }
}

1;

=head1 REPOSITORY

=over 2

=item * L<https://github.com/cpanic/Data-SUID|https://github.com/cpanic/Data-SUID>

=item * L<http://search.cpan.org/dist/Data-SUID/lib/Data/SUID.pm|http://search.cpan.org/dist/Data-SUID/lib/Data/SUID.pm>

=back

=head1 BUG REPORTS

Please report any bugs to L<http://rt.cpan.org/>

=head1 AUTHOR

Iain Campbell <cpanic@cpan.org>

=head1 COPYRIGHT AND LICENCE

Copyright (C) 2014-2015 by Iain Campbell

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.

=cut
