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   182710 use strict;
  18         37  
  18         522  
4 18     18   81 use warnings;
  18         34  
  18         432  
5 18     18   306 use 5.008004;
  18         55  
6 18     18   652 use FFI::Platypus;
  18         44  
  18         529  
7 18     18   83 use Scalar::Util qw( refaddr);
  18         32  
  18         1052  
8 18     18   95 use Carp qw( croak );
  18         29  
  18         1819  
9             use overload '&{}' => sub {
10 4     4   1542 my $self = shift;
11 4     4   16 sub { $self->{code}->(@_) };
  4         13  
12 18     18   108 }, bool => sub { 1 }, fallback => 1;
  18     0   37  
  18         197  
  0         0  
13              
14             # ABSTRACT: Platypus closure object
15             our $VERSION = '2.07'; # VERSION
16              
17              
18             sub new
19             {
20 87     87 1 4654 my($class, $coderef) = @_;
21 87 50       223 croak "not a coderef" unless ref($coderef) eq 'CODE';
22 87         281 my $self = bless { code => $coderef, cbdata => {}, sticky => 0 }, $class;
23 87         464 $self;
24             }
25              
26             sub add_data
27             {
28 89     89 0 230 my($self, $payload, $type) = @_;
29 89         637 $self->{cbdata}{$type} = bless \$payload, 'FFI::Platypus::ClosureData';
30             }
31              
32             sub get_data
33             {
34 90     90 0 553 my($self, $type) = @_;
35              
36 90 100       664 if (exists $self->{cbdata}->{$type}) {
37 1         1 return ${$self->{cbdata}->{$type}};
  1         10  
38             }
39              
40 89         3874 return 0;
41             }
42              
43              
44             sub call
45             {
46 2     2 1 640 my $self = shift;
47 2         6 $self->{code}->(@_)
48             }
49              
50              
51             sub sticky
52             {
53 2     2 1 1354 my($self) = @_;
54 2 100       8 return if $self->{sticky};
55 1         2 $self->{sticky} = 1;
56 1         4 $self->_sticky;
57             }
58              
59              
60             sub unstick
61             {
62 1     1 1 597 my($self) = @_;
63 1 50       5 return unless $self->{sticky};
64 1         2 $self->{sticky} = 0;
65 1         5 $self->_unstick;
66             }
67              
68             package FFI::Platypus::ClosureData;
69              
70             our $VERSION = '2.07'; # VERSION
71              
72             1;
73              
74             __END__