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