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.14 by root, Sat Aug 8 14:09:47 2015 UTC vs.
Revision 1.16 by root, Sat Sep 5 13:26:47 2015 UTC

… …
68use Scalar::Util (); 68use Scalar::Util ();
69 69
70use AnyEvent; 70use AnyEvent;
71use AnyEvent::Handle; 71use AnyEvent::Handle;
72use AnyEvent::Util (); 72use AnyEvent::Util ();
73
74our %TOLC; # tolc cache
73 75
74sub touc($) { 76sub touc($) {
75 local $_ = shift; 77 local $_ = shift;
76 1 while s/((?:^|_)(?:svk|chk|uri|fcp|ds|mime|dda)(?:_|$))/\U$1/; 78 1 while s/((?:^|_)(?:svk|chk|uri|fcp|ds|mime|dda)(?:_|$))/\U$1/;
77 s/(?:^|_)(.)/\U$1/g; 79 s/(?:^|_)(.)/\U$1/g;
… …
107 timeout => 3600 * 2, 109 timeout => 3600 * 2,
108 name => time.rand.rand.rand, # lame 110 name => time.rand.rand.rand, # lame
109 @_, 111 @_,
110 queue => [], 112 queue => [],
111 req => {}, 113 req => {},
112 prefix => "..:aefcpid-$rand:", 114 prefix => "..:aefcpid:$rand:",
113 idseq => "a0", 115 idseq => "a0",
114 }, $class; 116 }, $class;
115 117
116 { 118 {
117 Scalar::Util::weaken (my $self = $self); 119 Scalar::Util::weaken (my $self = $self);
… …
232 234
233 if (my $cb = $PERSISTENT_TYPE{$type}) { 235 if (my $cb = $PERSISTENT_TYPE{$type}) {
234 my $id = $kv->{identifier}; 236 my $id = $kv->{identifier};
235 my $req = $_[0]{req}{$id} ||= {}; 237 my $req = $_[0]{req}{$id} ||= {};
236 $cb->($self, $req, $kv); 238 $cb->($self, $req, $kv);
237 $self->recv (request_change => $kv, $type, @extra); 239 $self->recv (request_changed => $kv, $type, @extra);
238 } 240 }
239 241
240 my $on = $self->{on}; 242 my $on = $self->{on};
241 for (0 .. $#$on) { 243 for (0 .. $#$on) {
242 unless (my $res = $on->[$_]($self, $type, $kv, @extra)) { 244 unless (my $res = $on->[$_]($self, $type, $kv, @extra)) {
… …
254} 256}
255 257
256sub on_read { 258sub on_read {
257 my ($self) = @_; 259 my ($self) = @_;
258 260
259 my $type; 261 my ($k, $v, $type);
260 my %kv; 262 my %kv;
261 my $rdata; 263 my $rdata;
262 264
263 my $hdr_cb; $hdr_cb = sub { 265 my $hdr_cb; $hdr_cb = sub {
264 if ($_[1] =~ /^([^=]+)=(.*)$/) { 266 if (($v = index $_[1], "=") >= 0) {
265 my ($k, $v) = ($1, $2); 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 {
266 my @k = split /\./, tolc $k; 275 my @k = split /\./, $k;
267 my $ro = \\%kv; 276 my $ro = \\%kv;
268 277
269 while (@k) { 278 while (@k) {
270 my $k = shift @k; 279 $k = shift @k;
271 if ($k =~ /^\d+$/) { 280 if ($k =~ /^\d+$/) {
272 $ro = \$$ro->[$k]; 281 $ro = \$$ro->[$k];
273 } else { 282 } else {
274 $ro = \$$ro->{$k}; 283 $ro = \$$ro->{$k};
284 }
275 } 285 }
286
287 $$ro = $v;
276 } 288 }
277
278 $$ro = $v;
279 289
280 $_[0]->push_read (line => $hdr_cb); 290 $_[0]->push_read (line => $hdr_cb);
281 } elsif ($_[1] eq "Data") { 291 } elsif ($_[1] eq "Data") {
282 $_[0]->push_read (chunk => delete $kv{data_length}, sub { 292 $_[0]->push_read (chunk => delete $kv{data_length}, sub {
283 $rdata = \$_[1]; 293 $rdata = \$_[1];
… …
289 die "protocol error, expected message end, got $_[1]\n";#d# 299 die "protocol error, expected message end, got $_[1]\n";#d#
290 } 300 }
291 }; 301 };
292 302
293 $self->{hdl}->push_read (line => sub { 303 $self->{hdl}->push_read (line => sub {
294 $type = tolc $_[1]; 304 $type = ($TOLC{$_[1]} ||= tolc $_[1]);
295 $_[0]->push_read (line => $hdr_cb); 305 $_[0]->push_read (line => $hdr_cb);
296 }); 306 });
297} 307}
298 308
299sub default_recv { 309sub default_recv {
… …
394 } elsif (UNIVERSAL::isa $ok, AnyEvent::CondVar::) { 404 } elsif (UNIVERSAL::isa $ok, AnyEvent::CondVar::) {
395 $err = sub { $ok->croak ($_[0]{extra_description}) }; 405 $err = sub { $ok->croak ($_[0]{extra_description}) };
396 } else { 406 } else {
397 my $bt = Carp::longmess ""; 407 my $bt = Carp::longmess "";
398 $err = sub { 408 $err = sub {
399 die "$_[0]{extra_description}$bt"; 409 die "$_[0]{code_description} ($_[0]{extra_description})$bt";
400 }; 410 };
401 } 411 }
402 412
403 $ok ||= $NOP_CB; 413 $ok ||= $NOP_CB;
404 414
… …
549=cut 559=cut
550 560
551_txn get_plugin_info => sub { 561_txn get_plugin_info => sub {
552 my ($self, $ok, $err, $name, $detailed) = @_; 562 my ($self, $ok, $err, $name, $detailed) = @_;
553 563
564 my $id = $self->identifier;
565
554 $self->send_msg (get_plugin_info => 566 $self->send_msg (get_plugin_info =>
567 identifier => $id,
555 plugin_name => $name, 568 plugin_name => $name,
556 detailed => $detailed ? "true" : "false", 569 detailed => $detailed ? "true" : "false",
557 id_cb => sub {
558 my ($self, $type, $kv, $rdata) = @_;
559
560 $ok->($kv);
561 1
562 },
563 ); 570 );
571 $self->on (sub {
572 my ($self, $type, $kv) = @_;
573
574 if ($kv->{identifier} eq $id) {
575 if ($type eq "get_plugin_info") {
576 $ok->($kv);
577 } else {
578 $err->($kv, $type);
579 }
580 return;
581 }
582
583 1
584 });
564}; 585};
565 586
566=item $status = $fcp->client_get ($uri, $identifier, %kv) 587=item $status = $fcp->client_get ($uri, $identifier, %kv)
567 588
568%kv can contain (L<http://wiki.freenetproject.org/FCP2p0ClientGet>). 589%kv can contain (L<http://wiki.freenetproject.org/FCP2p0ClientGet>).

Diff Legend

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