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.11'; # 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->mangler(sub { "uuid$_[0]" });

$ffi->attach( _generate_random => ['opaque']           => 'void'   );
$ffi->attach( _generate_time   => ['opaque']           => 'void'   );
$ffi->attach( _unparse         => ['opaque', 'opaque'] => 'void'   );
$ffi->attach( _parse           => ['string', 'opaque'] => 'int'    );
$ffi->attach( _copy            => ['opaque', 'opaque'] => 'void'   );
$ffi->attach( _clear           => ['opaque']           => 'void'   );
$ffi->attach( _type            => ['opaque']           => 'int'    );
$ffi->attach( _variant         => ['opaque']           => 'int'    );
$ffi->attach( _time            => ['opaque', 'opaque'] => 'time_t' );
$ffi->attach( _is_null         => ['opaque']           => 'int'    );
$ffi->attach( _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__