1 |
package AnyEvent::Fork::RPC::Async; |
2 |
|
3 |
use common::sense; # actually required to avoid spurious warnings... |
4 |
|
5 |
use Errno (); |
6 |
|
7 |
use AnyEvent; |
8 |
|
9 |
# declare only |
10 |
sub AnyEvent::Fork::RPC::event; |
11 |
|
12 |
sub do_exit { exit } # workaround for perl 5.14 and below |
13 |
|
14 |
sub run { |
15 |
my ($function, $init, $serialiser, $done) = splice @_, -4, 4; |
16 |
my $rfh = shift; |
17 |
my $wfh = fileno $rfh ? $rfh : *STDOUT; |
18 |
|
19 |
$0 =~ s/^AnyEvent::Fork::RPC::Async::run of /$function of /; |
20 |
|
21 |
{ |
22 |
package main; |
23 |
&$init if length $init; |
24 |
$function = \&$function; # resolve function early for extra speed |
25 |
} |
26 |
|
27 |
my $busy = 1; # exit when == 0 |
28 |
|
29 |
my ($f, $t) = eval $serialiser; AE::log fatal => $@ if $@; |
30 |
my ($wbuf, $ww); |
31 |
|
32 |
my $wcb = sub { |
33 |
my $len = syswrite $wfh, $wbuf; |
34 |
|
35 |
unless (defined $len) { |
36 |
if ($! != Errno::EAGAIN && $! != Errno::EWOULDBLOCK) { |
37 |
undef $ww; |
38 |
AE::log fatal => "AnyEvent::Fork::RPC: write error ($!), parent gone?"; |
39 |
} |
40 |
} |
41 |
|
42 |
substr $wbuf, 0, $len, ""; |
43 |
|
44 |
unless (length $wbuf) { |
45 |
undef $ww; |
46 |
unless ($busy) { |
47 |
shutdown $wfh, 1; |
48 |
@_ = (); goto &$done; |
49 |
} |
50 |
} |
51 |
}; |
52 |
|
53 |
my $write = sub { |
54 |
$wbuf .= $_[0]; |
55 |
$ww ||= AE::io $wfh, 1, $wcb; |
56 |
}; |
57 |
|
58 |
*AnyEvent::Fork::RPC::event = sub { |
59 |
$write->(pack "NN/a*", 0, &$f); |
60 |
}; |
61 |
|
62 |
my ($rlen, $rbuf, $rw) = 512 - 16; |
63 |
|
64 |
my $len; |
65 |
|
66 |
$rw = AE::io $rfh, 0, sub { |
67 |
$rlen = $rlen * 2 + 16 if $rlen - 128 < length $rbuf; |
68 |
$len = sysread $rfh, $rbuf, $rlen - length $rbuf, length $rbuf; |
69 |
|
70 |
if ($len) { |
71 |
while (8 <= length $rbuf) { |
72 |
(my $id, $len) = unpack "NN", $rbuf; |
73 |
8 + $len <= length $rbuf |
74 |
or last; |
75 |
|
76 |
my @r = $t->(substr $rbuf, 8, $len); |
77 |
substr $rbuf, 0, 8 + $len, ""; |
78 |
|
79 |
++$busy; |
80 |
$function->(sub { |
81 |
--$busy; |
82 |
$write->(pack "NN/a*", $id, &$f); |
83 |
}, @r); |
84 |
} |
85 |
} elsif (defined $len or $! == Errno::EINVAL) { # EINVAL is for microshit windoze |
86 |
undef $rw; |
87 |
--$busy; |
88 |
$ww ||= AE::io $wfh, 1, $wcb; |
89 |
} elsif ($! != Errno::EAGAIN && $! != Errno::EWOULDBLOCK) { |
90 |
undef $rw; |
91 |
AE::log fatal => "AnyEvent::Fork::RPC: read error in child: $!"; |
92 |
} |
93 |
}; |
94 |
|
95 |
$AnyEvent::MODEL eq "EV" |
96 |
? EV::run () |
97 |
: AE::cv->recv; |
98 |
} |
99 |
|
100 |
1 |
101 |
|