ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/AnyEvent-FCP/FCP.pm
(Generate patch)

Comparing AnyEvent-FCP/FCP.pm (file contents):
Revision 1.16 by root, Sat Sep 5 13:26:47 2015 UTC vs.
Revision 1.20 by root, Sun Jun 12 01:32:37 2016 UTC

… …
61 61
62use common::sense; 62use common::sense;
63 63
64use Carp; 64use Carp;
65 65
66our $VERSION = '0.3'; 66our $VERSION = 0.4;
67 67
68use Scalar::Util (); 68use Scalar::Util ();
69 69
70use AnyEvent; 70use AnyEvent;
71use AnyEvent::Handle; 71use AnyEvent::Handle;
… …
86 1 while s/([^_])(SVK|CHK|URI|FCP|DS|MIME|DDA)/$1\_$2/; 86 1 while s/([^_])(SVK|CHK|URI|FCP|DS|MIME|DDA)/$1\_$2/;
87 s/(?<=[a-z])(?=[A-Z])/_/g; 87 s/(?<=[a-z])(?=[A-Z])/_/g;
88 lc 88 lc
89} 89}
90 90
91=item $fcp = new AnyEvent::FCP [host => $host][, port => $port][, name => $name] 91=item $fcp = new AnyEvent::FCP key => value...;
92 92
93Create a new FCP connection to the given host and port (default 93Create a new FCP connection to the given host and port (default
94127.0.0.1:9481, or the environment variables C<FREDHOST> and C<FREDPORT>). 94127.0.0.1:9481, or the environment variables C<FREDHOST> and C<FREDPORT>).
95 95
96If no C<name> was specified, then AnyEvent::FCP will generate a 96If no C<name> was specified, then AnyEvent::FCP will generate a
97(hopefully) unique client name for you. 97(hopefully) unique client name for you.
98
99The following keys can be specified (they are all optional):
100
101=over 4
102
103=item name => $string
104
105A unique name to identify this client. If none is specified, a randomly
106generated name will be used.
107
108=item host => $hostname
109
110The hostname or IP address of the freenet node. Default is C<$ENV{FREDHOST}>
111or C<127.0.0.1>.
112
113=item port => $portnumber
114
115The port number of the FCP port. Default is C<$ENV{FREDPORT}> or C<9481>.
116
117=item timeout => $seconds
118
119The timeout, in seconds, after which a connection error is assumed when
120there is no activity. Default is C<7200>, i.e. two hours.
121
122=item keepalive => $seconds
123
124The interval, in seconds, at which keepalive messages will be
125sent. Default is C<540>, i.e. nine minutes.
126
127These keepalive messages are useful both to detect that a connection is
128no longer working and to keep any (home) routers from expiring their
129masquerading entry.
130
131=item on_error => $callback->($fcp, $message)
132
133Invoked on any (fatal) errors, such as unexpected connection close. The
134callback receives the FCP object and a textual error message.
135
136=item on_failure => $callback->($fcp, $backtrace, $args, $error)
137
138Invoked when an FCP request fails that didn't have a failure callback. See
139L<FCP REQUESTS> for details.
140
141=back
98 142
99=cut 143=cut
100 144
101sub new { 145sub new {
102 my $class = shift; 146 my $class = shift;
… …
105 149
106 my $self = bless { 150 my $self = bless {
107 host => $ENV{FREDHOST} || "127.0.0.1", 151 host => $ENV{FREDHOST} || "127.0.0.1",
108 port => $ENV{FREDPORT} || 9481, 152 port => $ENV{FREDPORT} || 9481,
109 timeout => 3600 * 2, 153 timeout => 3600 * 2,
154 keepalive => 9 * 60,
110 name => time.rand.rand.rand, # lame 155 name => time.rand.rand.rand, # lame
111 @_, 156 @_,
112 queue => [], 157 queue => [],
113 req => {}, 158 req => {},
114 prefix => "..:aefcpid:$rand:", 159 prefix => "..:aefcpid:$rand:",
… …
116 }, $class; 161 }, $class;
117 162
118 { 163 {
119 Scalar::Util::weaken (my $self = $self); 164 Scalar::Util::weaken (my $self = $self);
120 165
166 $self->{kw} = AE::timer $self->{keepalive}, $self->{keepalive}, sub {
167 $self->{hdl}->push_write ("\n");
168 };
169
170 our $ENDMESSAGE = qr<\012(EndMessage|Data)\012>;
171
172 # these are declared here for performance reasons
173 my ($k, $v, $type);
174 my $rdata;
175
176 my $on_read = sub {
177 my ($hdl) = @_;
178
179 # we only carve out whole messages here
180 while ($hdl->{rbuf} =~ /\012(EndMessage|Data)\012/) {
181 # remember end marker
182 $rdata = $1 eq "Data"
183 or $1 eq "EndMessage"
184 or return $self->fatal ("protocol error, expected message end, got $1\n");
185
186 my @lines = split /\012/, substr $hdl->{rbuf}, 0, $-[0];
187
188 substr $hdl->{rbuf}, 0, $+[0], ""; # remove pkg
189
190 $type = shift @lines;
191 $type = ($TOLC{$type} ||= tolc $type);
192
193 my %kv;
194
195 for (@lines) {
196 ($k, $v) = split /=/, $_, 2;
197 $k = ($TOLC{$k} ||= tolc $k);
198
199 if ($k =~ /\./) {
200 # generic, slow case
201 my @k = split /\./, $k;
202 my $ro = \\%kv;
203
204 while (@k) {
205 $k = shift @k;
206 if ($k =~ /^\d+$/) {
207 $ro = \$$ro->[$k];
208 } else {
209 $ro = \$$ro->{$k};
210 }
211 }
212
213 $$ro = $v;
214
215 next;
216 }
217
218 # special comon case, for performance only
219 $kv{$k} = $v;
220 }
221
222 if ($rdata) {
223 $_[0]->push_read (chunk => delete $kv{data_length}, sub {
224 $rdata = \$_[1];
225 $self->recv ($type, \%kv, $rdata);
226 });
227
228 last; # do not tgry to parse more messages
229 } else {
230 $self->recv ($type, \%kv);
231 }
232 }
233 };
234
121 $self->{hdl} = new AnyEvent::Handle 235 $self->{hdl} = new AnyEvent::Handle
122 connect => [$self->{host} => $self->{port}], 236 connect => [$self->{host} => $self->{port}],
123 timeout => $self->{timeout}, 237 timeout => $self->{timeout},
238 on_read => $on_read,
239 on_eof => $self->{on_eof},
124 on_error => sub { 240 on_error => sub {
125 warn "@_\n";#d# 241 $self->fatal ($_[2]);
126 exit 1;
127 }, 242 },
128 on_read => sub { $self->on_read (@_) }, 243 ;
129 on_eof => $self->{on_eof} || sub { };
130 244
131 Scalar::Util::weaken ($self->{hdl}{fcp} = $self); 245 Scalar::Util::weaken ($self->{hdl}{fcp} = $self);
132 } 246 }
133 247
134 $self->send_msg (client_hello => 248 $self->send_msg (client_hello =>
135 name => $self->{name}, 249 name => $self->{name},
136 expected_version => "2.0", 250 expected_version => "2.0",
137 ); 251 );
138 252
139 $self 253 $self
254}
255
256sub fatal {
257 my ($self, $msg) = @_;
258
259 $self->{hdl}->shutdown;
260 delete $self->{kw};
261
262 if ($self->{on_error}) {
263 $self->{on_error}->($self, $msg);
264 } else {
265 die $msg;
266 }
140} 267}
141 268
142sub identifier { 269sub identifier {
143 $_[0]{prefix} . ++$_[0]{idseq} 270 $_[0]{prefix} . ++$_[0]{idseq}
144} 271}
… …
253 } else { 380 } else {
254 $self->default_recv ($type, $kv, @extra); 381 $self->default_recv ($type, $kv, @extra);
255 } 382 }
256} 383}
257 384
258sub on_read {
259 my ($self) = @_;
260
261 my ($k, $v, $type);
262 my %kv;
263 my $rdata;
264
265 my $hdr_cb; $hdr_cb = sub {
266 if (($v = index $_[1], "=") >= 0) {
267 $k = substr $_[1], 0, $v;
268 $v = substr $_[1], $v + 1;
269 $k = ($TOLC{$k} ||= tolc $k);
270
271 if ($k !~ /\./) {
272 # special case common case, for performance only
273 $kv{$k} = $v;
274 } else {
275 my @k = split /\./, $k;
276 my $ro = \\%kv;
277
278 while (@k) {
279 $k = shift @k;
280 if ($k =~ /^\d+$/) {
281 $ro = \$$ro->[$k];
282 } else {
283 $ro = \$$ro->{$k};
284 }
285 }
286
287 $$ro = $v;
288 }
289
290 $_[0]->push_read (line => $hdr_cb);
291 } elsif ($_[1] eq "Data") {
292 $_[0]->push_read (chunk => delete $kv{data_length}, sub {
293 $rdata = \$_[1];
294 $self->recv ($type, \%kv, $rdata);
295 });
296 } elsif ($_[1] eq "EndMessage") {
297 $self->recv ($type, \%kv);
298 } else {
299 die "protocol error, expected message end, got $_[1]\n";#d#
300 }
301 };
302
303 $self->{hdl}->push_read (line => sub {
304 $type = ($TOLC{$_[1]} ||= tolc $_[1]);
305 $_[0]->push_read (line => $hdr_cb);
306 });
307}
308
309sub default_recv { 385sub default_recv {
310 my ($self, $type, $kv, $rdata) = @_; 386 my ($self, $type, $kv, $rdata) = @_;
311 387
312 if ($type eq "node_hello") { 388 if ($type eq "node_hello") {
313 $self->{node_hello} = $kv; 389 $self->{node_hello} = $kv;
… …
350=over 4 426=over 4
351 427
352=item A code reference (or rather anything not matching some other alternative) 428=item A code reference (or rather anything not matching some other alternative)
353 429
354This code reference will be invoked with the result on success. On an 430This code reference will be invoked with the result on success. On an
431error, it will invoke the C<on_failure> callback of the FCP object, or,
355error, it will die (in the event loop) with a backtrace of the call site. 432if none was defined, will die (in the event loop) with a backtrace of the
433call site.
356 434
357This is a popular choice, but it makes handling errors hard - make sure 435This is a popular choice, but it makes handling errors hard - make sure
358you never generate protocol errors! 436you never generate protocol errors!
437
438If an C<on_failure> hook exists, it will be invoked with the FCP object,
439a (textual) backtrace as generated by C<Carp::longmess>, and arrayref
440containing the arguments from the original request invocation and the
441error object from the server, in this order, e.g.:
442
443 on_failure => sub {
444 my ($fcp, $backtrace, $orig_args, $error_object) = @_;
445 ...
446 },
359 447
360=item A condvar (as returned by e.g. C<< AnyEvent->condvar >>) 448=item A condvar (as returned by e.g. C<< AnyEvent->condvar >>)
361 449
362When a condvar is passed, it is sent (C<< $cv->send ($results) >>) the 450When a condvar is passed, it is sent (C<< $cv->send ($results) >>) the
363results when the request has finished. Should an error occur, the error 451results when the request has finished. Should an error occur, the error
… …
368=item An array with two callbacks C<[$success, $failure]> 456=item An array with two callbacks C<[$success, $failure]>
369 457
370The C<$success> callback will be invoked with the results, while the 458The C<$success> callback will be invoked with the results, while the
371C<$failure> callback will be invoked on any errors. 459C<$failure> callback will be invoked on any errors.
372 460
461The C<$failure> callback will be invoked with the error object from the
462server.
463
373=item C<undef> 464=item C<undef>
374 465
375This is the same thing as specifying C<sub { }> as callback, i.e. on 466This is the same thing as specifying C<sub { }> as callback, i.e. on
376success, the results are ignored, while on failure, you the module dies 467success, the results are ignored, while on failure, the C<on_failure> hook
377with a backtrace. 468is invoked or the module dies with a backtrace.
378 469
379This is good for quick scripts, or when you really aren't interested in 470This is good for quick scripts, or when you really aren't interested in
380the results. 471the results.
381 472
382=back 473=back
… …
402 if (ARRAY:: eq ref $ok) { 493 if (ARRAY:: eq ref $ok) {
403 ($ok, $err) = @$ok; 494 ($ok, $err) = @$ok;
404 } elsif (UNIVERSAL::isa $ok, AnyEvent::CondVar::) { 495 } elsif (UNIVERSAL::isa $ok, AnyEvent::CondVar::) {
405 $err = sub { $ok->croak ($_[0]{extra_description}) }; 496 $err = sub { $ok->croak ($_[0]{extra_description}) };
406 } else { 497 } else {
407 my $bt = Carp::longmess ""; 498 my $bt = Carp::longmess "AnyEvent::FCP request $name";
499 Scalar::Util::weaken (my $self = $_[0]);
500 my $args = [@_]; shift @$args;
408 $err = sub { 501 $err = sub {
502 if ($self->{on_failure}) {
503 $self->{on_failure}($self, $args, $bt, $_[0]);
504 } else {
409 die "$_[0]{code_description} ($_[0]{extra_description})$bt"; 505 die "$_[0]{code_description} ($_[0]{extra_description})$bt";
506 }
410 }; 507 };
411 } 508 }
412 509
413 $ok ||= $NOP_CB; 510 $ok ||= $NOP_CB;
414 511

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines