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.12 by root, Sat Aug 8 04:02:48 2015 UTC vs.
Revision 1.15 by root, Fri Aug 14 03:33:13 2015 UTC

… …
96 96
97=cut 97=cut
98 98
99sub new { 99sub new {
100 my $class = shift; 100 my $class = shift;
101
102 my $rand = join "", map chr 0x21 + rand 94, 1..40; # ~ 262 bits entropy
103
101 my $self = bless { 104 my $self = bless {
102 host => $ENV{FREDHOST} || "127.0.0.1", 105 host => $ENV{FREDHOST} || "127.0.0.1",
103 port => $ENV{FREDPORT} || 9481, 106 port => $ENV{FREDPORT} || 9481,
104 timeout => 3600 * 2, 107 timeout => 3600 * 2,
105 name => time.rand.rand.rand, # lame 108 name => time.rand.rand.rand, # lame
106 @_, 109 @_,
107 queue => [], 110 queue => [],
108 req => {}, 111 req => {},
112 prefix => "..:aefcpid:$rand:",
109 id => "a0", 113 idseq => "a0",
110 }, $class; 114 }, $class;
111 115
112 { 116 {
113 Scalar::Util::weaken (my $self = $self); 117 Scalar::Util::weaken (my $self = $self);
114 118
… …
131 ); 135 );
132 136
133 $self 137 $self
134} 138}
135 139
140sub identifier {
141 $_[0]{prefix} . ++$_[0]{idseq}
142}
143
136sub send_msg { 144sub send_msg {
137 my ($self, $type, %kv) = @_; 145 my ($self, $type, %kv) = @_;
138 146
139 my $data = delete $kv{data}; 147 my $data = delete $kv{data};
140 148
141 if (exists $kv{id_cb}) { 149 if (exists $kv{id_cb}) {
142 my $id = $kv{identifier} ||= ++$self->{id}; 150 my $id = $kv{identifier} ||= $self->identifier;
143 $self->{id}{$id} = delete $kv{id_cb}; 151 $self->{id}{$id} = delete $kv{id_cb};
144 } 152 }
145 153
146 my $msg = (touc $type) . "\012" 154 my $msg = (touc $type) . "\012"
147 . join "", map +(touc $_) . "=$kv{$_}\012", keys %kv; 155 . join "", map +(touc $_) . "=$kv{$_}\012", keys %kv;
… …
371 my ($name, $sub) = @_; 379 my ($name, $sub) = @_;
372 380
373 *{$name} = sub { 381 *{$name} = sub {
374 my $cv = AE::cv; 382 my $cv = AE::cv;
375 383
376 splice @_, 1, 0, $cv, sub { $cv->throw ($_[0]{extra_description}) }; 384 splice @_, 1, 0, $cv, sub { $cv->croak ($_[0]{extra_description}) };
377 &$sub; 385 &$sub;
378 $cv->recv 386 $cv->recv
379 }; 387 };
380 388
381 *{"$name\_"} = sub { 389 *{"$name\_"} = sub {
382 my ($ok, $err) = pop; 390 my ($ok, $err) = pop;
383 391
384 if (ARRAY:: eq ref $ok) { 392 if (ARRAY:: eq ref $ok) {
385 ($ok, $err) = @$ok; 393 ($ok, $err) = @$ok;
386 } elsif (UNIVERSAL::isa $ok, AnyEvent::CondVar::) { 394 } elsif (UNIVERSAL::isa $ok, AnyEvent::CondVar::) {
387 $err = sub { $ok->throw ($_[0]{extra_description}) }; 395 $err = sub { $ok->croak ($_[0]{extra_description}) };
388 } else { 396 } else {
389 my $bt = Carp::longmess ""; 397 my $bt = Carp::longmess "";
390 $err = sub { 398 $err = sub {
391 die "$_[0]{extra_description}$bt"; 399 die "$_[0]{code_description} ($_[0]{extra_description})$bt";
392 }; 400 };
393 } 401 }
394 402
395 $ok ||= $NOP_CB; 403 $ok ||= $NOP_CB;
396 404
… …
517 ); 525 );
518 526
519 $self->on (sub { 527 $self->on (sub {
520 my ($self, $type, $kv, @extra) = @_; 528 my ($self, $type, $kv, @extra) = @_;
521 529
530 $guard if 0;
531
522 if ($kv->{identifier} eq $identifier) { 532 if ($kv->{identifier} eq $identifier) {
523 if ($type eq "persistent_request_modified") { 533 if ($type eq "persistent_request_modified") {
524 $ok->($kv); 534 $ok->($kv);
525 return; 535 return;
526 } elsif ($type eq "protocol_error") { 536 } elsif ($type eq "protocol_error") {
… …
539=cut 549=cut
540 550
541_txn get_plugin_info => sub { 551_txn get_plugin_info => sub {
542 my ($self, $ok, $err, $name, $detailed) = @_; 552 my ($self, $ok, $err, $name, $detailed) = @_;
543 553
554 my $id = $self->identifier;
555
544 $self->send_msg (get_plugin_info => 556 $self->send_msg (get_plugin_info =>
557 identifier => $id,
545 plugin_name => $name, 558 plugin_name => $name,
546 detailed => $detailed ? "true" : "false", 559 detailed => $detailed ? "true" : "false",
547 id_cb => sub {
548 my ($self, $type, $kv, $rdata) = @_;
549
550 $ok->($kv);
551 1
552 },
553 ); 560 );
561 $self->on (sub {
562 my ($self, $type, $kv) = @_;
563
564 if ($kv->{identifier} eq $id) {
565 if ($type eq "get_plugin_info") {
566 $ok->($kv);
567 } else {
568 $err->($kv, $type);
569 }
570 return;
571 }
572
573 1
574 });
554}; 575};
555 576
556=item $status = $fcp->client_get ($uri, $identifier, %kv) 577=item $status = $fcp->client_get ($uri, $identifier, %kv)
557 578
558%kv can contain (L<http://wiki.freenetproject.org/FCP2p0ClientGet>). 579%kv can contain (L<http://wiki.freenetproject.org/FCP2p0ClientGet>).
… …
564=cut 585=cut
565 586
566_txn client_get => sub { 587_txn client_get => sub {
567 my ($self, $ok, $err, $uri, $identifier, %kv) = @_; 588 my ($self, $ok, $err, $uri, $identifier, %kv) = @_;
568 589
590 $self->serialise ($identifier => sub {
591 my ($self, $guard) = @_;
592
569 $self->send_msg (client_get => 593 $self->send_msg (client_get =>
570 %kv, 594 %kv,
571 uri => $uri, 595 uri => $uri,
572 identifier => $identifier, 596 identifier => $identifier,
597 );
598
599 $self->on (sub {
600 my ($self, $type, $kv, @extra) = @_;
601
602 $guard if 0;
603
604 if ($kv->{identifier} eq $identifier) {
605 if ($type eq "persistent_get") {
606 $ok->($kv);
607 return;
608 } elsif ($type eq "protocol_error") {
609 $err->($kv);
610 return;
611 }
612 }
613
614 1
615 });
573 ); 616 });
574
575 $ok->();
576}; 617};
577 618
578=item $status = $fcp->remove_request ($identifier[, $global]) 619=item $status = $fcp->remove_request ($identifier[, $global])
579 620
580Remove the request with the given isdentifier. Returns true if successful, 621Remove the request with the given isdentifier. Returns true if successful,
… …
592 identifier => $identifier, 633 identifier => $identifier,
593 global => $global ? "true" : "false", 634 global => $global ? "true" : "false",
594 ); 635 );
595 $self->on (sub { 636 $self->on (sub {
596 my ($self, $type, $kv, @extra) = @_; 637 my ($self, $type, $kv, @extra) = @_;
638
639 $guard if 0;
597 640
598 if ($kv->{identifier} eq $identifier) { 641 if ($kv->{identifier} eq $identifier) {
599 if ($type eq "persistent_request_removed") { 642 if ($type eq "persistent_request_removed") {
600 $ok->(1); 643 $ok->(1);
601 return; 644 return;

Diff Legend

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