1package FFI::Platypus::Function;
2
3use strict;
4use warnings;
5use 5.008004;
6use FFI::Platypus;
7
8# ABSTRACT: An FFI function object
9our $VERSION = '1.56'; # VERSION
10
11
12use overload '&{}' => sub {
13  my $ffi = shift;
14  sub { $ffi->call(@_) };
15}, 'bool' => sub {
16  my $ffi = shift;
17  return $ffi;
18}, fallback => 1;
19
20package FFI::Platypus::Function::Function;
21
22use parent qw( FFI::Platypus::Function );
23
24sub attach
25{
26  my($self, $perl_name, $proto) = @_;
27
28  my $frame = -1;
29  my($caller, $filename, $line);
30
31  do {
32    ($caller, $filename, $line) = caller(++$frame);
33  } while( $caller =~ /^FFI::Platypus(|::Function|::Function::Wrapper|::Declare)$/ );
34
35  $perl_name = join '::', $caller, $perl_name
36    unless $perl_name =~ /::/;
37
38  $self->_attach($perl_name, "$filename:$line", $proto);
39  $self;
40}
41
42sub sub_ref
43{
44  my($self) = @_;
45
46  my $frame = -1;
47  my($caller, $filename, $line);
48
49  do {
50    ($caller, $filename, $line) = caller(++$frame);
51  } while( $caller =~ /^FFI::Platypus(|::Function|::Function::Wrapper|::Declare)$/ );
52
53  $self->_sub_ref("$filename:$line");
54}
55
56package FFI::Platypus::Function::Wrapper;
57
58use parent qw( FFI::Platypus::Function );
59
60sub new
61{
62  my($class, $function, $wrapper) = @_;
63  bless [ $function, $wrapper ], $class;
64}
65
66sub call
67{
68  my($function, $wrapper) = @{ shift() };
69  @_ = ($function, @_);
70  goto &$wrapper;
71}
72
73sub attach
74{
75  my($self, $perl_name, $proto) = @_;
76  my($function, $wrapper) = @{ $self };
77
78  unless($perl_name =~ /::/)
79  {
80    my $caller;
81    my $frame = -1;
82    do { $caller = caller(++$frame) } while( $caller =~ /^FFI::Platypus(|::Declare)$/ );
83    $perl_name = join '::', $caller, $perl_name
84  }
85
86  my $xsub = $function->sub_ref;
87
88  {
89    my $code = sub {
90      unshift @_, $xsub;
91      goto &$wrapper;
92    };
93    if(defined $proto)
94    {
95      _set_prototype($proto, $code);
96    }
97    no strict 'refs';
98    *{$perl_name} = $code;
99  }
100
101  $self;
102}
103
104sub sub_ref
105{
106  my($self) = @_;
107  my($function, $wrapper) = @{ $self };
108  my $xsub = $function->sub_ref;
109
110  return sub {
111    unshift @_, $xsub;
112    goto &$wrapper;
113  };
114}
115
1161;
117
118__END__
119
120=pod
121
122=encoding UTF-8
123
124=head1 NAME
125
126FFI::Platypus::Function - An FFI function object
127
128=head1 VERSION
129
130version 1.56
131
132=head1 SYNOPSIS
133
134 use FFI::Platypus 1.00;
135
136 # call directly
137 my $ffi = FFI::Platypus->new( api => 1 );
138 my $f = $ffi->function(puts => ['string'] => 'int');
139 $f->call("hello there");
140
141 # attach as xsub and call (faster for repeated calls)
142 $f->attach('puts');
143 puts('hello there');
144
145=head1 DESCRIPTION
146
147This class represents an unattached platypus function.  For more
148context and better examples see L<FFI::Platypus>.
149
150=head1 METHODS
151
152=head2 attach
153
154 $f->attach($name);
155 $f->attach($name, $prototype);
156
157Attaches the function as an xsub (similar to calling attach directly
158from an L<FFI::Platypus> instance).  You may optionally include a
159prototype.
160
161=head2 call
162
163 my $ret = $f->call(@arguments);
164 my $ret = $f->(@arguments);
165
166Calls the function and returns the result. You can also use the
167function object B<like> a code reference.
168
169=head2 sub_ref
170
171 my $code = $f->sub_ref;
172
173Returns an anonymous code reference.  This will usually be faster
174than using the C<call> method above.
175
176=head1 AUTHOR
177
178Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
179
180Contributors:
181
182Bakkiaraj Murugesan (bakkiaraj)
183
184Dylan Cali (calid)
185
186pipcet
187
188Zaki Mughal (zmughal)
189
190Fitz Elliott (felliott)
191
192Vickenty Fesunov (vyf)
193
194Gregor Herrmann (gregoa)
195
196Shlomi Fish (shlomif)
197
198Damyan Ivanov
199
200Ilya Pavlov (Ilya33)
201
202Petr Písař (ppisar)
203
204Mohammad S Anwar (MANWAR)
205
206Håkon Hægland (hakonhagland, HAKONH)
207
208Meredith (merrilymeredith, MHOWARD)
209
210Diab Jerius (DJERIUS)
211
212Eric Brine (IKEGAMI)
213
214szTheory
215
216José Joaquín Atria (JJATRIA)
217
218Pete Houston (openstrike, HOUSTON)
219
220=head1 COPYRIGHT AND LICENSE
221
222This software is copyright (c) 2015,2016,2017,2018,2019,2020 by Graham Ollis.
223
224This is free software; you can redistribute it and/or modify it under
225the same terms as the Perl 5 programming language system itself.
226
227=cut
228