File Coverage

blib/lib/FFI/Platypus/Type/StringArray.pm

Criterion	Covered	Total	%
statement	40	40	100.0
branch	7	8	87.5
condition	1	3	33.3
subroutine	7	7	100.0
pod	0	3	0.0
total	55	61	90.1

package FFI::Platypus::Type::StringArray;

use strict;
use warnings;

# ABSTRACT: Platypus custom type for arrays of strings
our $VERSION = '0.01'; # VERSION


use constant _incantation =>
  $^O eq 'MSWin32' && $Config::Config{archname} =~ /MSWin32-x64/
  ? 'Q'
  : 'L!';

my @stack;

sub perl_to_native
{
  # this is the variable length version
  # and is actually simpler than the
  # fixed length version
  my $count = scalar @{ $_[0] };
  my $pointers = pack(('P' x $count)._incantation, @{ $_[0] }, 0);
  my $array_pointer = unpack _incantation, pack 'P', $pointers;
  push @stack, [ \$_[0], \$pointers ];
  $array_pointer;
}

sub perl_to_native_post
{
  pop @stack;
  ();
}

sub ffi_custom_type_api_1
{
  # arg0 = class
  # arg1 = FFI::Platypus instance
  # arg2 = array size
  # arg3 = default value
  my(undef, undef, $count, $default) = @_;

  my $config = {
    native_type => 'opaque',
    perl_to_native => \&perl_to_native,
    perl_to_native_post => \&perl_to_native_post,
  };

  if(defined $count)
  {
    $config->{perl_to_native} = sub {
      my @list;
      my $incantation = '';

      foreach my $i (0..($count-1))
      {
        my $item = $_[0]->[$i];
        if(defined $item)
        {
          push @list, $item;
          $incantation .= 'P';
        }
        elsif(defined $default)
        {
          push @list, $default;
          $incantation .= 'P';
        }
        else
        {
          push @list, 0;
          $incantation .= _incantation;
        }
      }

      push @list, 0;
      $incantation .= _incantation;
      my $pointers = pack $incantation, @list;
      my $array_pointer = unpack _incantation, pack 'P', $pointers;
      push @stack, [ \@list, $pointers ];
      $array_pointer;
    };
  }

  $config;
}

1;

__END__