1package FFI::Platypus::Closure; 2 3use strict; 4use warnings; 5use 5.008004; 6use FFI::Platypus; 7use Scalar::Util qw( refaddr); 8use Carp qw( croak ); 9use overload '&{}' => sub { 10 my $self = shift; 11 sub { $self->{code}->(@_) }; 12}, bool => sub { 1 }, fallback => 1; 13 14# ABSTRACT: Platypus closure object 15our $VERSION = '1.56'; # VERSION 16 17 18sub new 19{ 20 my($class, $coderef) = @_; 21 croak "not a coderef" unless ref($coderef) eq 'CODE'; 22 my $self = bless { code => $coderef, cbdata => {}, sticky => 0 }, $class; 23 $self; 24} 25 26sub add_data 27{ 28 my($self, $payload, $type) = @_; 29 $self->{cbdata}{$type} = bless \$payload, 'FFI::Platypus::ClosureData'; 30} 31 32sub get_data 33{ 34 my($self, $type) = @_; 35 36 if (exists $self->{cbdata}->{$type}) { 37 return ${$self->{cbdata}->{$type}}; 38 } 39 40 return 0; 41} 42 43 44sub call 45{ 46 my $self = shift; 47 $self->{code}->(@_) 48} 49 50 51sub sticky 52{ 53 my($self) = @_; 54 return if $self->{sticky}; 55 $self->{sticky} = 1; 56 $self->_sticky; 57} 58 59 60sub unstick 61{ 62 my($self) = @_; 63 return unless $self->{sticky}; 64 $self->{sticky} = 0; 65 $self->_unstick; 66} 67 68package FFI::Platypus::ClosureData; 69 70our $VERSION = '1.56'; # VERSION 71 721; 73 74__END__ 75 76=pod 77 78=encoding UTF-8 79 80=head1 NAME 81 82FFI::Platypus::Closure - Platypus closure object 83 84=head1 VERSION 85 86version 1.56 87 88=head1 SYNOPSIS 89 90create closure with OO interface 91 92 use FFI::Platypus::Closure; 93 my $closure = FFI::Platypus::Closure->new(sub { print "hello world\n" }); 94 95create closure from Platypus object 96 97 use FFI::Platypus 1.00; 98 my $ffi = FFI::Platypus->new( api => 1 ); 99 my $closure = $ffi->closure(sub { print "hello world\n" }); 100 101use closure 102 103 $ffi->function(foo => ['()->void'] => 'void')->call($closure); 104 105=head1 DESCRIPTION 106 107This class represents a Perl code reference that can be called from compiled code. 108When you create a closure object, you can pass it into any function that expects 109a function pointer. Care needs to be taken with closures because compiled languages 110typically have a different way of handling lifetimes of objects. You have to make 111sure that if the compiled code is going to call a closure that the closure object 112is still in scope somewhere, or has been made sticky, otherwise you may get a 113segment violation or other mysterious crash. 114 115=head1 CONSTRUCTOR 116 117=head2 new 118 119 my $closure = FFI::Platypus::Closure->new($coderef); 120 121Create a new closure object; C<$coderef> must be a subroutine code reference. 122 123=head1 METHODS 124 125=head2 call 126 127 $closure->call(@arguments); 128 $closure->(@arguments); 129 130Call the closure from Perl space. May also be invoked by treating 131the closure object as a code reference. 132 133=head2 sticky 134 135 $closure->sticky; 136 137Mark the closure sticky, meaning that it won't be free'd even if 138all the reference of the object fall out of scope. 139 140=head2 unstick 141 142 $closure->unstick; 143 144Unmark the closure as sticky. 145 146=head1 AUTHOR 147 148Author: Graham Ollis E<lt>plicease@cpan.orgE<gt> 149 150Contributors: 151 152Bakkiaraj Murugesan (bakkiaraj) 153 154Dylan Cali (calid) 155 156pipcet 157 158Zaki Mughal (zmughal) 159 160Fitz Elliott (felliott) 161 162Vickenty Fesunov (vyf) 163 164Gregor Herrmann (gregoa) 165 166Shlomi Fish (shlomif) 167 168Damyan Ivanov 169 170Ilya Pavlov (Ilya33) 171 172Petr Písař (ppisar) 173 174Mohammad S Anwar (MANWAR) 175 176Håkon Hægland (hakonhagland, HAKONH) 177 178Meredith (merrilymeredith, MHOWARD) 179 180Diab Jerius (DJERIUS) 181 182Eric Brine (IKEGAMI) 183 184szTheory 185 186José Joaquín Atria (JJATRIA) 187 188Pete Houston (openstrike, HOUSTON) 189 190=head1 COPYRIGHT AND LICENSE 191 192This software is copyright (c) 2015,2016,2017,2018,2019,2020 by Graham Ollis. 193 194This is free software; you can redistribute it and/or modify it under 195the same terms as the Perl 5 programming language system itself. 196 197=cut 198