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.3 by root, Tue Jul 28 02:20:51 2009 UTC vs.
Revision 1.6 by root, Mon May 31 06:27:37 2010 UTC

… …
42 42
43use common::sense; 43use common::sense;
44 44
45use Carp; 45use Carp;
46 46
47our $VERSION = '0.2'; 47our $VERSION = '0.21';
48 48
49use Scalar::Util (); 49use Scalar::Util ();
50 50
51use AnyEvent; 51use AnyEvent;
52use AnyEvent::Handle; 52use AnyEvent::Handle;
53 53
54sub touc($) { 54sub touc($) {
55 local $_ = shift; 55 local $_ = shift;
56 1 while s/((?:^|_)(?:svk|chk|uri|fcp)(?:_|$))/\U$1/; 56 1 while s/((?:^|_)(?:svk|chk|uri|fcp|ds|mime)(?:_|$))/\U$1/;
57 s/(?:^|_)(.)/\U$1/g; 57 s/(?:^|_)(.)/\U$1/g;
58 $_ 58 $_
59} 59}
60 60
61sub tolc($) { 61sub tolc($) {
62 local $_ = shift; 62 local $_ = shift;
63 1 while s/(SVK|CHK|URI|FCP)([^_])/$1\_$2/i; 63 1 while s/(SVK|CHK|URI|FCP|DS|MIME)([^_])/$1\_$2/i;
64 1 while s/([^_])(SVK|CHK|URI|FCP)/$1\_$2/i; 64 1 while s/([^_])(SVK|CHK|URI|FCP|DS|MIME)/$1\_$2/i;
65 s/(?<=[a-z])(?=[A-Z])/_/g; 65 s/(?<=[a-z])(?=[A-Z])/_/g;
66 lc 66 lc
67} 67}
68 68
69=item $fcp = new AnyEvent::FCP [host => $host][, port => $port][, progress => \&cb][, name => $name] 69=item $fcp = new AnyEvent::FCP [host => $host][, port => $port][, progress => \&cb][, name => $name]
… …
72127.0.0.1:9481, or the environment variables C<FREDHOST> and C<FREDPORT>). 72127.0.0.1:9481, or the environment variables C<FREDHOST> and C<FREDPORT>).
73 73
74If no C<name> was specified, then AnyEvent::FCP will generate a 74If no C<name> was specified, then AnyEvent::FCP will generate a
75(hopefully) unique client name for you. 75(hopefully) unique client name for you.
76 76
77=cut
78
79#TODO
80#You can install a progress callback that is being called with the AnyEvent::FCP 77You can install a progress callback that is being called with the AnyEvent::FCP
81#object, a txn object, the type of the transaction and the attributes. Use 78object, the type, a hashref with key-value pairs and a reference to any received data,
82#it like this: 79for all unsolicited messages.
83# 80
81Example:
82
84# sub progress_cb { 83 sub progress_cb {
85# my ($self, $txn, $type, $attr) = @_; 84 my ($self, $type, $kv, $rdata) = @_;
86# 85
87# warn "progress<$txn,$type," . (join ":", %$attr) . ">\n"; 86 if ($type eq "simple_progress") {
87 warn "$kv->{identifier} $kv->{succeeded}/$kv->{required}\n";
88 }
88# } 89 }
90
91=cut
89 92
90sub new { 93sub new {
91 my $class = shift; 94 my $class = shift;
92 my $self = bless { @_ }, $class; 95 my $self = bless { @_ }, $class;
93 96
94 $self->{host} ||= $ENV{FREDHOST} || "127.0.0.1"; 97 $self->{host} ||= $ENV{FREDHOST} || "127.0.0.1";
95 $self->{port} ||= $ENV{FREDPORT} || 9481; 98 $self->{port} ||= $ENV{FREDPORT} || 9481;
96 $self->{name} ||= time.rand.rand.rand; # lame 99 $self->{name} ||= time.rand.rand.rand; # lame
97 $self->{timeout} ||= 600; 100 $self->{timeout} ||= 600;
101 $self->{progress} ||= sub { };
98 102
99 $self->{id} = "a0"; 103 $self->{id} = "a0";
100 104
101 { 105 {
102 Scalar::Util::weaken (my $self = $self); 106 Scalar::Util::weaken (my $self = $self);
… …
120 expected_version => "2.0", 124 expected_version => "2.0",
121 ); 125 );
122 126
123 $self 127 $self
124} 128}
125
126#sub progress {
127# my ($self, $txn, $type, $attr) = @_;
128#
129# $self->{progress}->($self, $txn, $type, $attr)
130# if $self->{progress};
131#}
132 129
133sub send_msg { 130sub send_msg {
134 my ($self, $type, %kv) = @_; 131 my ($self, $type, %kv) = @_;
135 132
136 my $data = delete $kv{data}; 133 my $data = delete $kv{data};
… …
221 $self->{node_hello} = $kv; 218 $self->{node_hello} = $kv;
222 } elsif (exists $self->{id}{$kv->{identifier}}) { 219 } elsif (exists $self->{id}{$kv->{identifier}}) {
223 $self->{id}{$kv->{identifier}}($self, $type, $kv, $rdata) 220 $self->{id}{$kv->{identifier}}($self, $type, $kv, $rdata)
224 and delete $self->{id}{$kv->{identifier}}; 221 and delete $self->{id}{$kv->{identifier}};
225 } else { 222 } else {
226 # on_warn 223 &{ $self->{progress} };
227 #warn "protocol warning (unexpected $type message)\n";
228 } 224 }
229} 225}
230 226
231sub _txn { 227sub _txn {
232 my ($name, $sub) = @_; 228 my ($name, $sub) = @_;
… …
365 361
366 $cv->($kv); 362 $cv->($kv);
367 1 363 1
368 }, 364 },
369 ); 365 );
370
371 $cv->();
372}; 366};
373 367
374=item $cv = $fcp->modify_persistent_request ($global, $identifier[, $client_token[, $priority_class]]) 368=item $cv = $fcp->modify_persistent_request ($global, $identifier[, $client_token[, $priority_class]])
375 369
376=item $status = $fcp->modify_persistent_request_sync ($global, $identifier[, $client_token[, $priority_class]]) 370=item $sync = $fcp->modify_persistent_request_sync ($global, $identifier[, $client_token[, $priority_class]])
377 371
378=cut 372=cut
379 373
380_txn modify_persistent_request => sub { 374_txn modify_persistent_request => sub {
381 my ($self, $cv, $global, $identifier, $client_token, $priority_class) = @_; 375 my ($self, $cv, $global, $identifier, $client_token, $priority_class) = @_;
382 376
383 $self->send_msg (modify_persistent_request => 377 $self->send_msg (modify_persistent_request =>
384 global => $global ? "true" : "false", 378 global => $global ? "true" : "false",
385 identifier => $identifier,
386 defined $client_token ? (client_token => $client_token ) : (), 379 defined $client_token ? (client_token => $client_token ) : (),
387 defined $priority_class ? (priority_class => $priority_class) : (), 380 defined $priority_class ? (priority_class => $priority_class) : (),
381 identifier => $identifier,
388 id_cb => sub { 382 id_cb => sub {
389 my ($self, $type, $kv, $rdata) = @_; 383 my ($self, $type, $kv, $rdata) = @_;
390 384
391 $cv->($kv); 385 $cv->($kv);
392 1 386 1
393 }, 387 },
394 ); 388 );
395
396 $cv->();
397}; 389};
398 390
399=item $cv = $fcp->get_plugin_info ($name, $detailed) 391=item $cv = $fcp->get_plugin_info ($name, $detailed)
400 392
401=item $info = $fcp->get_plugin_info_sync ($name, $detailed) 393=item $info = $fcp->get_plugin_info_sync ($name, $detailed)
… …
413 405
414 $cv->($kv); 406 $cv->($kv);
415 1 407 1
416 }, 408 },
417 ); 409 );
410};
418 411
419 $cv->(); 412=item $cv = $fcp->client_get ($uri, $identifier, %kv)
413
414=item $status = $fcp->client_get_sync ($uri, $identifier, %kv)
415
416%kv can contain (L<http://wiki.freenetproject.org/FCP2p0ClientGet>).
417
418ignore_ds, ds_only, verbosity, max_size, max_temp_size, max_retries,
419priority_class, persistence, client_token, global, return_type,
420binary_blob, allowed_mime_types, filename, temp_filename
421
422=cut
423
424_txn client_get => sub {
425 my ($self, $cv, $uri, $identifier, %kv) = @_;
426
427 $self->send_msg (client_get =>
428 %kv,
429 uri => $uri,
430 identifier => $identifier,
431 id_cb => sub {
432 my ($self, $type, $kv, $rdata) = @_;
433
434 $cv->($kv);
435 1
436 },
437 );
420}; 438};
421 439
422=back 440=back
423 441
424=head1 EXAMPLE PROGRAM 442=head1 EXAMPLE PROGRAM

Diff Legend

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