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


line stmt bran cond sub pod time code
1             package FFI::C;
2              
3 2     2   446580 use strict;
  2         14  
  2         56  
4 2     2   9 use warnings;
  2         4  
  2         44  
5 2     2   47 use 5.008001;
  2         7  
6 2     2   8 use Carp ();
  2         4  
  2         50  
7 2     2   968 use Ref::Util qw( is_ref is_plain_arrayref is_plain_hashref );
  2         3396  
  2         2016  
8              
9             # ABSTRACT: C data types for FFI
10             our $VERSION = '0.15'; # VERSION
11              
12              
13             our %ffi;
14              
15             sub _ffi_get
16             {
17 14     14   29 my($filename) = @_;
18 14   66     98 $ffi{$filename} ||= do {
19 2         804 require FFI::Platypus;
20 2         7823 FFI::Platypus->new( api => 1 );
21             };
22             }
23              
24             sub ffi
25             {
26 4     4 1 14770 my($class, $new) = @_;
27 4         17 my(undef, $filename) = caller;
28              
29 4 100       14 if($new)
30             {
31             Carp::croak("Already have an FFI::Platypus instance for $filename")
32 2 100       183 if defined $ffi{$filename};
33 1         12 return $ffi{$filename} = $new;
34             }
35              
36 2         8 _ffi_get($filename);
37             }
38              
39              
40             our $def_class;
41             sub _gen
42             {
43 10     10   14 shift;
44 10         40 my($class, $filename) = caller;
45              
46 10         19 my($name, $members);
47              
48 10 50       31 my %extra = is_plain_hashref $_[-1] ? %{ pop() } : ();
  0         0  
49              
50 10 100 66     77 if(@_ == 2 && !is_ref $_[0] && is_plain_arrayref $_[1])
    50 66        
      33        
51             {
52 4         10 ($name, $members) = @_;
53             }
54             elsif(@_ == 1 && is_plain_arrayref $_[0])
55             {
56 6         35 $name = lcfirst [split /::/, $class]->[-1];
57 6         42 $name =~ s/([A-Z]+)/'_' . lc($1)/ge;
  7         38  
58 6         15 $name .= "_t";
59 6         14 ($members) = @_;
60             }
61             else
62             {
63 0         0 my($method) = map { lc $_ } $def_class =~ /::([A-Za-z]+)Def$/;
  0         0  
64 0         0 Carp::croak("usage: FFI::C->$method([\$name], \\\@members)");
65             }
66              
67 10         24 $def_class->new(
68             _ffi_get($filename),
69             %extra,
70             name => $name,
71             class => $class,
72             members => $members,
73             );
74             }
75              
76             sub struct
77             {
78 6     6 1 3261 require FFI::C::StructDef;
79 6         15 $def_class = 'FFI::C::StructDef';
80 6         19 goto &_gen;
81             }
82              
83              
84             sub union
85             {
86 2     2 1 461 require FFI::C::UnionDef;
87 2         8 $def_class = 'FFI::C::UnionDef';
88 2         13 goto &_gen;
89             }
90              
91              
92             sub array
93             {
94 2     2 1 499 require FFI::C::ArrayDef;
95 2         7 $def_class = 'FFI::C::ArrayDef';
96 2         8 goto &_gen;
97             }
98              
99              
100             sub enum
101             {
102 2     2 1 6951 (undef) = shift;
103 2 50 33     14 my $name = defined $_[0] && !is_ref $_[0] ? shift : undef;
104 2 50 33     10 my @values = defined $_[0] && is_plain_arrayref $_[0] ? @{shift()} : ();
  2         5  
105 2 100 66     22 my %config = defined $_[0] && is_plain_hashref $_[0] ? %{shift()} : ();
  1         5  
106              
107 2         10 my($class, $filename) = caller;
108              
109 2 50       6 unless(defined $name)
110             {
111 2         12 $name = lcfirst [split /::/, $class]->[-1];
112 2         25 $name =~ s/([A-Z]+)/'_' . lc($1)/ge;
  2         12  
113 2         9 $name .= "_t";
114             }
115              
116             my $ffi = _ffi_get($filename),
117              
118 2   33     5 $config{package} ||= $class;
119 2         3 my @maps;
120 2         5 $config{maps} = \@maps;
121 2   100     8 my $rev = $config{rev} ||= 'str';
122              
123 2         9 $ffi->load_custom_type('::Enum', $name, \%config, @values);
124              
125 2         2453 my($str_lookup, $int_lookup, $type) = @maps;
126              
127 2         466 require FFI::C::Def;
128 2         13 $ffi->def('FFI::C::EnumDef', $name,
129             FFI::C::EnumDef->new(
130             str_lookup => $str_lookup,
131             int_lookup => $int_lookup,
132             type => $type,
133             rev => $rev,
134             )
135             );
136             }
137              
138              
139             1;
140              
141             __END__