File Coverage

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

Criterion	Covered	Total	%
statement	27	27	100.0
branch	10	10	100.0
condition	4	5	80.0
subroutine	9	9	100.0
pod	0	1	0.0
total	50	52	96.1

package FFI::Platypus::Type::PtrObject;

use strict;
use warnings;
use FFI::Platypus 1.11;
use Ref::Util qw( is_blessed_hashref );
use Carp ();
use 5.008001;

# ABSTRACT: Platypus custom type for an object wrapped around an opaque pointer
our $VERSION = '0.03'; # VERSION


push @FFI::Platypus::CARP_NOT, __PACKAGE__;

sub ffi_custom_type_api_1
{
  my(undef, undef, $wrapper_class, $constructor) = @_;

  Carp::croak("no class specified") unless defined $wrapper_class;
  Carp::croak("illegal class name: $wrapper_class") unless $wrapper_class =~ /^[A-Z_][0-9A-Z_]*(::[A-Z_][0-9A-Z_]*)*$/i;

  $constructor ||= sub {
    defined $_[0] ? bless { ptr => $_[0] }, $wrapper_class : undef;
  };

  return {
    native_type    => 'opaque',
    perl_to_native => sub {
      Carp::croak("argument is not a $wrapper_class") unless is_blessed_hashref($_[0]) && $_[0]->isa($wrapper_class);
      my $ptr = $_[0]->{ptr};
      Carp::croak("pointer for $wrapper_class went away") unless defined $ptr;
      $ptr;
    },
    native_to_perl => $constructor,
  };
}

1;

__END__