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


line stmt bran cond sub pod time code
1             package FFI;
2              
3 3     3   102876 use strict;
  3         17  
  3         93  
4 3     3   14 use warnings;
  3         6  
  3         83  
5 3     3   16 use Carp ();
  3         5  
  3         42  
6 3     3   1381 use FFI::Platypus;
  3         15290  
  3         247  
7 3   33 3   22 use constant _is_win32 => $^O =~ /^(MSWin32|cygwin|msys2?)$/ && FFI::Platypus->abis->{stdcall};
  3         4  
  3         1651  
8              
9             # ABSTRACT: Perl Foreign Function Interface based on libffi
10             our $VERSION = '1.15'; # VERSION
11              
12             our $ffi = FFI::Platypus->new;
13             $ffi->lib(undef);
14              
15             my $stdcall_ffi = _is_win32
16             ? do {
17             my $ffi = FFI::Platypus->new;
18             $ffi->lib(undef);
19             $ffi->abi('stdcall');
20             }
21             : $ffi;
22              
23             our %typemap = qw(
24             c char
25             C uchar
26             s short
27             S ushort
28             i int
29             I uint
30             l long
31             L ulong
32             f float
33             d double
34             p string
35             v void
36             o opaque
37             );
38              
39             sub _ffi
40             {
41 10 50   10   60 if($_[0] =~ s/^([sc])//)
42             {
43 10 100       40 return $stdcall_ffi if $1 eq 's';
44             }
45             else
46             {
47 0         0 Carp::croak("first character of signature must be s or c");
48             }
49            
50 8         19 $ffi;
51             }
52              
53             sub call
54             {
55 9     9 1 2645 my $addr = shift;
56 9         15 my $signature = shift;
57 9         62 my $ffi = _ffi($signature);
58 9         28 my($ret_type, @args_types) = map { $typemap{$_} } split //, $signature;
  23         60  
59 9         38 $ffi->function($addr => \@args_types => $ret_type)->call(@_);
60             }
61              
62             sub callback
63             {
64 1     1 1 9 my($signature, $sub) = @_;
65 1         4 my $ffi = _ffi($signature);
66 1         4 my($ret_type, @args_types) = map { $typemap{$_} } split //, $signature;
  3         9  
67 1         6 my $type = '(' . join(',', @args_types) . ')->' . $ret_type;
68 1         6 my $closure = $ffi->closure($sub);
69 1         1286 bless {
70             addr => $ffi->cast($type => 'opaque', $closure),
71             sub => $sub,
72             closure => $closure,
73             }, 'FFI::Callback';
74             }
75              
76             package FFI::Callback;
77              
78 1     1   12 sub addr { shift->{addr} }
79              
80             1;
81              
82             __END__