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

package FFI::C::File;

use strict;
use warnings;
use Carp qw( croak );
use FFI::Platypus 1.00;
use base qw( Exporter );

our @EXPORT_OK = qw( SEEK_SET SEEK_CUR SEEK_END );

# ABSTRACT: Perl interface to C File pointer
our $VERSION = '0.15'; # VERSION


our $ffi = FFI::Platypus->new( api => 1, lib => [undef] );
$ffi->type( 'object(FFI::C::File)' => 'FILE' );
$ffi->load_custom_type('::Enum', 'whence',
  { package => 'FFI::C::File', prefix => 'SEEK_', type => 'int' },
  'set',
  'cur',
  'end',
);


$ffi->attach( fopen => [ 'string', 'string' ] => 'opaque' => sub {
  my($xsub, $class, $filename, $mode) = @_;
  my $ptr = $xsub->($filename, $mode);
  unless(defined $ptr)
  {
    croak "Error opening $filename with mode $mode: $!";
  }
  bless \$ptr, $class;
});


$ffi->attach( tmpfile => [] => 'opaque' => sub {
  my($xsub, $class) = @_;
  if(my $ptr = $xsub->())
  {
    return bless \$ptr, $class;
  }
  else
  {
    croak "Error opening temp file: $!"
  }
});


sub new
{
  my($class, $ptr) = @_;
  bless \$ptr, $class;
}


$ffi->attach( freopen => ['string','string','FILE'] => 'opaque' => sub {
  my($xsub, $self, $filename, $mode) = @_;
  if(my $ptr = $xsub->($filename, $mode, $self))
  {
    $$self = $ptr;
  }
  else
  {
    $$self = undef;
    $filename = 'undef' unless defined $filename;
    croak "Error opening $filename with mode $mode: $!";
  }
});


sub _read_write_wrapper
{
  my($xsub, $self, $buffer, $size) = @_;
  $self->clearerr;
  my $ret = $xsub->($$buffer, 1, $size, $self);
  if($ret != $size)
  {
    if(my $error = $self->ferror)
    {
      croak "File error: $!";
    }
  }
  return $ret;
}

$ffi->attach( fread => ['string', 'size_t', 'size_t', 'FILE'] => 'size_t' => \&_read_write_wrapper );


$ffi->attach( fwrite => ['string', 'size_t', 'size_t', 'FILE'] => 'size_t' => \&_read_write_wrapper );


$ffi->attach( fseek => ['FILE', 'long', 'whence'] => 'int', sub {
  my $xsub = shift;
  $xsub->(@_) and croak "Error seeking file: $!";
});


$ffi->attach( ftell => ['FILE'] => 'long' );


$ffi->attach( rewind => ['FILE'] );


$ffi->attach( fflush => ['FILE'] => 'int' => sub {
  my($xsub, $self) = @_;
  my $ret = $xsub->($self);
  die 'fixme' unless $ret == 0;
  return;
});


$ffi->attach( clearerr => ['FILE'] );


$ffi->attach( feof => ['FILE'] => 'int' );


$ffi->attach( ferror => ['FILE'] => 'int' );


sub take
{
  my($self) = @_;
  my $ptr = $$self;
  $$self = undef;
  $ptr;
}


$ffi->attach( fclose => [ 'FILE' ] => 'int' => sub {
  my($xsub, $self) = @_;
  my $ret = $xsub->($self);
  if($ret != 0)
  {
    croak "Error closing file: $!";
  }
  $$self = undef;
});

sub DESTROY
{
  my($self) = @_;
  $self->fclose if defined $$self;
}


1;

__END__