File Coverage

blib/lib/FFI/Platypus/Closure.pm
Criterion Covered Total %
statement 44 45 97.7
branch 6 8 75.0
condition n/a
subroutine 15 16 93.7
pod 4 6 66.6
total 69 75 92.0


line stmt bran cond sub pod time code
1             package FFI::Platypus::Closure;
2              
3 18     18   230895 use strict;
  18         49  
  18         592  
4 18     18   96 use warnings;
  18         48  
  18         489  
5 18     18   337 use 5.008004;
  18         68  
6 18     18   820 use FFI::Platypus;
  18         46  
  18         607  
7 18     18   111 use Scalar::Util qw( refaddr);
  18         43  
  18         1192  
8 18     18   126 use Carp qw( croak );
  18         50  
  18         2261  
9             use overload '&{}' => sub {
10 4     4   1910 my $self = shift;
11 4     4   26 sub { $self->{code}->(@_) };
  4         19  
12 18     18   140 }, bool => sub { 1 }, fallback => 1;
  18     0   49  
  18         234  
  0         0  
13              
14             # ABSTRACT: Platypus closure object
15             our $VERSION = '2.08'; # VERSION
16              
17              
18             sub new
19             {
20 87     87 1 5608 my($class, $coderef) = @_;
21 87 50       293 croak "not a coderef" unless ref($coderef) eq 'CODE';
22 87         302 my $self = bless { code => $coderef, cbdata => {}, sticky => 0 }, $class;
23 87         608 $self;
24             }
25              
26             sub add_data
27             {
28 89     89 0 244 my($self, $payload, $type) = @_;
29 89         761 $self->{cbdata}{$type} = bless \$payload, 'FFI::Platypus::ClosureData';
30             }
31              
32             sub get_data
33             {
34 90     90 0 734 my($self, $type) = @_;
35              
36 90 100       813 if (exists $self->{cbdata}->{$type}) {
37 1         2 return ${$self->{cbdata}->{$type}};
  1         12  
38             }
39              
40 89         5095 return 0;
41             }
42              
43              
44             sub call
45             {
46 2     2 1 763 my $self = shift;
47 2         8 $self->{code}->(@_)
48             }
49              
50              
51             sub sticky
52             {
53 2     2 1 1692 my($self) = @_;
54 2 100       9 return if $self->{sticky};
55 1         3 $self->{sticky} = 1;
56 1         6 $self->_sticky;
57             }
58              
59              
60             sub unstick
61             {
62 1     1 1 764 my($self) = @_;
63 1 50       6 return unless $self->{sticky};
64 1         4 $self->{sticky} = 0;
65 1         6 $self->_unstick;
66             }
67              
68             package FFI::Platypus::ClosureData;
69              
70             our $VERSION = '2.08'; # VERSION
71              
72             1;
73              
74             __END__