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.8 by root, Fri Jun 18 16:59:13 2010 UTC

… …
6 6
7 use AnyEvent::FCP; 7 use AnyEvent::FCP;
8 8
9 my $fcp = new AnyEvent::FCP; 9 my $fcp = new AnyEvent::FCP;
10 10
11# transactions return condvars 11 # transactions return condvars
12 my $lp_cv = $fcp->list_peers; 12 my $lp_cv = $fcp->list_peers;
13 my $pr_cv = $fcp->list_persistent_requests; 13 my $pr_cv = $fcp->list_persistent_requests;
14 14
15 my $peers = $lp_cv->recv; 15 my $peers = $lp_cv->recv;
16 my $reqs = $pr_cv->recv; 16 my $reqs = $pr_cv->recv;
… …
26The module uses L<AnyEvent> to find a suitable event module. 26The module uses L<AnyEvent> to find a suitable event module.
27 27
28Only very little is implemented, ask if you need more, and look at the 28Only very little is implemented, ask if you need more, and look at the
29example program later in this section. 29example program later in this section.
30 30
31=head2 EXAMPLE
32
33This example fetches the download list and sets the priority of all files
34with "a" in their name to "emergency":
35
36 use AnyEvent::FCP;
37
38 my $fcp = new AnyEvent::FCP;
39
40 $fcp->watch_global_sync (1, 0);
41 my $req = $fcp->list_persistent_requests_sync;
42
43 for my $req (values %$req) {
44 if ($req->{filename} =~ /a/) {
45 $fcp->modify_persistent_request_sync (1, $req->{identifier}, undef, 0);
46 }
47 }
48
31=head2 IMPORT TAGS 49=head2 IMPORT TAGS
32 50
33Nothing much can be "imported" from this module right now. 51Nothing much can be "imported" from this module right now.
34 52
35=head2 THE AnyEvent::FCP CLASS 53=head2 THE AnyEvent::FCP CLASS
… …
42 60
43use common::sense; 61use common::sense;
44 62
45use Carp; 63use Carp;
46 64
47our $VERSION = '0.2'; 65our $VERSION = '0.3';
48 66
49use Scalar::Util (); 67use Scalar::Util ();
50 68
51use AnyEvent; 69use AnyEvent;
52use AnyEvent::Handle; 70use AnyEvent::Handle;
53 71
54sub touc($) { 72sub touc($) {
55 local $_ = shift; 73 local $_ = shift;
56 1 while s/((?:^|_)(?:svk|chk|uri|fcp)(?:_|$))/\U$1/; 74 1 while s/((?:^|_)(?:svk|chk|uri|fcp|ds|mime)(?:_|$))/\U$1/;
57 s/(?:^|_)(.)/\U$1/g; 75 s/(?:^|_)(.)/\U$1/g;
58 $_ 76 $_
59} 77}
60 78
61sub tolc($) { 79sub tolc($) {
62 local $_ = shift; 80 local $_ = shift;
63 1 while s/(SVK|CHK|URI|FCP)([^_])/$1\_$2/i; 81 1 while s/(SVK|CHK|URI|FCP|DS|MIME)([^_])/$1\_$2/i;
64 1 while s/([^_])(SVK|CHK|URI|FCP)/$1\_$2/i; 82 1 while s/([^_])(SVK|CHK|URI|FCP|DS|MIME)/$1\_$2/i;
65 s/(?<=[a-z])(?=[A-Z])/_/g; 83 s/(?<=[a-z])(?=[A-Z])/_/g;
66 lc 84 lc
67} 85}
68 86
69=item $fcp = new AnyEvent::FCP [host => $host][, port => $port][, progress => \&cb][, name => $name] 87=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>). 90127.0.0.1:9481, or the environment variables C<FREDHOST> and C<FREDPORT>).
73 91
74If no C<name> was specified, then AnyEvent::FCP will generate a 92If no C<name> was specified, then AnyEvent::FCP will generate a
75(hopefully) unique client name for you. 93(hopefully) unique client name for you.
76 94
77=cut
78
79#TODO
80#You can install a progress callback that is being called with the AnyEvent::FCP 95You 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 96object, the type, a hashref with key-value pairs and a reference to any received data,
82#it like this: 97for all unsolicited messages.
83# 98
99Example:
100
84# sub progress_cb { 101 sub progress_cb {
85# my ($self, $txn, $type, $attr) = @_; 102 my ($self, $type, $kv, $rdata) = @_;
86# 103
87# warn "progress<$txn,$type," . (join ":", %$attr) . ">\n"; 104 if ($type eq "simple_progress") {
105 warn "$kv->{identifier} $kv->{succeeded}/$kv->{required}\n";
106 }
88# } 107 }
108
109=cut
89 110
90sub new { 111sub new {
91 my $class = shift; 112 my $class = shift;
92 my $self = bless { @_ }, $class; 113 my $self = bless { @_ }, $class;
93 114
94 $self->{host} ||= $ENV{FREDHOST} || "127.0.0.1"; 115 $self->{host} ||= $ENV{FREDHOST} || "127.0.0.1";
95 $self->{port} ||= $ENV{FREDPORT} || 9481; 116 $self->{port} ||= $ENV{FREDPORT} || 9481;
96 $self->{name} ||= time.rand.rand.rand; # lame 117 $self->{name} ||= time.rand.rand.rand; # lame
97 $self->{timeout} ||= 600; 118 $self->{timeout} ||= 3600*2;
119 $self->{progress} ||= sub { };
98 120
99 $self->{id} = "a0"; 121 $self->{id} = "a0";
100 122
101 { 123 {
102 Scalar::Util::weaken (my $self = $self); 124 Scalar::Util::weaken (my $self = $self);
103 125
104 $self->{hdl} = new AnyEvent::Handle 126 $self->{hdl} = new AnyEvent::Handle
105 connect => [$self->{host} => $self->{port}], 127 connect => [$self->{host} => $self->{port}],
106 timeout => $self->{timeout}, 128 timeout => $self->{timeout},
107 on_error => sub { 129 on_error => sub {
108 warn "<@_>\n"; 130 warn "@_\n";#d#
109 exit 1; 131 exit 1;
110 }, 132 },
111 on_read => sub { $self->on_read (@_) }, 133 on_read => sub { $self->on_read (@_) },
112 on_eof => $self->{on_eof} || sub { }; 134 on_eof => $self->{on_eof} || sub { };
113 135
… …
120 expected_version => "2.0", 142 expected_version => "2.0",
121 ); 143 );
122 144
123 $self 145 $self
124} 146}
125
126#sub progress {
127# my ($self, $txn, $type, $attr) = @_;
128#
129# $self->{progress}->($self, $txn, $type, $attr)
130# if $self->{progress};
131#}
132 147
133sub send_msg { 148sub send_msg {
134 my ($self, $type, %kv) = @_; 149 my ($self, $type, %kv) = @_;
135 150
136 my $data = delete $kv{data}; 151 my $data = delete $kv{data};
… …
221 $self->{node_hello} = $kv; 236 $self->{node_hello} = $kv;
222 } elsif (exists $self->{id}{$kv->{identifier}}) { 237 } elsif (exists $self->{id}{$kv->{identifier}}) {
223 $self->{id}{$kv->{identifier}}($self, $type, $kv, $rdata) 238 $self->{id}{$kv->{identifier}}($self, $type, $kv, $rdata)
224 and delete $self->{id}{$kv->{identifier}}; 239 and delete $self->{id}{$kv->{identifier}};
225 } else { 240 } else {
226 # on_warn 241 &{ $self->{progress} };
227 #warn "protocol warning (unexpected $type message)\n";
228 } 242 }
229} 243}
230 244
231sub _txn { 245sub _txn {
232 my ($name, $sub) = @_; 246 my ($name, $sub) = @_;
… …
365 379
366 $cv->($kv); 380 $cv->($kv);
367 1 381 1
368 }, 382 },
369 ); 383 );
370
371 $cv->();
372}; 384};
373 385
374=item $cv = $fcp->modify_persistent_request ($global, $identifier[, $client_token[, $priority_class]]) 386=item $cv = $fcp->modify_persistent_request ($global, $identifier[, $client_token[, $priority_class]])
375 387
376=item $status = $fcp->modify_persistent_request_sync ($global, $identifier[, $client_token[, $priority_class]]) 388=item $sync = $fcp->modify_persistent_request_sync ($global, $identifier[, $client_token[, $priority_class]])
377 389
378=cut 390=cut
379 391
380_txn modify_persistent_request => sub { 392_txn modify_persistent_request => sub {
381 my ($self, $cv, $global, $identifier, $client_token, $priority_class) = @_; 393 my ($self, $cv, $global, $identifier, $client_token, $priority_class) = @_;
382 394
383 $self->send_msg (modify_persistent_request => 395 $self->send_msg (modify_persistent_request =>
384 global => $global ? "true" : "false", 396 global => $global ? "true" : "false",
385 identifier => $identifier,
386 defined $client_token ? (client_token => $client_token ) : (), 397 defined $client_token ? (client_token => $client_token ) : (),
387 defined $priority_class ? (priority_class => $priority_class) : (), 398 defined $priority_class ? (priority_class => $priority_class) : (),
399 identifier => $identifier,
388 id_cb => sub { 400 id_cb => sub {
389 my ($self, $type, $kv, $rdata) = @_; 401 my ($self, $type, $kv, $rdata) = @_;
390 402
391 $cv->($kv); 403 $cv->($kv);
392 1 404 1
393 }, 405 },
394 ); 406 );
395
396 $cv->();
397}; 407};
398 408
399=item $cv = $fcp->get_plugin_info ($name, $detailed) 409=item $cv = $fcp->get_plugin_info ($name, $detailed)
400 410
401=item $info = $fcp->get_plugin_info_sync ($name, $detailed) 411=item $info = $fcp->get_plugin_info_sync ($name, $detailed)
… …
413 423
414 $cv->($kv); 424 $cv->($kv);
415 1 425 1
416 }, 426 },
417 ); 427 );
428};
418 429
419 $cv->(); 430=item $cv = $fcp->client_get ($uri, $identifier, %kv)
431
432=item $status = $fcp->client_get_sync ($uri, $identifier, %kv)
433
434%kv can contain (L<http://wiki.freenetproject.org/FCP2p0ClientGet>).
435
436ignore_ds, ds_only, verbosity, max_size, max_temp_size, max_retries,
437priority_class, persistence, client_token, global, return_type,
438binary_blob, allowed_mime_types, filename, temp_filename
439
440=cut
441
442_txn client_get => sub {
443 my ($self, $cv, $uri, $identifier, %kv) = @_;
444
445 $self->send_msg (client_get =>
446 %kv,
447 uri => $uri,
448 identifier => $identifier,
449 id_cb => sub {
450 my ($self, $type, $kv, $rdata) = @_;
451
452 $cv->($kv);
453 1
454 },
455 );
420}; 456};
421 457
422=back 458=back
423 459
424=head1 EXAMPLE PROGRAM 460=head1 EXAMPLE PROGRAM

Diff Legend

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