ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/cvsroot/AnyEvent-Fork-RPC/RPC/Sync.pm
Revision: 1.20
Committed: Thu Sep 12 15:15:49 2019 UTC (7 years ago) by root
Branch: MAIN
Changes since 1.19: +10 -2 lines
Log Message:
*** empty log message ***

File Contents

# Content
1 package AnyEvent::Fork::RPC::Sync;
2
3 use common::sense; # actually required to avoid spurious warnings...
4
5 our $VERSION = 2; # protocol version
6
7 # declare only
8 sub AnyEvent::Fork::RPC::event;
9
10 sub do_exit { exit } # workaround for perl 5.14 and below
11
12 # the goal here is to keep this simple, small and efficient
13 sub run {
14 my %kv = splice @_, pop;
15
16 my $rfh = shift;
17 my $wfh = fileno $rfh ? $rfh : *STDOUT;
18
19 my $function = delete $kv{function};
20 my $serialiser = delete $kv{serialiser};
21 my $rlen = delete $kv{rlen};
22
23 $0 =~ s/^(\d+).*$/$1 $function/s;
24
25 {
26 package main;
27 my $init = delete $kv{init};
28 &$init if length $init;
29 $function = \&$function; # resolve function early for extra speed
30 }
31
32 my ($f, $t) = eval $serialiser; die $@ if $@;
33
34 my $write = sub {
35 my $got = syswrite $wfh, $_[0];
36
37 while ($got < length $_[0]) {
38 my $len = syswrite $wfh, $_[0], 1<<30, $got;
39
40 defined $len
41 or die "AnyEvent::Fork::RPC::Sync: write error ($!), parent gone?";
42
43 $got += $len;
44 }
45 };
46
47 *AnyEvent::Fork::RPC::event = sub {
48 $write->(pack "NN/a*", 0, &$f);
49 };
50
51 my $rbuf;
52
53 while (sysread $rfh, $rbuf, $rlen - length $rbuf, length $rbuf) {
54 $rlen = $rlen * 2 + 16 if $rlen - 128 < length $rbuf;
55
56 while () {
57 last if 4 > length $rbuf;
58 my $len = unpack "N", $rbuf;
59 last if 4 + $len > length $rbuf;
60
61 $write->(pack "NN/a*", 1, $f->($function->($t->(substr $rbuf, 4, $len))));
62
63 substr $rbuf, 0, 4 + $len, "";
64 }
65 }
66
67 shutdown $wfh, 1;
68 exit; # work around broken win32 perls
69 }
70
71 1
72