File Coverage

blib/lib/FFI/C.pm

Criterion	Covered	Total	%
statement	65	69	94.2
branch	13	18	72.2
condition	14	26	53.8
subroutine	12	12	100.0
pod	5	5	100.0
total	109	130	83.8

package FFI::C;

use strict;
use warnings;
use 5.008001;
use Carp ();
use Ref::Util qw( is_ref is_plain_arrayref is_plain_hashref );

# ABSTRACT: C data types for FFI
our $VERSION = '0.15'; # VERSION


our %ffi;

sub _ffi_get
{
  my($filename) = @_;
  $ffi{$filename} ||= do {
    require FFI::Platypus;
    FFI::Platypus->new( api => 1 );
  };
}

sub ffi
{
  my($class, $new) = @_;
  my(undef, $filename) = caller;

  if($new)
  {
    Carp::croak("Already have an FFI::Platypus instance for $filename")
      if defined $ffi{$filename};
    return $ffi{$filename} = $new;
  }

  _ffi_get($filename);
}


our $def_class;
sub _gen
{
  shift;
  my($class, $filename) = caller;

  my($name, $members);

  my %extra = is_plain_hashref $_[-1] ? %{ pop() } : ();

  if(@_ == 2 && !is_ref $_[0] && is_plain_arrayref $_[1])
  {
    ($name, $members) = @_;
  }
  elsif(@_ == 1 && is_plain_arrayref $_[0])
  {
    $name = lcfirst [split /::/, $class]->[-1];
    $name =~ s/([A-Z]+)/'_' . lc($1)/ge;
    $name .= "_t";
    ($members) = @_;
  }
  else
  {
    my($method) = map { lc $_ } $def_class =~ /::([A-Za-z]+)Def$/;
    Carp::croak("usage: FFI::C->$method([\$name], \\\@members)");
  }

  $def_class->new(
    _ffi_get($filename),
    %extra,
    name    => $name,
    class   => $class,
    members => $members,
  );
}

sub struct
{
  require FFI::C::StructDef;
  $def_class = 'FFI::C::StructDef';
  goto &_gen;
}


sub union
{
  require FFI::C::UnionDef;
  $def_class = 'FFI::C::UnionDef';
  goto &_gen;
}


sub array
{
  require FFI::C::ArrayDef;
  $def_class = 'FFI::C::ArrayDef';
  goto &_gen;
}


sub enum
{
  (undef)    = shift;
  my $name   = defined $_[0] && !is_ref $_[0] ? shift : undef;
  my @values = defined $_[0] && is_plain_arrayref $_[0] ? @{shift()} : ();
  my %config = defined $_[0] && is_plain_hashref $_[0]  ? %{shift()} : ();

  my($class, $filename) = caller;

  unless(defined $name)
  {
    $name = lcfirst [split /::/, $class]->[-1];
    $name =~ s/([A-Z]+)/'_' . lc($1)/ge;
    $name .= "_t";
  }

  my $ffi = _ffi_get($filename),

  $config{package} ||= $class;
  my @maps;
  $config{maps} = \@maps;
  my $rev = $config{rev}  ||= 'str';

  $ffi->load_custom_type('::Enum', $name, \%config, @values);

  my($str_lookup, $int_lookup, $type) = @maps;

  require FFI::C::Def;
  $ffi->def('FFI::C::EnumDef', $name,
    FFI::C::EnumDef->new(
      str_lookup => $str_lookup,
      int_lookup => $int_lookup,
      type       => $type,
      rev        => $rev,
    )
  );
}


1;

__END__