File Coverage

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

Criterion	Covered	Total	%
statement	40	40	100.0
branch	11	12	91.6
condition	1	3	33.3
subroutine	11	11	100.0
pod	0	4	0.0
total	63	70	90.0

package FFI::Platypus::Type::StringPointer;

use strict;
use warnings;
use 5.008004;
use FFI::Platypus;
use Scalar::Util qw( readonly );

# ABSTRACT: Convert a pointer to a string and back
our $VERSION = '2.07'; # VERSION


use constant _incantation =>
  $^O eq 'MSWin32' && do { require Config; $Config::Config{archname} =~ /MSWin32-x64/ }
  ? 'Q'
  : 'L!';
use constant _pointer_buffer => "P" . FFI::Platypus->new( api => 2 )->sizeof('opaque');

my @stack;

sub perl_to_native
{
  if(defined $_[0])
  {
    my $packed = pack 'P', ${$_[0]};
    my $pointer_pointer = pack 'P', $packed;
    my $unpacked = unpack _incantation, $pointer_pointer;
    push @stack, [ \$packed, \$pointer_pointer ];
    return $unpacked;
  }
  else
  {
    push @stack, [];
    return undef;
  }
}

sub perl_to_native_post
{
  my($packed) = @{ pop @stack };
  return unless defined $packed;
  unless(readonly(${$_[0]}))
  {
    ${$_[0]} = unpack 'p', $$packed;
  }
}

sub native_to_perl
{
  return unless defined $_[0];
  my $pointer_pointer = unpack(_incantation, unpack(_pointer_buffer, pack(_incantation, $_[0])));
  $pointer_pointer ? \unpack('p', pack(_incantation, $pointer_pointer)) : \undef;
}

sub ffi_custom_type_api_1
{
  return {
    native_type         => 'opaque',
    perl_to_native      => \&perl_to_native,
    perl_to_native_post => \&perl_to_native_post,
    native_to_perl      => \&native_to_perl,
  }
}

1;

__END__