ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/AnyEvent-MP/MP/Node.pm
Revision: 1.67
Committed: Sun Aug 28 08:23:34 2016 UTC (7 years, 10 months ago) by root
Branch: MAIN
Changes since 1.66: +0 -1 lines
Log Message:
*** empty log message ***

File Contents

# User Rev Content
1 root 1.1 =head1 NAME
2    
3 root 1.31 AnyEvent::MP::Node - represent a node
4 root 1.1
5     =head1 SYNOPSIS
6    
7     use AnyEvent::MP::Node;
8    
9     =head1 DESCRIPTION
10    
11 root 1.31 This is an internal utility module, horrible to look at, so don't.
12    
13 root 1.1 =cut
14    
15 root 1.64 package AnyEvent::MP::Node; # base class for nodes
16 root 1.1
17     use common::sense;
18    
19 root 1.63 use AnyEvent ();
20 root 1.1 use AnyEvent::Socket ();
21    
22     use AnyEvent::MP::Transport ();
23    
24     sub new {
25 root 1.28 my ($self, $id) = @_;
26 root 1.1
27 root 1.28 $self = bless { id => $id }, $self;
28 root 1.1
29 root 1.66 # register
30     $AnyEvent::MP::Kernel::NODE{$id} = $self;
31    
32 root 1.27 $self->init;
33 root 1.18 $self->transport_reset;
34 root 1.1
35 root 1.18 $self
36     }
37 root 1.1
38 root 1.66 sub DESTROY {
39     # unregister
40     delete $AnyEvent::MP::Kernel::NODE{$_[0]{id}};
41     }
42    
43 root 1.27 sub init {
44     #
45     }
46    
47 root 1.1 sub send {
48 root 1.19 &{ shift->{send} }
49 root 1.1 }
50    
51 root 1.27 # nodes reachable via the network
52 root 1.64 package AnyEvent::MP::Node::Remote; # a remote node
53 root 1.7
54 root 1.18 use base "AnyEvent::MP::Node";
55 root 1.7
56 root 1.18 # called at init time, mostly sets {send}
57     sub transport_reset {
58     my ($self) = @_;
59 root 1.6
60 root 1.18 delete $self->{transport};
61 root 1.6
62 root 1.19 Scalar::Util::weaken $self;
63    
64 root 1.18 $self->{send} = sub {
65 root 1.19 push @{$self->{queue}}, shift;
66     $self->connect;
67 root 1.18 };
68 root 1.6 }
69    
70 root 1.32 # called each time we fail to establish a connection,
71     # or the existing connection failed
72 root 1.18 sub transport_error {
73     my ($self, @reason) = @_;
74 root 1.6
75 root 1.21 my $no_transport = !$self->{transport};
76    
77     delete $self->{connect_w};
78     delete $self->{connect_to};
79 root 1.20
80 root 1.18 delete $self->{queue};
81     $self->transport_reset;
82 root 1.6
83 root 1.18 if (my $mon = delete $self->{lmon}) {
84     $_->(@reason) for map @$_, values %$mon;
85 root 1.6 }
86 root 1.30
87     AnyEvent::MP::Kernel::_inject_nodeevent ($self, 0, @reason)
88     unless $no_transport;
89 root 1.32
90 root 1.66 # we weaken the node reference, so it can go away if unused
91     Scalar::Util::weaken $AnyEvent::MP::Kernel::NODE{$self->{id}}
92     unless $self->{connect_to};
93    
94     AE::log 9 => "@reason";
95 root 1.6 }
96    
97 root 1.18 # called after handshake was successful
98     sub transport_connect {
99 root 1.1 my ($self, $transport) = @_;
100    
101 root 1.28 delete $self->{trial};
102    
103 root 1.51 $self->transport_error (transport_error => $self->{id}, "switched connections")
104 root 1.6 if $self->{transport};
105    
106 root 1.18 delete $self->{connect_w};
107     delete $self->{connect_to};
108 root 1.8
109 root 1.15 $self->{transport} = $transport;
110 root 1.1
111 root 1.52 my $transport_send = $transport->{send};
112 root 1.19
113 root 1.46 AnyEvent::MP::Kernel::_inject_nodeevent ($self, 1);
114    
115 root 1.52 $self->{send} = $transport_send;
116 root 1.18
117 root 1.52 $transport_send->($_)
118 root 1.1 for @{ delete $self->{queue} || [] };
119     }
120    
121 root 1.18 sub connect {
122 root 1.53 my ($self) = @_;
123 root 1.18
124 root 1.23 return if $self->{transport};
125 root 1.55 return if $self->{connect_w};
126 root 1.23
127 root 1.66 # we unweaken the node reference, in case it was weakened before
128     $AnyEvent::MP::Kernel::NODE{$self->{id}}
129     = $AnyEvent::MP::Kernel::NODE{$self->{id}};
130    
131 root 1.18 Scalar::Util::weaken $self;
132 root 1.8
133 root 1.59 $self->{connect_to} ||= AE::timer $AnyEvent::MP::Kernel::CONFIG->{connect_interval}, 0, sub {
134 root 1.66 $self->transport_error (transport_error => $self->{id}, "connect timeout");
135 root 1.59 };
136    
137     # maybe @$addresses?
138     my $addresses = $AnyEvent::MP::Kernel::GLOBAL_DB{"'l"}{$self->{id}};
139    
140     if ($addresses) {
141     $self->connect_to ($addresses);
142     } else {
143     # on global nodes, all bets are off now - we either know the node, or we don't
144 root 1.66 if ($AnyEvent::MP::Kernel::GLOBAL) {
145     $self->transport_error (transport_error => $self->{id}, "no known address");
146     } else {
147 root 1.59 AnyEvent::MP::Kernel::g_find ($self->{id});
148     }
149     }
150     }
151    
152     sub connect_to {
153     my ($self, $addresses) = @_;
154    
155     return if $self->{transport};
156     return if $self->{connect_w};
157    
158 root 1.66 unless (@$addresses) {
159     $self->transport_error (transport_error => $self->{id}, "no known address");
160     return;
161     }
162 root 1.59
163 root 1.62 AE::log 9 => "connecting to $self->{id} with [@$addresses]";
164 root 1.59
165     my $monitor = $AnyEvent::MP::Kernel::CONFIG->{monitor_timeout};
166     my $interval = $AnyEvent::MP::Kernel::CONFIG->{connect_interval};
167    
168     $interval = ($monitor - $interval) / @$addresses
169     if ($monitor - $interval) / @$addresses < $interval;
170    
171     $interval = 0.4 if $interval < 0.4;
172    
173     my @endpoints = reverse @$addresses;
174    
175     $self->{connect_w} = AE::timer 0, $interval * (0.9 + 0.1 * rand), sub {
176     my $endpoint = pop @endpoints;
177    
178 root 1.62 AE::log 9 => "connecting to $self->{id} at $endpoint";
179 root 1.59
180     $self->{trial}{$endpoint} ||= do {
181     my ($host, $port) = AnyEvent::Socket::parse_hostport $endpoint
182 root 1.62 or return AE::log critical => "$self->{id}: '$endpoint' is not a resolved node reference.";
183 root 1.33
184     AnyEvent::MP::Transport::mp_connect
185     $host, $port,
186     sub { delete $self->{trial}{$endpoint} },
187     };
188     };
189 root 1.8 }
190    
191 root 1.18 sub kill {
192     my ($self, $port, @reason) = @_;
193 root 1.4
194 root 1.66 $self->{send} (["", kil1 => $port, @reason]);
195 root 1.1 }
196    
197 root 1.18 sub monitor {
198     my ($self, $portid, $cb) = @_;
199    
200     my $list = $self->{lmon}{$portid} ||= [];
201    
202     $self->send (["", mon1 => $portid])
203 root 1.24 unless @$list || !length $portid;
204 root 1.1
205 root 1.18 push @$list, $cb;
206     }
207 root 1.1
208 root 1.18 sub unmonitor {
209     my ($self, $portid, $cb) = @_;
210 root 1.1
211 root 1.18 my $list = $self->{lmon}{$portid}
212     or return;
213 root 1.1
214 root 1.18 @$list = grep $_ != $cb, @$list;
215 root 1.1
216 root 1.18 unless (@$list) {
217     $self->send (["", mon0 => $portid]);
218     delete $self->{monitor}{$portid};
219 root 1.1 }
220 root 1.18 }
221 root 1.1
222 root 1.64 package AnyEvent::MP::Node::Self; # the local node
223 root 1.1
224     use base "AnyEvent::MP::Node";
225    
226 root 1.20 sub connect {
227     # we are trivially connected
228     }
229    
230 root 1.38 # delay every so often to avoid recursion, also used to delay after spawn
231 root 1.43 our $DELAY = -50;
232 root 1.38 our @DELAY;
233     our $DELAY_W;
234    
235 root 1.61 our $send_delayed = sub {
236 root 1.60 $AnyEvent::MP::Kernel::SRCNODE = $AnyEvent::MP::Kernel::NODE;
237 root 1.39 (shift @DELAY)->()
238 root 1.38 while @DELAY;
239     undef $DELAY_W;
240     $DELAY = -50;
241 root 1.61 };
242 root 1.38
243 root 1.18 sub transport_reset {
244     my ($self) = @_;
245 root 1.1
246 root 1.19 Scalar::Util::weaken $self;
247    
248 root 1.18 $self->{send} = sub {
249 root 1.61 if (++$DELAY > 0) {
250 root 1.39 my $msg = $_[0];
251     push @DELAY, sub { AnyEvent::MP::Kernel::_inject (@$msg) };
252 root 1.61 $DELAY_W ||= AE::timer 0, 0, $send_delayed;
253 root 1.40 return;
254 root 1.38 }
255 root 1.40
256 root 1.60 local $AnyEvent::MP::Kernel::SRCNODE = $AnyEvent::MP::Kernel::NODE;
257 root 1.40 AnyEvent::MP::Kernel::_inject (@{ $_[0] });
258 root 1.18 };
259 root 1.6 }
260    
261 root 1.28 sub transport_connect {
262     my ($self, $tp) = @_;
263    
264 root 1.62 AE::log 9 => "I refuse to talk to myself ($tp->{peerhost}:$tp->{peerport})";
265 root 1.28 }
266    
267 root 1.7 sub kill {
268 root 1.49 my (undef, @args) = @_;
269 root 1.7
270 root 1.44 # we _always_ delay kil's, to avoid calling mon callbacks
271     # from anything but the event loop context.
272     $DELAY = 1;
273 root 1.48 push @DELAY, sub { AnyEvent::MP::Kernel::_kill (@args) };
274 root 1.61 $DELAY_W ||= AE::timer 0, 0, $send_delayed;
275 root 1.7 }
276    
277 root 1.6 sub monitor {
278 root 1.50 # maybe always delay, too?
279 root 1.49 if ($DELAY_W) {
280     my @args = @_;
281     push @DELAY, sub { AnyEvent::MP::Kernel::_monitor (@args) };
282     return;
283     }
284     &AnyEvent::MP::Kernel::_monitor;
285 root 1.6 }
286    
287     sub unmonitor {
288 root 1.50 # no need to always delay
289 root 1.49 if ($DELAY_W) {
290     my @args = @_;
291     push @DELAY, sub { AnyEvent::MP::Kernel::_unmonitor (@args) };
292     return;
293     }
294 root 1.39
295 root 1.49 &AnyEvent::MP::Kernel::_unmonitor;
296 root 1.1 }
297    
298     =head1 SEE ALSO
299    
300 root 1.17 L<AnyEvent::MP>.
301 root 1.1
302     =head1 AUTHOR
303    
304     Marc Lehmann <schmorp@schmorp.de>
305     http://home.schmorp.de/
306    
307     =cut
308    
309     1
310