1package FFI::Platypus::Type::StringArray; 2 3use strict; 4use warnings; 5use 5.008004; 6use FFI::Platypus; 7 8# ABSTRACT: Platypus custom type for arrays of strings 9our $VERSION = '1.56'; # VERSION 10 11 12use constant _incantation => 13 $^O eq 'MSWin32' && do { require Config; $Config::Config{archname} =~ /MSWin32-x64/ } 14 ? 'Q' 15 : 'L!'; 16use constant _size_of_pointer => FFI::Platypus->new( api => 1 )->sizeof('opaque'); 17use constant _pointer_buffer => "P" . _size_of_pointer; 18 19my @stack; 20 21sub perl_to_native 22{ 23 # this is the variable length version 24 # and is actually simpler than the 25 # fixed length version 26 my $count = scalar @{ $_[0] }; 27 my $pointers = pack(('P' x $count)._incantation, @{ $_[0] }, 0); 28 my $array_pointer = unpack _incantation, pack 'P', $pointers; 29 push @stack, [ \$_[0], \$pointers ]; 30 $array_pointer; 31} 32 33sub perl_to_native_post 34{ 35 pop @stack; 36 (); 37} 38 39sub native_to_perl 40{ 41 return unless defined $_[0]; 42 my @list; 43 my $i=0; 44 while(1) 45 { 46 my $pointer_pointer = unpack( 47 _incantation, 48 unpack( 49 _pointer_buffer, 50 pack( 51 _incantation, $_[0]+_size_of_pointer*$i 52 ) 53 ) 54 ); 55 last unless $pointer_pointer; 56 push @list, unpack('p', pack(_incantation, $pointer_pointer)); 57 $i++; 58 } 59 \@list; 60} 61 62sub ffi_custom_type_api_1 63{ 64 # arg0 = class 65 # arg1 = FFI::Platypus instance 66 # arg2 = array size 67 # arg3 = default value 68 my(undef, undef, $count, $default) = @_; 69 70 my $config = { 71 native_type => 'opaque', 72 perl_to_native => \&perl_to_native, 73 perl_to_native_post => \&perl_to_native_post, 74 native_to_perl => \&native_to_perl, 75 }; 76 77 if(defined $count) 78 { 79 my $end = $count-1; 80 81 $config->{perl_to_native} = sub { 82 my $incantation = ''; 83 84 my @list = ((map { 85 defined $_ 86 ? do { $incantation .= 'P'; $_ } 87 : defined $default 88 ? do { $incantation .= 'P'; $default } 89 : do { $incantation .= _incantation; 0 }; 90 } @{ $_[0] }[0..$end]), 0); 91 92 $incantation .= _incantation; 93 94 my $pointers = pack $incantation, @list; 95 my $array_pointer = unpack _incantation, pack 'P', $pointers; 96 push @stack, [ \@list, $pointers ]; 97 $array_pointer; 98 }; 99 100 my $pointer_buffer = "P@{[ FFI::Platypus->new( api => 1 )->sizeof('opaque') * $count ]}"; 101 my $incantation_count = _incantation.$count; 102 103 $config->{native_to_perl} = sub { 104 return unless defined $_[0]; 105 my @pointer_pointer = unpack($incantation_count, unpack($pointer_buffer, pack(_incantation, $_[0]))); 106 [map { $_ ? unpack('p', pack(_incantation, $_)) : $default } @pointer_pointer]; 107 }; 108 109 } 110 111 $config; 112} 113 1141; 115 116__END__ 117 118=pod 119 120=encoding UTF-8 121 122=head1 NAME 123 124FFI::Platypus::Type::StringArray - Platypus custom type for arrays of strings 125 126=head1 VERSION 127 128version 1.56 129 130=head1 SYNOPSIS 131 132In your C code: 133 134 void 135 takes_string_array(const char **array) 136 { 137 ... 138 } 139 140 void 141 takes_fixed_string_array(const char *array[5]) 142 { 143 ... 144 } 145 146In your L<Platypus::FFI> code: 147 148 use FFI::Platypus; 149 150 my $ffi = FFI::Platypus->new( api => 1 ); 151 $ffi->load_custom_type('::StringArray' => 'string_array'); 152 $ffi->load_custom_type('::StringArray' => 'string_5' => 5); 153 154 $ffi->attach(takes_string_array => ['string_array'] => 'void'); 155 $ffi->attach(takes_fixed_string_array => ['string_5'] => 'void'); 156 157 my @list = qw( foo bar baz ); 158 159 takes_string_array(\@list); 160 takes_fixed_string_array([qw( s1 s2 s3 s4 s5 )]); 161 162=head1 DESCRIPTION 163 164B<NOTE>: The primary motivation for this custom type was originally to 165fill the void left by the fact that L<FFI::Platypus> did not support arrays 166of strings by itself. Since 0.62 this support has been added, and that is 167probably what you want to use, but the semantics and feature set are 168slightly different, so there are cases where you might want to use this 169custom type. 170 171This module provides a L<FFI::Platypus> custom type for arrays of 172strings. The array is always NULL terminated. Return types are supported! 173 174This custom type takes two optional arguments. The first is the size of 175arrays and the second is a default value to fill in any values that 176aren't provided when the function is called. If not default is provided 177then C<NULL> will be passed in for those values. 178 179=head1 SUPPORT 180 181If something does not work the way you think it should, or if you have a 182feature request, please open an issue on this project's GitHub Issue 183tracker: 184 185L<https://github.com/plicease/FFI-Platypus-Type-StringArray/issues> 186 187=head1 CONTRIBUTING 188 189If you have implemented a new feature or fixed a bug then you may make a 190pull request on this project's GitHub repository: 191 192L<https://github.com/plicease/FFI-Platypus-Type-StringArray/pulls> 193 194This project's GitHub issue tracker listed above is not Write-Only. If 195you want to contribute then feel free to browse through the existing 196issues and see if there is something you feel you might be good at and 197take a whack at the problem. I frequently open issues myself that I 198hope will be accomplished by someone in the future but do not have time 199to immediately implement myself. 200 201Another good area to help out in is documentation. I try to make sure 202that there is good document coverage, that is there should be 203documentation describing all the public features and warnings about 204common pitfalls, but an outsider's or alternate view point on such 205things would be welcome; if you see something confusing or lacks 206sufficient detail I encourage documentation only pull requests to 207improve things. 208 209=head1 SEE ALSO 210 211=over 4 212 213=item L<FFI::Platypus> 214 215=item L<FFI::Platypus::Type::StringPointer> 216 217=back 218 219=head1 AUTHOR 220 221Author: Graham Ollis E<lt>plicease@cpan.orgE<gt> 222 223Contributors: 224 225Bakkiaraj Murugesan (bakkiaraj) 226 227Dylan Cali (calid) 228 229pipcet 230 231Zaki Mughal (zmughal) 232 233Fitz Elliott (felliott) 234 235Vickenty Fesunov (vyf) 236 237Gregor Herrmann (gregoa) 238 239Shlomi Fish (shlomif) 240 241Damyan Ivanov 242 243Ilya Pavlov (Ilya33) 244 245Petr Písař (ppisar) 246 247Mohammad S Anwar (MANWAR) 248 249Håkon Hægland (hakonhagland, HAKONH) 250 251Meredith (merrilymeredith, MHOWARD) 252 253Diab Jerius (DJERIUS) 254 255Eric Brine (IKEGAMI) 256 257szTheory 258 259José Joaquín Atria (JJATRIA) 260 261Pete Houston (openstrike, HOUSTON) 262 263=head1 COPYRIGHT AND LICENSE 264 265This software is copyright (c) 2015,2016,2017,2018,2019,2020 by Graham Ollis. 266 267This is free software; you can redistribute it and/or modify it under 268the same terms as the Perl 5 programming language system itself. 269 270=cut 271