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