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   8 use strict;
  1         2  
  1         40  
4 1     1   4 use warnings;
  1         3  
  1         49  
5 1     1   16 use 5.008004;
  1         4  
6 1     1   6 use FFI::Platypus;
  1         2  
  1         38  
7 1         576 use FFI::Platypus::API qw(
8             arguments_set_pointer
9             arguments_set_uint32
10             arguments_set_uint64
11 1     1   511 );
  1         4  
12 1     1   627 use FFI::Platypus::Buffer qw( scalar_to_buffer );
  1         4  
  1         75  
13 1     1   6 use FFI::Platypus::Buffer qw( buffer_to_scalar );
  1         2  
  1         280  
14              
15             # ABSTRACT: Convert string scalar to a buffer as a pointer / size_t combination
16             our $VERSION = '2.11'; # 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 85 my($pointer, $size) = scalar_to_buffer($_[0]);
29 6         15 push @stack, [ $pointer, $size ];
30 6         33 arguments_set_pointer $_[1], $pointer;
31 6         36 arguments_set_size_t($_[1]+1, $size);
32             }
33              
34             sub perl_to_native_post
35             {
36 6     6 0 12 my($pointer, $size) = @{ pop @stack };
  6         17  
37 6         19 $_[0] = buffer_to_scalar($pointer, $size);
38             }
39              
40             sub ffi_custom_type_api_1
41             {
42             {
43 2     2 0 11 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__