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