1package FFI::Platypus::Type::StringPointer;
2
3use strict;
4use warnings;
5use 5.008004;
6use FFI::Platypus;
7use Scalar::Util qw( readonly );
8
9# ABSTRACT: Convert a pointer to a string and back
10our $VERSION = '1.56'; # VERSION
11
12
13use constant _incantation =>
14  $^O eq 'MSWin32' && do { require Config; $Config::Config{archname} =~ /MSWin32-x64/ }
15  ? 'Q'
16  : 'L!';
17use constant _pointer_buffer => "P" . FFI::Platypus->new( api => 1 )->sizeof('opaque');
18
19my @stack;
20
21sub perl_to_native
22{
23  if(defined $_[0])
24  {
25    my $packed = pack 'P', ${$_[0]};
26    my $pointer_pointer = pack 'P', $packed;
27    my $unpacked = unpack _incantation, $pointer_pointer;
28    push @stack, [ \$packed, \$pointer_pointer ];
29    return $unpacked;
30  }
31  else
32  {
33    push @stack, [];
34    return undef;
35  }
36}
37
38sub perl_to_native_post
39{
40  my($packed) = @{ pop @stack };
41  return unless defined $packed;
42  unless(readonly(${$_[0]}))
43  {
44    ${$_[0]} = unpack 'p', $$packed;
45  }
46}
47
48sub native_to_perl
49{
50  return unless defined $_[0];
51  my $pointer_pointer = unpack(_incantation, unpack(_pointer_buffer, pack(_incantation, $_[0])));
52  $pointer_pointer ? \unpack('p', pack(_incantation, $pointer_pointer)) : \undef;
53}
54
55sub ffi_custom_type_api_1
56{
57  return {
58    native_type         => 'opaque',
59    perl_to_native      => \&perl_to_native,
60    perl_to_native_post => \&perl_to_native_post,
61    native_to_perl      => \&native_to_perl,
62  }
63}
64
651;
66
67__END__
68
69=pod
70
71=encoding UTF-8
72
73=head1 NAME
74
75FFI::Platypus::Type::StringPointer - Convert a pointer to a string and back
76
77=head1 VERSION
78
79version 1.56
80
81=head1 SYNOPSIS
82
83In your C code:
84
85 void
86 string_pointer_argument(const char **string)
87 {
88   ...
89 }
90 const char **
91 string_pointer_return(void)
92 {
93   ...
94 }
95
96In your Platypus::FFI code:
97
98 use FFI::Platypus;
99
100 my $ffi = FFI::Platypus->new( api => 1 );
101 $ffi->load_custom_type('::StringPointer' => 'string_pointer');
102
103 $ffi->attach(string_pointer_argument => ['string_pointer'] => 'void');
104 $ffi->attach(string_pointer_return   => [] => 'string_pointer');
105
106 my $string = "foo";
107
108 string_pointer_argument(\$string); # $string may be modified
109
110 $ref = string_pointer_return();
111
112 print $$ref;  # print the string pointed to by $ref
113
114=head1 DESCRIPTION
115
116B<NOTE>: As of version 0.61, this custom type is now deprecated since
117pointers to strings are supported in the L<FFI::Platypus> directly
118without custom types.
119
120This module provides a L<FFI::Platypus> custom type for pointers to
121strings.
122
123=head1 SEE ALSO
124
125=over 4
126
127=item L<FFI::Platypus>
128
129Main Platypus documentation.
130
131=item L<FFI::Platypus::Type>
132
133Platypus types documentation.
134
135=back
136
137=head1 AUTHOR
138
139Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
140
141Contributors:
142
143Bakkiaraj Murugesan (bakkiaraj)
144
145Dylan Cali (calid)
146
147pipcet
148
149Zaki Mughal (zmughal)
150
151Fitz Elliott (felliott)
152
153Vickenty Fesunov (vyf)
154
155Gregor Herrmann (gregoa)
156
157Shlomi Fish (shlomif)
158
159Damyan Ivanov
160
161Ilya Pavlov (Ilya33)
162
163Petr Písař (ppisar)
164
165Mohammad S Anwar (MANWAR)
166
167Håkon Hægland (hakonhagland, HAKONH)
168
169Meredith (merrilymeredith, MHOWARD)
170
171Diab Jerius (DJERIUS)
172
173Eric Brine (IKEGAMI)
174
175szTheory
176
177José Joaquín Atria (JJATRIA)
178
179Pete Houston (openstrike, HOUSTON)
180
181=head1 COPYRIGHT AND LICENSE
182
183This software is copyright (c) 2015,2016,2017,2018,2019,2020 by Graham Ollis.
184
185This is free software; you can redistribute it and/or modify it under
186the same terms as the Perl 5 programming language system itself.
187
188=cut
189