File Coverage

blib/lib/AnyEvent/XSPromises/Loader.pm
Criterion Covered Total %
statement 21 22 95.4
branch 3 6 50.0
condition n/a
subroutine 7 7 100.0
pod n/a
total 31 35 88.5


line stmt bran cond sub pod time code
1             package AnyEvent::XSPromises::Loader;
2 2     2   32 use 5.010;
  2         7  
3 2     2   10 use strict;
  2         4  
  2         36  
4 2     2   10 use warnings;
  2         4  
  2         73  
5              
6             our $VERSION = '0.004';
7              
8 2     2   9 use AnyEvent;
  2         4  
  2         428  
9              
10             require XSLoader;
11             XSLoader::load('AnyEvent::XSPromises', $VERSION);
12              
13             AnyEvent::XSPromises::___set_conversion_helper(sub {
14             my $promise= shift;
15             my $deferred= AnyEvent::XSPromises::deferred();
16             my $called;
17             eval {
18             $promise->then(sub {
19             return if $called++;
20             $deferred->resolve(@_);
21             }, sub {
22             return if $called++;
23             $deferred->reject(@_);
24             });
25             1;
26             } or do {
27             my $error= $@;
28             if (!$called++) {
29             $deferred->reject($error);
30             }
31             };
32             return $deferred->promise;
33             });
34              
35             # We do not use AE::postpone, because it sets a timer of 0 seconds. While that sounds great in
36             # theory, the underlying libraries (eg. epoll, used by EV) don't support 0 second timers, and
37             # so they get passed 1ms instead. To avoid actually waiting a millisecond every time, we write
38             # data onto a socket read by the event loop. Of course, these sockets need to be carefully managed
39             # in case the code does a fork, so we need to frequently check $$.
40             my ($AE_PID, $AE_WATCH, $PIPE_IN, $PIPE_OUT);
41 2     2   499 BEGIN { $AE_PID= -1; }
42              
43             sub ___notify_callback {
44 5 50   5   1658 if ($$ != $AE_PID) {
45 0         0 ___reset_pipe();
46             } else {
47 5         87 sysread $PIPE_IN, my $read_buf, 16;
48             }
49              
50             # sort makes perl push a pseudo-block on the stack that prevents callback code from using
51             # next/last/redo. Without it, an accidental invocation of one of those could cause serious
52             # problems. We have to assign it to @useless_variable or Perl thinks our code is a no-op
53             # and optimizes it away.
54 5         53 my @useless_variable= sort { AnyEvent::XSPromises::___flush(); 0 } 1, 2;
  5         60  
55             }
56              
57             sub ___reset_pipe {
58 2 50   2   8 close $PIPE_IN if $PIPE_IN;
59 2 50       7 close $PIPE_OUT if $PIPE_OUT;
60 2         92 pipe($PIPE_IN, $PIPE_OUT);
61 2         21 $AE_WATCH= AE::io($PIPE_IN, 0, \&___notify_callback);
62 2         8 $AE_PID= $$;
63             }
64              
65             AnyEvent::XSPromises::___set_backend(sub {
66             ___reset_pipe() if $$ != $AE_PID;
67             syswrite $PIPE_OUT, "\0";
68             });
69              
70             1;