File Coverage

blib/lib/FFI.pm

Criterion	Covered	Total	%
statement	32	33	96.9
branch	3	4	75.0
condition	1	3	33.3
subroutine	9	9	100.0
pod	2	2	100.0
total	47	51	92.1

package FFI;

use strict;
use warnings;
use Carp ();
use FFI::Platypus;
use constant _is_win32 => $^O =~ /^(MSWin32|cygwin|msys2?)$/ && FFI::Platypus->abis->{stdcall};

# ABSTRACT: Perl Foreign Function Interface based on libffi
our $VERSION = '1.14'; # VERSION

our $ffi = FFI::Platypus->new;
$ffi->lib(undef);

my $stdcall_ffi = _is_win32
  ? do {
    my $ffi = FFI::Platypus->new;
    $ffi->lib(undef);
    $ffi->abi('stdcall');
  }
  : $ffi;

our %typemap = qw(
  c   char
  C   uchar
  s   short
  S   ushort
  i   int
  I   uint
  l   long
  L   ulong
  f   float
  d   double
  p   string
  v   void
  o   opaque
);

sub _ffi
{
  if($_[0] =~ s/^([sc])//)
  {
    return $stdcall_ffi if $1 eq 's';
  }
  else
  {
    Carp::croak("first character of signature must be s or c");
  }

  $ffi;
}

sub call
{
  my $addr = shift;
  my $signature = shift;
  my $ffi = _ffi($signature);
  my($ret_type, @args_types) = map { $typemap{$_} } split //, $signature;
  $ffi->function($addr => \@args_types => $ret_type)->call(@_);
}

sub callback
{
  my($signature, $sub) = @_;
  my $ffi = _ffi($signature);
  my($ret_type, @args_types) = map { $typemap{$_} } split //, $signature;
  my $type = '(' . join(',', @args_types) . ')->' . $ret_type;
  my $closure = $ffi->closure($sub);
  bless {
    addr    => $ffi->cast($type => 'opaque', $closure),
    sub     => $sub,
    closure => $closure,
  }, 'FFI::Callback';
}

package FFI::Callback;

sub addr { shift->{addr} }

1;

__END__