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