ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/cvsroot/Net-FCP/FCP.pm
(Generate patch)

Comparing cvsroot/Net-FCP/FCP.pm (file contents):
Revision 1.20 by root, Mon Sep 15 00:05:32 2003 UTC vs.
Revision 1.36 by root, Thu Dec 1 22:07:40 2005 UTC

… …
13 13
14=head1 DESCRIPTION 14=head1 DESCRIPTION
15 15
16See L<http://freenet.sourceforge.net/index.php?page=fcp> for a description 16See L<http://freenet.sourceforge.net/index.php?page=fcp> for a description
17of what the messages do. I am too lazy to document all this here. 17of what the messages do. I am too lazy to document all this here.
18
19The module uses L<AnyEvent> to find a suitable Event module.
18 20
19=head1 WARNING 21=head1 WARNING
20 22
21This module is alpha. While it probably won't destroy (much :) of your 23This module is alpha. While it probably won't destroy (much :) of your
22data, it currently falls short of what it should provide (intelligent uri 24data, it currently falls short of what it should provide (intelligent uri
23following, splitfile downloads, healing...) 25following, splitfile downloads, healing...)
24 26
25=head2 IMPORT TAGS 27=head2 IMPORT TAGS
26 28
27Nothing much can be "imported" from this module right now. There are, 29Nothing much can be "imported" from this module right now.
28however, certain "import tags" that can be used to select the event model
29to be used.
30
31Event models are implemented as modules under the C<Net::FCP::Event::xyz>
32class, where C<xyz> is the event model to use. The default is C<Event> (or
33later C<Auto>).
34
35The import tag to use is named C<event=xyz>, e.g. C<event=Event>,
36C<event=Glib> etc.
37
38You should specify the event module to use only in the main program.
39
40If no event model has been specified, FCP tries to autodetect it on first
41use (e.g. first transaction), in this order: Coro, Event, Glib, Tk.
42 30
43=head2 FREENET BASICS 31=head2 FREENET BASICS
44 32
45Ok, this section will not explain any freenet basics to you, just some 33Ok, this section will not explain any freenet basics to you, just some
46problems I found that you might want to avoid: 34problems I found that you might want to avoid:
… …
72 60
73package Net::FCP; 61package Net::FCP;
74 62
75use Carp; 63use Carp;
76 64
77$VERSION = 0.08; 65$VERSION = '1.0';
78 66
79no warnings; 67no warnings;
80 68
81our $EVENT = Net::FCP::Event::Auto::; 69use AnyEvent;
82 70
83sub import { 71use Net::FCP::Metadata;
84 shift; 72use Net::FCP::Util qw(tolc touc xeh);
85 73
86 for (@_) {
87 if (/^event=(\w+)$/) {
88 $EVENT = "Net::FCP::Event::$1";
89 eval "require $EVENT";
90 }
91 }
92 die $@ if $@;
93}
94
95sub touc($) {
96 local $_ = shift;
97 1 while s/((?:^|_)(?:svk|chk|uri)(?:_|$))/\U$1/;
98 s/(?:^|_)(.)/\U$1/g;
99 $_;
100}
101
102sub tolc($) {
103 local $_ = shift;
104 s/(?<=[a-z])(?=[A-Z])/_/g;
105 lc $_;
106}
107
108=item $meta = Net::FCP::parse_metadata $string
109
110Parse a metadata string and return it.
111
112The metadata will be a hashref with key C<version> (containing
113the mandatory version header entries).
114
115All other headers are represented by arrayrefs (they can be repeated).
116
117Since this is confusing, here is a rather verbose example of a parsed
118manifest:
119
120 (
121 version => { revision => 1 },
122 document => [
123 {
124 info => { format" => "image/jpeg" },
125 name => "background.jpg",
126 redirect => { target => "freenet:CHK\@ZcagI,ra726bSw" },
127 },
128 {
129 info => { format" => "text/html" },
130 name => ".next",
131 redirect => { target => "freenet:SSK\@ilUPAgM/TFEE/3" },
132 },
133 {
134 info => { format" => "text/html" },
135 redirect => { target => "freenet:CHK\@8M8Po8ucwI,8xA" },
136 }
137 ]
138 )
139
140=cut
141
142sub parse_metadata {
143 my $meta;
144
145 my $data = shift;
146 if ($data =~ /^Version\015?\012/gc) {
147 my $hdr = $meta->{version} = {};
148
149 for (;;) {
150 while ($data =~ /\G([^=\015\012]+)=([^\015\012]*)\015?\012/gc) {
151 my ($k, $v) = ($1, $2);
152 my @p = split /\./, tolc $k, 3;
153
154 $hdr->{$p[0]} = $v if @p == 1; # lamest code I ever wrote
155 $hdr->{$p[0]}{$p[1]} = $v if @p == 2;
156 $hdr->{$p[0]}{$p[1]}{$p[2]} = $v if @p == 3;
157 die "FATAL: 4+ dot metadata" if @p >= 4;
158 }
159
160 if ($data =~ /\GEndPart\015?\012/gc) {
161 # nop
162 } elsif ($data =~ /\GEnd(\015?\012|$)/gc) {
163 last;
164 } elsif ($data =~ /\G([A-Za-z0-9.\-]+)\015?\012/gcs) {
165 push @{$meta->{tolc $1}}, $hdr = {};
166 } elsif ($data =~ /\G(.*)/gcs) {
167 print STDERR "metadata format error ($1), please report this string: <<$data>>";
168 die "metadata format error";
169 }
170 }
171 }
172
173 #$meta->{tail} = substr $data, pos $data;
174
175 $meta;
176}
177
178=item $fcp = new Net::FCP [host => $host][, port => $port] 74=item $fcp = new Net::FCP [host => $host][, port => $port][, progress => \&cb]
179 75
180Create a new virtual FCP connection to the given host and port (default 76Create a new virtual FCP connection to the given host and port (default
181127.0.0.1:8481, or the environment variables C<FREDHOST> and C<FREDPORT>). 77127.0.0.1:8481, or the environment variables C<FREDHOST> and C<FREDPORT>).
182 78
183Connections are virtual because no persistent physical connection is 79Connections are virtual because no persistent physical connection is
184established. 80established.
185 81
186=begin comment 82You can install a progress callback that is being called with the Net::FCP
83object, a txn object, the type of the transaction and the attributes. Use
84it like this:
187 85
188However, the existance of the node is checked by executing a 86 sub progress_cb {
189C<ClientHello> transaction. 87 my ($self, $txn, $type, $attr) = @_;
190 88
191=end 89 warn "progress<$txn,$type," . (join ":", %$attr) . ">\n";
90 }
192 91
193=cut 92=cut
194 93
195sub new { 94sub new {
196 my $class = shift; 95 my $class = shift;
197 my $self = bless { @_ }, $class; 96 my $self = bless { @_ }, $class;
198 97
199 $self->{host} ||= $ENV{FREDHOST} || "127.0.0.1"; 98 $self->{host} ||= $ENV{FREDHOST} || "127.0.0.1";
200 $self->{port} ||= $ENV{FREDPORT} || 8481; 99 $self->{port} ||= $ENV{FREDPORT} || 8481;
201 100
202 #$self->{nodehello} = $self->client_hello
203 # or croak "unable to get nodehello from node\n";
204
205 $self; 101 $self;
206} 102}
207 103
208sub progress { 104sub progress {
209 my ($self, $txn, $type, $attr) = @_; 105 my ($self, $txn, $type, $attr) = @_;
210 #warn "progress<$txn,$type," . (join ":", %$attr) . ">\n";
211}
212 106
107 $self->{progress}->($self, $txn, $type, $attr)
108 if $self->{progress};
109}
110
213=item $txn = $fcp->txn(type => attr => val,...) 111=item $txn = $fcp->txn (type => attr => val,...)
214 112
215The low-level interface to transactions. Don't use it. 113The low-level interface to transactions. Don't use it unless you have
216 114"special needs". Instead, use predefiend transactions like this:
217Here are some examples of using transactions:
218 115
219The blocking case, no (visible) transactions involved: 116The blocking case, no (visible) transactions involved:
220 117
221 my $nodehello = $fcp->client_hello; 118 my $nodehello = $fcp->client_hello;
222 119
… …
241sub txn { 138sub txn {
242 my ($self, $type, %attr) = @_; 139 my ($self, $type, %attr) = @_;
243 140
244 $type = touc $type; 141 $type = touc $type;
245 142
246 my $txn = "Net::FCP::Txn::$type"->new(fcp => $self, type => tolc $type, attr => \%attr); 143 my $txn = "Net::FCP::Txn::$type"->new (fcp => $self, type => tolc $type, attr => \%attr);
247 144
248 $txn; 145 $txn;
249} 146}
250 147
251{ # transactions 148{ # transactions
… …
312 my ($self) = @_; 209 my ($self) = @_;
313 210
314 $self->txn ("client_info"); 211 $self->txn ("client_info");
315}); 212});
316 213
317=item $txn = $fcp->txn_generate_chk ($metadata, $data) 214=item $txn = $fcp->txn_generate_chk ($metadata, $data[, $cipher])
318 215
319=item $uri = $fcp->generate_chk ($metadata, $data) 216=item $uri = $fcp->generate_chk ($metadata, $data[, $cipher])
320 217
321Creates a new CHK, given the metadata and data. UNTESTED. 218Calculates a CHK, given the metadata and data. C<$cipher> is either
219C<Rijndael> or C<Twofish>, with the latter being the default.
322 220
323=cut 221=cut
324 222
325$txn->(generate_chk => sub { 223$txn->(generate_chk => sub {
326 my ($self, $metadata, $data) = @_; 224 my ($self, $metadata, $data, $cipher) = @_;
327 225
328 $self->txn (generate_chk => data => "$metadata$data", metadata_length => length $metadata); 226 $metadata = Net::FCP::Metadata::build_metadata $metadata;
227
228 $self->txn (generate_chk =>
229 data => "$metadata$data",
230 metadata_length => xeh length $metadata,
231 cipher => $cipher || "Twofish");
329}); 232});
330 233
331=item $txn = $fcp->txn_generate_svk_pair 234=item $txn = $fcp->txn_generate_svk_pair
332 235
333=item ($public, $private) = @{ $fcp->generate_svk_pair } 236=item ($public, $private, $crypto) = @{ $fcp->generate_svk_pair }
334 237
335Creates a new SVK pair. Returns an arrayref. 238Creates a new SVK pair. Returns an arrayref with the public key, the
239private key and a crypto key, which is just additional entropy.
336 240
337 [ 241 [
338 "hKs0-WDQA4pVZyMPKNFsK1zapWY", 242 "acLx4dux9fvvABH15Gk6~d3I-yw",
339 "ZnmvMITaTXBMFGl4~jrjuyWxOWg" 243 "cPoDkDMXDGSMM32plaPZDhJDxSs",
244 "BH7LXCov0w51-y9i~BoB3g",
340 ] 245 ]
246
247A private key (for inserting) can be constructed like this:
248
249 SSK@<private_key>,<crypto_key>/<name>
250
251It can be used to insert data. The corresponding public key looks like this:
252
253 SSK@<public_key>PAgM,<crypto_key>/<name>
254
255Watch out for the C<PAgM>-part!
341 256
342=cut 257=cut
343 258
344$txn->(generate_svk_pair => sub { 259$txn->(generate_svk_pair => sub {
345 my ($self) = @_; 260 my ($self) = @_;
346 261
347 $self->txn ("generate_svk_pair"); 262 $self->txn ("generate_svk_pair");
348}); 263});
349 264
350=item $txn = $fcp->txn_insert_private_key ($private) 265=item $txn = $fcp->txn_invert_private_key ($private)
351 266
352=item $public = $fcp->insert_private_key ($private) 267=item $public = $fcp->invert_private_key ($private)
353 268
354Inserts a private key. $private can be either an insert URI (must start 269Inverts a private key (returns the public key). C<$private> can be either
355with C<freenet:SSK@>) or a raw private key (i.e. the private value you get 270an insert URI (must start with C<freenet:SSK@>) or a raw private key (i.e.
356back from C<generate_svk_pair>). 271the private value you get back from C<generate_svk_pair>).
357 272
358Returns the public key. 273Returns the public key.
359 274
360UNTESTED.
361
362=cut 275=cut
363 276
364$txn->(insert_private_key => sub { 277$txn->(invert_private_key => sub {
365 my ($self, $privkey) = @_; 278 my ($self, $privkey) = @_;
366 279
367 $self->txn (invert_private_key => private => $privkey); 280 $self->txn (invert_private_key => private => $privkey);
368}); 281});
369 282
… …
372=item $length = $fcp->get_size ($uri) 285=item $length = $fcp->get_size ($uri)
373 286
374Finds and returns the size (rounded up to the nearest power of two) of the 287Finds and returns the size (rounded up to the nearest power of two) of the
375given document. 288given document.
376 289
377UNTESTED.
378
379=cut 290=cut
380 291
381$txn->(get_size => sub { 292$txn->(get_size => sub {
382 my ($self, $uri) = @_; 293 my ($self, $uri) = @_;
383 294
… …
386 297
387=item $txn = $fcp->txn_client_get ($uri [, $htl = 15 [, $removelocal = 0]]) 298=item $txn = $fcp->txn_client_get ($uri [, $htl = 15 [, $removelocal = 0]])
388 299
389=item ($metadata, $data) = @{ $fcp->client_get ($uri, $htl, $removelocal) 300=item ($metadata, $data) = @{ $fcp->client_get ($uri, $htl, $removelocal)
390 301
391Fetches a (small, as it should fit into memory) file from 302Fetches a (small, as it should fit into memory) key content block from
392freenet. C<$meta> is the metadata (as returned by C<parse_metadata> or 303freenet. C<$meta> is a C<Net::FCP::Metadata> object or C<undef>).
393C<undef>).
394 304
395Due to the overhead, a better method to download big files should be used. 305The C<$uri> should begin with C<freenet:>, but the scheme is currently
306added, if missing.
396 307
397 my ($meta, $data) = @{ 308 my ($meta, $data) = @{
398 $fcp->client_get ( 309 $fcp->client_get (
399 "freenet:CHK@hdXaxkwZ9rA8-SidT0AN-bniQlgPAwI,XdCDmBuGsd-ulqbLnZ8v~w" 310 "freenet:CHK@hdXaxkwZ9rA8-SidT0AN-bniQlgPAwI,XdCDmBuGsd-ulqbLnZ8v~w"
400 ) 311 )
… …
403=cut 314=cut
404 315
405$txn->(client_get => sub { 316$txn->(client_get => sub {
406 my ($self, $uri, $htl, $removelocal) = @_; 317 my ($self, $uri, $htl, $removelocal) = @_;
407 318
319 $uri =~ s/^freenet://; $uri = "freenet:$uri";
320
408 $self->txn (client_get => URI => $uri, hops_to_live => (defined $htl ? $htl :15), 321 $self->txn (client_get => URI => $uri, hops_to_live => xeh (defined $htl ? $htl : 15),
409 remove_local_key => $removelocal ? "true" : "false"); 322 remove_local_key => $removelocal ? "true" : "false");
410}); 323});
411 324
412=item $txn = $fcp->txn_client_put ($uri, $metadata, $data, $htl, $removelocal) 325=item $txn = $fcp->txn_client_put ($uri, $metadata, $data, $htl, $removelocal)
413 326
414=item my $uri = $fcp->client_put ($uri, $metadata, $data, $htl, $removelocal); 327=item my $uri = $fcp->client_put ($uri, $metadata, $data, $htl, $removelocal);
415 328
416Insert a new key. If the client is inserting a CHK, the URI may be 329Insert a new key. If the client is inserting a CHK, the URI may be
417abbreviated as just CHK@. In this case, the node will calculate the 330abbreviated as just CHK@. In this case, the node will calculate the
418CHK. 331CHK. If the key is a private SSK key, the node will calculcate the public
332key and the resulting public URI.
419 333
420C<$meta> can be a reference or a string (ONLY THE STRING CASE IS IMPLEMENTED!). 334C<$meta> can be a hash reference (same format as returned by
335C<Net::FCP::parse_metadata>) or a string.
421 336
422THIS INTERFACE IS UNTESTED AND SUBJECT TO CHANGE. 337The result is an arrayref with the keys C<uri>, C<public_key> and C<private_key>.
423 338
424=cut 339=cut
425 340
426$txn->(client_put => sub { 341$txn->(client_put => sub {
427 my ($self, $uri, $meta, $data, $htl, $removelocal) = @_; 342 my ($self, $uri, $metadata, $data, $htl, $removelocal) = @_;
428 343
429 $self->txn (client_put => URI => $uri, hops_to_live => (defined $htl ? $htl :15), 344 $metadata = Net::FCP::Metadata::build_metadata $metadata;
345 $uri =~ s/^freenet://; $uri = "freenet:$uri";
346
347 $self->txn (client_put => URI => $uri,
348 hops_to_live => xeh (defined $htl ? $htl : 15),
430 remove_local_key => $removelocal ? "true" : "false", 349 remove_local_key => $removelocal ? "true" : "false",
431 data => "$meta$data", metadata_length => length $meta); 350 data => "$metadata$data", metadata_length => xeh length $metadata);
432}); 351});
433 352
434} # transactions 353} # transactions
435 354
436=item MISSING: (ClientPut), InsretKey
437
438=back 355=back
439 356
440=head2 THE Net::FCP::Txn CLASS 357=head2 THE Net::FCP::Txn CLASS
441 358
442All requests (or transactions) are executed in a asynchroneous way (LIE: 359All requests (or transactions) are executed in a asynchronous way. For
443uploads are blocking). For each request, a C<Net::FCP::Txn> object is 360each request, a C<Net::FCP::Txn> object is created (worse: a tcp
444created (worse: a tcp connection is created, too). 361connection is created, too).
445 362
446For each request there is actually a different subclass (and it's possible 363For each request there is actually a different subclass (and it's possible
447to subclass these, although of course not documented). 364to subclass these, although of course not documented).
448 365
449The most interesting method is C<result>. 366The most interesting method is C<result>.
… …
465 382
466sub new { 383sub new {
467 my $class = shift; 384 my $class = shift;
468 my $self = bless { @_ }, $class; 385 my $self = bless { @_ }, $class;
469 386
470 $self->{signal} = $EVENT->new_signal; 387 $self->{signal} = AnyEvent->condvar;
471 388
472 $self->{fcp}{txn}{$self} = $self; 389 $self->{fcp}{txn}{$self} = $self;
473 390
474 my $attr = ""; 391 my $attr = "";
475 my $data = delete $self->{attr}{data}; 392 my $data = delete $self->{attr}{data};
… …
477 while (my ($k, $v) = each %{$self->{attr}}) { 394 while (my ($k, $v) = each %{$self->{attr}}) {
478 $attr .= (Net::FCP::touc $k) . "=$v\012" 395 $attr .= (Net::FCP::touc $k) . "=$v\012"
479 } 396 }
480 397
481 if (defined $data) { 398 if (defined $data) {
482 $attr .= "DataLength=" . (length $data) . "\012"; 399 $attr .= sprintf "DataLength=%x\012", length $data;
483 $data = "Data\012$data"; 400 $data = "Data\012$data";
484 } else { 401 } else {
485 $data = "EndMessage\012"; 402 $data = "EndMessage\012";
486 } 403 }
487 404
… …
494 and !$!{EINPROGRESS} 411 and !$!{EINPROGRESS}
495 and Carp::croak "FCP::txn: unable to connect to $self->{fcp}{host}:$self->{fcp}{port}: $!\n"; 412 and Carp::croak "FCP::txn: unable to connect to $self->{fcp}{host}:$self->{fcp}{port}: $!\n";
496 413
497 $self->{sbuf} = 414 $self->{sbuf} =
498 "\x00\x00\x00\x02" 415 "\x00\x00\x00\x02"
499 . Net::FCP::touc $self->{type} 416 . (Net::FCP::touc $self->{type})
500 . "\012$attr$data"; 417 . "\012$attr$data";
501 418
502 #$fh->shutdown (1); # freenet buggy?, well, it's java... 419 #shutdown $fh, 1; # freenet buggy?, well, it's java...
503 420
504 $self->{fh} = $fh; 421 $self->{fh} = $fh;
505 422
506 $self->{w} = $EVENT->new_from_fh ($fh)->cb(sub { $self->fh_ready_w })->poll(0, 1, 1); 423 $self->{w} = AnyEvent->io (fh => $fh, poll => 'w', cb => sub { $self->fh_ready_w });
507 424
508 $self; 425 $self;
509} 426}
510 427
511=item $txn = $txn->cb ($coderef) 428=item $txn = $txn->cb ($coderef)
… …
547 $self; 464 $self;
548} 465}
549 466
550=item $txn->cancel (%attr) 467=item $txn->cancel (%attr)
551 468
552Cancels the operation with a C<cancel> exception anf the given attributes 469Cancels the operation with a C<cancel> exception and the given attributes
553(consider at least giving the attribute C<reason>). 470(consider at least giving the attribute C<reason>).
554 471
555UNTESTED. 472UNTESTED.
556 473
557=cut 474=cut
… …
570 487
571 if ($len > 0) { 488 if ($len > 0) {
572 substr $self->{sbuf}, 0, $len, ""; 489 substr $self->{sbuf}, 0, $len, "";
573 unless (length $self->{sbuf}) { 490 unless (length $self->{sbuf}) {
574 fcntl $self->{fh}, F_SETFL, 0; 491 fcntl $self->{fh}, F_SETFL, 0;
575 $self->{w}->cb(sub { $self->fh_ready_r })->poll (1, 0, 1); 492 undef $self->{w}; #d# #workaround for buggy Tk versions
493 $self->{w} = AnyEvent->io (fh => $self->{fh}, poll => 'r', cb => sub { $self->fh_ready_r });
576 } 494 }
577 } elsif (defined $len) { 495 } elsif (defined $len) {
578 $self->throw (Net::FCP::Exception->new (network_error => { reason => "unexpected end of file while writing" })); 496 $self->throw (Net::FCP::Exception->new (network_error => { reason => "unexpected end of file while writing" }));
579 } else { 497 } else {
580 $self->throw (Net::FCP::Exception->new (network_error => { reason => "$!" })); 498 $self->throw (Net::FCP::Exception->new (network_error => { reason => "$!" }));
… …
645 my ($self, $result) = @_; 563 my ($self, $result) = @_;
646 564
647 unless (exists $self->{result}) { 565 unless (exists $self->{result}) {
648 $self->{result} = $result; 566 $self->{result} = $result;
649 $self->{cb}->($self) if exists $self->{cb}; 567 $self->{cb}->($self) if exists $self->{cb};
650 $self->{signal}->send; 568 $self->{signal}->broadcast;
651 } 569 }
652} 570}
653 571
654sub eof { 572sub eof {
655 my ($self) = @_; 573 my ($self) = @_;
… …
666 } 584 }
667} 585}
668 586
669sub progress { 587sub progress {
670 my ($self, $type, $attr) = @_; 588 my ($self, $type, $attr) = @_;
589
671 $self->{fcp}->progress ($self, $type, $attr); 590 $self->{fcp}->progress ($self, $type, $attr);
672} 591}
673 592
674=item $result = $txn->result 593=item $result = $txn->result
675 594
676Waits until a result is available and then returns it. 595Waits until a result is available and then returns it.
677 596
678This waiting is (depending on your event model) not very efficient, as it 597This waiting is (depending on your event model) not very efficient, as it
679is done outside the "mainloop". 598is done outside the "mainloop". The biggest problem, however, is that it's
599blocking one thread of execution. Try to use the callback mechanism, if
600possible, and call result from within the callback (or after is has been
601run), as then no waiting is necessary.
680 602
681=cut 603=cut
682 604
683sub result { 605sub result {
684 my ($self) = @_; 606 my ($self) = @_;
… …
715use base Net::FCP::Txn; 637use base Net::FCP::Txn;
716 638
717sub rcv_success { 639sub rcv_success {
718 my ($self, $attr) = @_; 640 my ($self, $attr) = @_;
719 641
720 $self->set_result ($attr); 642 $self->set_result ($attr->{uri});
721} 643}
722 644
723package Net::FCP::Txn::GenerateSVKPair; 645package Net::FCP::Txn::GenerateSVKPair;
724 646
725use base Net::FCP::Txn; 647use base Net::FCP::Txn;
726 648
727sub rcv_success { 649sub rcv_success {
728 my ($self, $attr) = @_; 650 my ($self, $attr) = @_;
729 $self->set_result ([$attr->{PublicKey}, $attr->{PrivateKey}]); 651 $self->set_result ([$attr->{public_key}, $attr->{private_key}, $attr->{crypto_key}]);
730} 652}
731 653
732package Net::FCP::Txn::InsertPrivateKey; 654package Net::FCP::Txn::InvertPrivateKey;
733 655
734use base Net::FCP::Txn; 656use base Net::FCP::Txn;
735 657
736sub rcv_success { 658sub rcv_success {
737 my ($self, $attr) = @_; 659 my ($self, $attr) = @_;
738 $self->set_result ($attr->{PublicKey}); 660 $self->set_result ($attr->{public_key});
739} 661}
740 662
741package Net::FCP::Txn::GetSize; 663package Net::FCP::Txn::GetSize;
742 664
743use base Net::FCP::Txn; 665use base Net::FCP::Txn;
744 666
745sub rcv_success { 667sub rcv_success {
746 my ($self, $attr) = @_; 668 my ($self, $attr) = @_;
747 $self->set_result ($attr->{Length}); 669 $self->set_result (hex $attr->{length});
748} 670}
749 671
750package Net::FCP::Txn::GetPut; 672package Net::FCP::Txn::GetPut;
751 673
752# base class for get and put 674# base class for get and put
753 675
754use base Net::FCP::Txn; 676use base Net::FCP::Txn;
755 677
756*rcv_uri_error = \&Net::FCP::Txn::rcv_throw_exception; 678*rcv_uri_error = \&Net::FCP::Txn::rcv_throw_exception;
757*rcv_route_not_found = \&Net::FCP::Txn::rcv_throw_exception; 679*rcv_route_not_found = \&Net::FCP::Txn::rcv_throw_exception;
758 680
759sub rcv_restarted { 681sub rcv_restarted {
760 my ($self, $attr, $type) = @_; 682 my ($self, $attr, $type) = @_;
761 683
762 delete $self->{datalength}; 684 delete $self->{datalength};
… …
779 701
780 $self->progress ("data", { chunk => length $chunk, received => length $self->{data}, total => $self->{datalength} }); 702 $self->progress ("data", { chunk => length $chunk, received => length $self->{data}, total => $self->{datalength} });
781 703
782 if ($self->{datalength} == length $self->{data}) { 704 if ($self->{datalength} == length $self->{data}) {
783 my $data = delete $self->{data}; 705 my $data = delete $self->{data};
784 my $meta = Net::FCP::parse_metadata substr $data, 0, $self->{metalength}, ""; 706 my $meta = new Net::FCP::Metadata (substr $data, 0, $self->{metalength}, "");
785 707
786 $self->set_result ([$meta, $data]); 708 $self->set_result ([$meta, $data]);
709 $self->eof;
787 } 710 }
788} 711}
789 712
790sub rcv_data_found { 713sub rcv_data_found {
791 my ($self, $attr, $type) = @_; 714 my ($self, $attr, $type) = @_;
… …
799package Net::FCP::Txn::ClientPut; 722package Net::FCP::Txn::ClientPut;
800 723
801use base Net::FCP::Txn::GetPut; 724use base Net::FCP::Txn::GetPut;
802 725
803*rcv_size_error = \&Net::FCP::Txn::rcv_throw_exception; 726*rcv_size_error = \&Net::FCP::Txn::rcv_throw_exception;
804*rcv_key_collision = \&Net::FCP::Txn::rcv_throw_exception;
805 727
806sub rcv_pending { 728sub rcv_pending {
807 my ($self, $attr, $type) = @_; 729 my ($self, $attr, $type) = @_;
808 $self->progress ($type, $attr); 730 $self->progress ($type, $attr);
809} 731}
… …
811sub rcv_success { 733sub rcv_success {
812 my ($self, $attr, $type) = @_; 734 my ($self, $attr, $type) = @_;
813 $self->set_result ($attr); 735 $self->set_result ($attr);
814} 736}
815 737
738sub rcv_key_collision {
739 my ($self, $attr, $type) = @_;
740 $self->set_result ({ key_collision => 1, %$attr });
741}
742
816=back 743=back
817 744
818=head2 The Net::FCP::Exception CLASS 745=head2 The Net::FCP::Exception CLASS
819 746
820Any unexpected (non-standard) responses that make it impossible to return 747Any unexpected (non-standard) responses that make it impossible to return
… …
829 756
830package Net::FCP::Exception; 757package Net::FCP::Exception;
831 758
832use overload 759use overload
833 '""' => sub { 760 '""' => sub {
834 "Net::FCP::Exception<<$_[0][0]," . (join ":", %{$_[0][1]}) . ">>\n"; 761 "Net::FCP::Exception<<$_[0][0]," . (join ":", %{$_[0][1]}) . ">>";
835 }; 762 };
836 763
837=item $exc = new Net::FCP::Exception $type, \%attr 764=item $exc = new Net::FCP::Exception $type, \%attr
838 765
839Create a new exception object of the given type (a string like 766Create a new exception object of the given type (a string like
… …
886 813
887=head1 BUGS 814=head1 BUGS
888 815
889=head1 AUTHOR 816=head1 AUTHOR
890 817
891 Marc Lehmann <pcg@goof.com> 818 Marc Lehmann <schmorp@schmorp.de>
892 http://www.goof.com/pcg/marc/ 819 http://home.schmorp.de/
893 820
894=cut 821=cut
895 822
896package Net::FCP::Event::Auto; 8231
897 824
898my @models = (
899 [Coro => Coro::Event:: ],
900 [Event => Event::],
901 [Glib => Glib:: ],
902 [Tk => Tk::],
903);
904
905sub AUTOLOAD {
906 $AUTOLOAD =~ s/.*://;
907
908 for (@models) {
909 my ($model, $package) = @$_;
910 if (defined ${"$package\::VERSION"}) {
911 $EVENT = "Net::FCP::Event::$model";
912 eval "require $EVENT"; die if $@;
913 goto &{"$EVENT\::$AUTOLOAD"};
914 }
915 }
916
917 for (@models) {
918 my ($model, $package) = @$_;
919 $EVENT = "Net::FCP::Event::$model";
920 if (eval "require $EVENT") {
921 goto &{"$EVENT\::$AUTOLOAD"};
922 }
923 }
924
925 die "No event module selected for Net::FCP and autodetect failed. Install any of these: Coro, Event, Glib or Tk.";
926}
927
9281;
929

Diff Legend

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