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.17 by root, Sat Sep 5 19:36:12 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
121 our $ENDMESSAGE = qr<\012(EndMessage|Data)\012>; 170 our $ENDMESSAGE = qr<\012(EndMessage|Data)\012>;
122 171
123 # these are declared here for performance reasons 172 # these are declared here for performance reasons
124 my ($k, $v, $type); 173 my ($k, $v, $type);
125 my $rdata; 174 my $rdata;
… …
130 # we only carve out whole messages here 179 # we only carve out whole messages here
131 while ($hdl->{rbuf} =~ /\012(EndMessage|Data)\012/) { 180 while ($hdl->{rbuf} =~ /\012(EndMessage|Data)\012/) {
132 # remember end marker 181 # remember end marker
133 $rdata = $1 eq "Data" 182 $rdata = $1 eq "Data"
134 or $1 eq "EndMessage" 183 or $1 eq "EndMessage"
135 or die "protocol error, expected message end, got $1\n"; 184 or return $self->fatal ("protocol error, expected message end, got $1\n");
136 185
137 my @lines = split /\012/, substr $hdl->{rbuf}, 0, $-[0]; 186 my @lines = split /\012/, substr $hdl->{rbuf}, 0, $-[0];
138 187
139 substr $hdl->{rbuf}, 0, $+[0], ""; # remove pkg 188 substr $hdl->{rbuf}, 0, $+[0], ""; # remove pkg
140 189
… …
184 }; 233 };
185 234
186 $self->{hdl} = new AnyEvent::Handle 235 $self->{hdl} = new AnyEvent::Handle
187 connect => [$self->{host} => $self->{port}], 236 connect => [$self->{host} => $self->{port}],
188 timeout => $self->{timeout}, 237 timeout => $self->{timeout},
238 on_read => $on_read,
239 on_eof => $self->{on_eof},
189 on_error => sub { 240 on_error => sub {
190 warn "@_\n";#d# 241 $self->fatal ($_[2]);
191 exit 1;
192 }, 242 },
193 on_read => $on_read,
194 on_eof => $self->{on_eof} || sub { },
195 ; 243 ;
196 244
197 Scalar::Util::weaken ($self->{hdl}{fcp} = $self); 245 Scalar::Util::weaken ($self->{hdl}{fcp} = $self);
198 } 246 }
199 247
… …
201 name => $self->{name}, 249 name => $self->{name},
202 expected_version => "2.0", 250 expected_version => "2.0",
203 ); 251 );
204 252
205 $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 }
206} 267}
207 268
208sub identifier { 269sub identifier {
209 $_[0]{prefix} . ++$_[0]{idseq} 270 $_[0]{prefix} . ++$_[0]{idseq}
210} 271}
… …
365=over 4 426=over 4
366 427
367=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)
368 429
369This 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,
370error, 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.
371 434
372This 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
373you 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 },
374 447
375=item A condvar (as returned by e.g. C<< AnyEvent->condvar >>) 448=item A condvar (as returned by e.g. C<< AnyEvent->condvar >>)
376 449
377When 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
378results when the request has finished. Should an error occur, the error 451results when the request has finished. Should an error occur, the error
… …
383=item An array with two callbacks C<[$success, $failure]> 456=item An array with two callbacks C<[$success, $failure]>
384 457
385The C<$success> callback will be invoked with the results, while the 458The C<$success> callback will be invoked with the results, while the
386C<$failure> callback will be invoked on any errors. 459C<$failure> callback will be invoked on any errors.
387 460
461The C<$failure> callback will be invoked with the error object from the
462server.
463
388=item C<undef> 464=item C<undef>
389 465
390This 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
391success, the results are ignored, while on failure, you the module dies 467success, the results are ignored, while on failure, the C<on_failure> hook
392with a backtrace. 468is invoked or the module dies with a backtrace.
393 469
394This 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
395the results. 471the results.
396 472
397=back 473=back
… …
417 if (ARRAY:: eq ref $ok) { 493 if (ARRAY:: eq ref $ok) {
418 ($ok, $err) = @$ok; 494 ($ok, $err) = @$ok;
419 } elsif (UNIVERSAL::isa $ok, AnyEvent::CondVar::) { 495 } elsif (UNIVERSAL::isa $ok, AnyEvent::CondVar::) {
420 $err = sub { $ok->croak ($_[0]{extra_description}) }; 496 $err = sub { $ok->croak ($_[0]{extra_description}) };
421 } else { 497 } else {
422 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;
423 $err = sub { 501 $err = sub {
502 if ($self->{on_failure}) {
503 $self->{on_failure}($self, $args, $bt, $_[0]);
504 } else {
424 die "$_[0]{code_description} ($_[0]{extra_description})$bt"; 505 die "$_[0]{code_description} ($_[0]{extra_description})$bt";
506 }
425 }; 507 };
426 } 508 }
427 509
428 $ok ||= $NOP_CB; 510 $ok ||= $NOP_CB;
429 511

Diff Legend

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