File Coverage

blib/lib/FFI/Platypus/Declare.pm

Criterion	Covered	Total	%
statement	91	98	92.8
branch	8	10	80.0
condition	3	6	50.0
subroutine	23	27	85.1
pod	13	13	100.0
total	138	154	89.6

package FFI::Platypus::Declare;

use strict;
use warnings;
use 5.008004;
use Carp ();
use FFI::Platypus 1.33;

# ABSTRACT: (discouraged) Declarative interface to FFI::Platypus
our $VERSION = '1.33'; # VERSION


our $ffi    = {};
our $types  = {};

sub _ffi_object
{
  my($package, $filename) = caller(1);
  $ffi->{$package} ||= FFI::Platypus->new->package($package,$filename);
}


sub lib (@)
{
  _ffi_object->lib(@_);
}


sub type ($;$)
{
  _ffi_object->type(@_);
}


sub custom_type ($$)
{
  _ffi_object->custom_type(@_);
}


sub load_custom_type ($$;@)
{
  _ffi_object->load_custom_type(@_);
}


sub type_meta($)
{
  _ffi_object->type_meta(@_);
}


my $inner_counter = 0;

sub attach ($$$;$$)
{
  my $wrapper;
  $wrapper = pop if ref($_[-1]) eq 'CODE';
  my($name, $args, $ret, $proto) = @_;

  my($symbol_name, $perl_name) = ref $name ? (@$name) : ($name, $name);
  my $function = _ffi_object->function($symbol_name, $args, $ret, $wrapper);
  $function->attach($perl_name, $proto);
  ();
}


sub closure (&)
{
  my($coderef) = @_;
  require FFI::Platypus::Closure;
  FFI::Platypus::Closure->new($coderef);
}


sub sticky ($)
{
  my($closure) = @_;
  Carp::croak("usage: sticky \$closure")
    unless defined $closure && ref($closure) eq 'FFI::Platypus::Closure';
  $closure->sticky;
  $closure;
}


sub cast ($$$)
{
  _ffi_object->cast(@_);
}


sub attach_cast ($$$)
{
  my($name, $type1, $type2) = @_;
  my $caller = caller;
  $name = join '::', $caller, $name;
  _ffi_object->attach_cast($name, $type1, $type2);
}


sub sizeof ($)
{
  _ffi_object->sizeof($_[0]);
}


sub lang ($)
{
  _ffi_object->lang($_[0]);
}


sub abi ($)
{
  _ffi_object->abi($_[0]);
}

sub import
{
  my $caller = caller;
  shift; # class

  foreach my $arg (@_)
  {
    if(ref $arg)
    {
      if($arg->[0] =~ /::/)
      {
        _ffi_object->load_custom_type(@$arg);
        no strict 'refs';
        *{join '::', $caller, $arg->[1]} = sub () { $arg->[1] };
      }
      else
      {
        _ffi_object->type(@$arg);
        no strict 'refs';
        *{join '::', $caller, $arg->[1]} = sub () { $arg->[0] };
      }
    }
    else
    {
      _ffi_object->type($arg);
      no strict 'refs';
      *{join '::', $caller, $arg} = sub () { $arg };
    }
  }

  no strict 'refs';
  *{join '::', $caller, 'lib'} = \&lib;
  *{join '::', $caller, 'type'} = \&type;
  *{join '::', $caller, 'type_meta'} = \&type_meta;
  *{join '::', $caller, 'custom_type'} = \&custom_type;
  *{join '::', $caller, 'load_custom_type'} = \&load_custom_type;
  *{join '::', $caller, 'attach'} = \&attach;
  *{join '::', $caller, 'closure'} = \&closure;
  *{join '::', $caller, 'sticky'} = \&sticky;
  *{join '::', $caller, 'cast'} = \&cast;
  *{join '::', $caller, 'attach_cast'} = \&attach_cast;
  *{join '::', $caller, 'sizeof'} = \&sizeof;
  *{join '::', $caller, 'lang'} = \⟨
  *{join '::', $caller, 'abi'} = \&abi;
}

1;

__END__