File Coverage

blib/lib/FFI/C/ArrayDef.pm

Criterion	Covered	Total	%
statement	85	88	96.5
branch	26	36	72.2
condition	13	24	54.1
subroutine	17	17	100.0
pod	2	2	100.0
total	143	167	85.6

package FFI::C::ArrayDef;

use strict;
use warnings;
use 5.008001;
use Ref::Util qw( is_blessed_ref is_ref is_plain_arrayref );
use FFI::C::Array;
use Sub::Install ();
use Sub::Util ();
use Scalar::Util qw( refaddr );
use base qw( FFI::C::Def );

our @CARP_NOT = qw( FFI::C );

# ABSTRACT: Array data definition for FFI
our $VERSION = '0.15'; # VERSION


sub new
{
  my $self = shift->SUPER::new(@_);

  my %args = %{ delete $self->{args} };

  my $member;
  my $count = 0;

  my @members = @{ delete $args{members} || [] };
  if(@members == 1)
  {
    ($member) = @members;
  }
  elsif(@members == 2)
  {
    ($member, $count) = @members;
  }
  else
  {
    Carp::croak("The members argument should be a struct/union type and an optional element count");
  }

  if(my $def = $self->ffi->def('FFI::C::Def', $member))
  {
    $member = $def;
  }

  Carp::croak("Canot nest an array def inside of itself") if refaddr($member) == refaddr($self);

  Carp::croak("Illegal member")
    unless defined $member && is_blessed_ref($member) && $member->isa("FFI::C::Def");

  Carp::croak("The element count must be a positive integer")
    if defined $count && $count !~ /^[1-9]*[0-9]$/;

  $self->{size}              = $member->size * $count;
  $self->{align}             = $member->align;
  $self->{members}->{member} = $member;
  $self->{members}->{count}  = $count;

  Carp::carp("Unknown argument: $_") for sort keys %args;

  if($self->class)
  {
    # not handled by the superclass:
    #  3. Any nested cdefs must have Perl classes.

    {
      my $member = $self->{members}->{member};
      my $accessor = $self->class . '::get';
      Carp::croak("Missing Perl class for $accessor")
        if $member->{nest} && !$member->{nest}->{class};
    }

    $self->_generate_class(qw( get ));

    {
      my $member_class = $self->{members}->{member}->class;
      my $member_size  = $self->{members}->{member}->size;
      my $code = sub {
        my($self, $index) = @_;
        Carp::croak("Negative array index") if $index < 0;
        Carp::croak("OOB array index") if $self->{count} && $index >= $self->{count};
        my $ptr = $self->{ptr} + $member_size * $index;
        $member_class->new($ptr,$self);
      };
      Sub::Util::set_subname(join('::', $self->class), $code);
      Sub::Install::install_sub({
        code => $code,
        into => $self->class,
        as   => 'get',
      });
    }

    {
      no strict 'refs';
      push @{ join '::', $self->class, 'ISA' }, 'FFI::C::Array';
    }

  }

  $self;
}


sub create
{
  my $self = shift;

  return $self->class->new(@_) if $self->class;

  local $self->{size} = $self->{size};
  my $count = $self->{members}->{count};
  if(@_ == 1)
  {
    if(! is_ref $_[0])
    {
      $count = shift;
    }
    elsif(is_plain_arrayref $_[0])
    {
      $count = scalar @{$_[0]};
    }
    if($count)
    {
      $self->{size} = $self->{members}->{member}->size * $count;
    }
  }

  if( (@_ == 2 && ! is_ref $_[0]) || ($self->size) )
  {
    my $array = $self->SUPER::create(@_);
    $array->{count} = $count;
    FFI::C::Util::perl_to_c($array, $_[0]) if @_ == 1 && is_plain_arrayref $_[0];
    return $array;
  }

  Carp::croak("Cannot create array without knowing the number of elements");
}

1;

__END__