File Coverage

blib/lib/FFI/C/File.pm
Criterion Covered Total %
statement 29 30 96.6
branch 5 6 83.3
condition n/a
subroutine 9 9 100.0
pod 2 2 100.0
total 45 47 95.7


line stmt bran cond sub pod time code
1             package FFI::C::File;
2              
3 2     2   241170 use strict;
  2         8  
  2         58  
4 2     2   11 use warnings;
  2         3  
  2         53  
5 2     2   11 use Carp qw( croak );
  2         3  
  2         95  
6 2     2   1534 use FFI::Platypus 1.00;
  2         16502  
  2         108  
7 2     2   16 use base qw( Exporter );
  2         4  
  2         2022  
8              
9             our @EXPORT_OK = qw( SEEK_SET SEEK_CUR SEEK_END );
10              
11             # ABSTRACT: Perl interface to C File pointer
12             our $VERSION = '0.15'; # VERSION
13              
14              
15             our $ffi = FFI::Platypus->new( api => 1, lib => [undef] );
16             $ffi->type( 'object(FFI::C::File)' => 'FILE' );
17             $ffi->load_custom_type('::Enum', 'whence',
18             { package => 'FFI::C::File', prefix => 'SEEK_', type => 'int' },
19             'set',
20             'cur',
21             'end',
22             );
23              
24              
25             $ffi->attach( fopen => [ 'string', 'string' ] => 'opaque' => sub {
26             my($xsub, $class, $filename, $mode) = @_;
27             my $ptr = $xsub->($filename, $mode);
28             unless(defined $ptr)
29             {
30             croak "Error opening $filename with mode $mode: $!";
31             }
32             bless \$ptr, $class;
33             });
34              
35              
36             $ffi->attach( tmpfile => [] => 'opaque' => sub {
37             my($xsub, $class) = @_;
38             if(my $ptr = $xsub->())
39             {
40             return bless \$ptr, $class;
41             }
42             else
43             {
44             croak "Error opening temp file: $!"
45             }
46             });
47              
48              
49             sub new
50             {
51 1     1 1 6 my($class, $ptr) = @_;
52 1         4 bless \$ptr, $class;
53             }
54              
55              
56             $ffi->attach( freopen => ['string','string','FILE'] => 'opaque' => sub {
57             my($xsub, $self, $filename, $mode) = @_;
58             if(my $ptr = $xsub->($filename, $mode, $self))
59             {
60             $$self = $ptr;
61             }
62             else
63             {
64             $$self = undef;
65             $filename = 'undef' unless defined $filename;
66             croak "Error opening $filename with mode $mode: $!";
67             }
68             });
69              
70              
71             sub _read_write_wrapper
72             {
73 8     8   2623 my($xsub, $self, $buffer, $size) = @_;
74 8         47 $self->clearerr;
75 8         150 my $ret = $xsub->($$buffer, 1, $size, $self);
76 8 100       36 if($ret != $size)
77             {
78 1 50       8 if(my $error = $self->ferror)
79             {
80 0         0 croak "File error: $!";
81             }
82             }
83 8         41 return $ret;
84             }
85              
86             $ffi->attach( fread => ['string', 'size_t', 'size_t', 'FILE'] => 'size_t' => \&_read_write_wrapper );
87              
88              
89             $ffi->attach( fwrite => ['string', 'size_t', 'size_t', 'FILE'] => 'size_t' => \&_read_write_wrapper );
90              
91              
92             $ffi->attach( fseek => ['FILE', 'long', 'whence'] => 'int', sub {
93             my $xsub = shift;
94             $xsub->(@_) and croak "Error seeking file: $!";
95             });
96              
97              
98             $ffi->attach( ftell => ['FILE'] => 'long' );
99              
100              
101             $ffi->attach( rewind => ['FILE'] );
102              
103              
104             $ffi->attach( fflush => ['FILE'] => 'int' => sub {
105             my($xsub, $self) = @_;
106             my $ret = $xsub->($self);
107             die 'fixme' unless $ret == 0;
108             return;
109             });
110              
111              
112             $ffi->attach( clearerr => ['FILE'] );
113              
114              
115             $ffi->attach( feof => ['FILE'] => 'int' );
116              
117              
118             $ffi->attach( ferror => ['FILE'] => 'int' );
119              
120              
121             sub take
122             {
123 1     1 1 430 my($self) = @_;
124 1         3 my $ptr = $$self;
125 1         2 $$self = undef;
126 1         3 $ptr;
127             }
128              
129              
130             $ffi->attach( fclose => [ 'FILE' ] => 'int' => sub {
131             my($xsub, $self) = @_;
132             my $ret = $xsub->($self);
133             if($ret != 0)
134             {
135             croak "Error closing file: $!";
136             }
137             $$self = undef;
138             });
139              
140             sub DESTROY
141             {
142 11     11   6567 my($self) = @_;
143 11 100       59 $self->fclose if defined $$self;
144             }
145              
146              
147             1;
148              
149             __END__