File Coverage

blib/lib/FFI/Platypus/Type/PointerSizeBuffer.pm
Criterion Covered Total %
statement 28 28 100.0
branch n/a
condition n/a
subroutine 10 10 100.0
pod 0 3 0.0
total 38 41 92.6


line stmt bran cond sub pod time code
1             package FFI::Platypus::Type::PointerSizeBuffer;
2              
3 1     1   6 use strict;
  1         1  
  1         25  
4 1     1   5 use warnings;
  1         1  
  1         19  
5 1     1   13 use 5.008004;
  1         3  
6 1     1   5 use FFI::Platypus;
  1         1  
  1         22  
7 1         61 use FFI::Platypus::API qw(
8             arguments_set_pointer
9             arguments_set_uint32
10             arguments_set_uint64
11 1     1   325 );
  1         2  
12 1     1   335 use FFI::Platypus::Buffer qw( scalar_to_buffer );
  1         2  
  1         45  
13 1     1   6 use FFI::Platypus::Buffer qw( buffer_to_scalar );
  1         2  
  1         203  
14              
15             # ABSTRACT: Convert string scalar to a buffer as a pointer / size_t combination
16             our $VERSION = '2.07'; # VERSION
17              
18              
19             my @stack;
20              
21             *arguments_set_size_t
22             = FFI::Platypus->new( api => 2 )->sizeof('size_t') == 4
23             ? \&arguments_set_uint32
24             : \&arguments_set_uint64;
25              
26             sub perl_to_native
27             {
28 6     6 0 69 my($pointer, $size) = scalar_to_buffer($_[0]);
29 6         11 push @stack, [ $pointer, $size ];
30 6         23 arguments_set_pointer $_[1], $pointer;
31 6         27 arguments_set_size_t($_[1]+1, $size);
32             }
33              
34             sub perl_to_native_post
35             {
36 6     6 0 8 my($pointer, $size) = @{ pop @stack };
  6         11  
37 6         14 $_[0] = buffer_to_scalar($pointer, $size);
38             }
39              
40             sub ffi_custom_type_api_1
41             {
42             {
43 2     2 0 8 native_type => 'opaque',
44             perl_to_native => \&perl_to_native,
45             perl_to_native_post => \&perl_to_native_post,
46             argument_count => 2,
47             }
48             }
49              
50             1;
51              
52             __END__