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