File Coverage

blib/lib/UUID/FFI.pm

Criterion	Covered	Total	%
statement	67	68	98.5
branch	5	8	62.5
condition			n/a
subroutine	22	23	95.6
pod	11	11	100.0
total	105	110	95.4

package UUID::FFI;

use strict;
use warnings;
use 5.008001;
use FFI::Platypus 1.00;
use FFI::Platypus::Memory ();
use FFI::CheckLib ();
use Carp qw( croak );
use overload '<=>' => sub { $_[0]->compare($_[1]) },
             '""'  => sub { shift->as_hex         },
             bool => sub { 1 }, fallback => 1;

# TODO: as_bin or similar

# ABSTRACT: Universally Unique Identifiers FFI style
our $VERSION = '0.10'; # VERSION


my $ffi = FFI::Platypus->new( api => 1 );

$ffi->lib(sub {
  my @lib = eval {
    require Alien::libuuid;
    Alien::libuuid->VERSION('0.05');
    Alien::libuuid->dynamic_libs;
  };
  return @lib if @lib;
  @lib = FFI::CheckLib::find_lib(
    lib => 'uuid',
    symbol => [
      'uuid_generate_random',
      'uuid_generate_time',
      'uuid_unparse',
      'uuid_parse',
      'uuid_copy',
      'uuid_clear',
      'uuid_type',
      'uuid_variant',
      'uuid_time',
      'uuid_is_null',
      'uuid_compare',
    ]
  );
  die "Unable to find system libuuid with required symbols.  Try installing or upgrading Alien::libuuid"
    unless @lib;
  return @lib;
});

$ffi->attach( [uuid_generate_random => '_generate_random'] => ['opaque']           => 'void'   => '$'  );
$ffi->attach( [uuid_generate_time   => '_generate_time']   => ['opaque']           => 'void'   => '$'  );
$ffi->attach( [uuid_unparse         => '_unparse']         => ['opaque', 'opaque'] => 'void'   => '$$' );
$ffi->attach( [uuid_parse           => '_parse']           => ['string', 'opaque'] => 'int'    => '$$' );
$ffi->attach( [uuid_copy            => '_copy']            => ['opaque', 'opaque'] => 'void'   => '$$' );
$ffi->attach( [uuid_clear           => '_clear']           => ['opaque']           => 'void'   => '$'  );
$ffi->attach( [uuid_type            => '_type']            => ['opaque']           => 'int'    => '$'  );
$ffi->attach( [uuid_variant         => '_variant']         => ['opaque']           => 'int'    => '$'  );
$ffi->attach( [uuid_time            => '_time']            => ['opaque', 'opaque'] => 'time_t' => '$$' );
$ffi->attach( [uuid_is_null         => '_is_null']         => ['opaque']           => 'int'    => '$'  );
$ffi->attach( [uuid_compare         => '_compare']         => ['opaque', 'opaque'] => 'int'    => '$$' );


sub new
{
  my($class, $hex) = @_;
  croak "usage: UUID::FFI->new($hex)" unless $hex;
  my $self = bless \FFI::Platypus::Memory::malloc(16), $class;
  my $r = _parse($hex, $$self);
  croak "$hex is not a valid hex UUID" if $r != 0;
  $self;
}


sub new_random
{
  my($class) = @_;
  my $self = bless \FFI::Platypus::Memory::malloc(16), $class;
  _generate_random->($$self);
  $self;
}


sub new_time
{
  my($class) = @_;
  my $self = bless \FFI::Platypus::Memory::malloc(16), $class;
  _generate_time($$self);
  $self;
}


sub new_null
{
  my($class) = @_;
  my $self = bless \FFI::Platypus::Memory::malloc(16), $class;
  _clear($$self);
  $self;
}


sub is_null { _is_null(${$_[0]}) }


sub clone
{
  my($self) = @_;
  my $other = bless \FFI::Platypus::Memory::malloc(16), ref $self;
  _copy($$other, $$self);
  $other;
}


sub as_hex
{
  my($self) = @_;
  my $data = "x" x 36;
  my $ptr = unpack 'L!', pack 'P', $data;
  _unparse($$self, $ptr);
  $data;
}


sub compare { _compare( ${$_[0]}, ${$_[1]} ) }

my %type_map = (
  1 => 'time',
  4 => 'random',
);


sub type
{
  my($self) = @_;
  my $r = _type($$self);
  $type_map{$r} || croak "illegal type: $r";
}

my @variant = qw( ncs dce microsoft other );


sub variant
{
  my($self) = @_;
  my $r = _variant($$self);
  $variant[$r] || croak "illegal varient: $r";
}


sub time
{
  my($self) = @_;
  _time($$self, undef);
}

sub DESTROY
{
  my($self) = @_;
  FFI::Platypus::Memory::free($$self);
}

1;

__END__