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.21 by root, Tue Sep 16 07:00:59 2003 UTC vs.
Revision 1.38 by root, Mon Nov 27 13:16:25 2006 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 the
113mandatory version header entries) and key C<raw> containing the original
114metadata string.
115
116All other headers are represented by arrayrefs (they can be repeated).
117
118Since this description is confusing, here is a rather verbose example of a
119parsed manifest:
120
121 (
122 raw => "Version...",
123 version => { revision => 1 },
124 document => [
125 {
126 info => { format" => "image/jpeg" },
127 name => "background.jpg",
128 redirect => { target => "freenet:CHK\@ZcagI,ra726bSw" },
129 },
130 {
131 info => { format" => "text/html" },
132 name => ".next",
133 redirect => { target => "freenet:SSK\@ilUPAgM/TFEE/3" },
134 },
135 {
136 info => { format" => "text/html" },
137 redirect => { target => "freenet:CHK\@8M8Po8ucwI,8xA" },
138 }
139 ]
140 )
141
142=cut
143
144sub parse_metadata {
145 my $data = shift;
146 my $meta = { raw => $data };
147
148 if ($data =~ /^Version\015?\012/gc) {
149 my $hdr = $meta->{version} = {};
150
151 for (;;) {
152 while ($data =~ /\G([^=\015\012]+)=([^\015\012]*)\015?\012/gc) {
153 my ($k, $v) = ($1, $2);
154 my @p = split /\./, tolc $k, 3;
155
156 $hdr->{$p[0]} = $v if @p == 1; # lamest code I ever wrote
157 $hdr->{$p[0]}{$p[1]} = $v if @p == 2;
158 $hdr->{$p[0]}{$p[1]}{$p[2]} = $v if @p == 3;
159 die "FATAL: 4+ dot metadata" if @p >= 4;
160 }
161
162 if ($data =~ /\GEndPart\015?\012/gc) {
163 # nop
164 } elsif ($data =~ /\GEnd(\015?\012|$)/gc) {
165 last;
166 } elsif ($data =~ /\G([A-Za-z0-9.\-]+)\015?\012/gcs) {
167 push @{$meta->{tolc $1}}, $hdr = {};
168 } elsif ($data =~ /\G(.*)/gcs) {
169 print STDERR "metadata format error ($1), please report this string: <<$data>>";
170 die "metadata format error";
171 }
172 }
173 }
174
175 #$meta->{tail} = substr $data, pos $data;
176
177 $meta;
178}
179
180=item $fcp = new Net::FCP [host => $host][, port => $port] 74=item $fcp = new Net::FCP [host => $host][, port => $port][, progress => \&cb]
181 75
182Create 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
183127.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>).
184 78
185Connections are virtual because no persistent physical connection is 79Connections are virtual because no persistent physical connection is
186established. 80established.
187 81
188=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:
189 85
190However, the existance of the node is checked by executing a 86 sub progress_cb {
191C<ClientHello> transaction. 87 my ($self, $txn, $type, $attr) = @_;
192 88
193=end 89 warn "progress<$txn,$type," . (join ":", %$attr) . ">\n";
90 }
194 91
195=cut 92=cut
196 93
197sub new { 94sub new {
198 my $class = shift; 95 my $class = shift;
199 my $self = bless { @_ }, $class; 96 my $self = bless { @_ }, $class;
200 97
201 $self->{host} ||= $ENV{FREDHOST} || "127.0.0.1"; 98 $self->{host} ||= $ENV{FREDHOST} || "127.0.0.1";
202 $self->{port} ||= $ENV{FREDPORT} || 8481; 99 $self->{port} ||= $ENV{FREDPORT} || 8481;
203 100
204 #$self->{nodehello} = $self->client_hello
205 # or croak "unable to get nodehello from node\n";
206
207 $self; 101 $self;
208} 102}
209 103
210sub progress { 104sub progress {
211 my ($self, $txn, $type, $attr) = @_; 105 my ($self, $txn, $type, $attr) = @_;
212 #warn "progress<$txn,$type," . (join ":", %$attr) . ">\n";
213}
214 106
107 $self->{progress}->($self, $txn, $type, $attr)
108 if $self->{progress};
109}
110
215=item $txn = $fcp->txn(type => attr => val,...) 111=item $txn = $fcp->txn (type => attr => val,...)
216 112
217The low-level interface to transactions. Don't use it. 113The low-level interface to transactions. Don't use it unless you have
218 114"special needs". Instead, use predefiend transactions like this:
219Here are some examples of using transactions:
220 115
221The blocking case, no (visible) transactions involved: 116The blocking case, no (visible) transactions involved:
222 117
223 my $nodehello = $fcp->client_hello; 118 my $nodehello = $fcp->client_hello;
224 119
… …
243sub txn { 138sub txn {
244 my ($self, $type, %attr) = @_; 139 my ($self, $type, %attr) = @_;
245 140
246 $type = touc $type; 141 $type = touc $type;
247 142
248 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);
249 144
250 $txn; 145 $txn;
251} 146}
252 147
253{ # transactions 148{ # transactions
… …
318 213
319=item $txn = $fcp->txn_generate_chk ($metadata, $data[, $cipher]) 214=item $txn = $fcp->txn_generate_chk ($metadata, $data[, $cipher])
320 215
321=item $uri = $fcp->generate_chk ($metadata, $data[, $cipher]) 216=item $uri = $fcp->generate_chk ($metadata, $data[, $cipher])
322 217
323Calculcates a CHK, given the metadata and data. C<$cipher> is either 218Calculates a CHK, given the metadata and data. C<$cipher> is either
324C<Rijndael> or C<Twofish>, with the latter being the default. 219C<Rijndael> or C<Twofish>, with the latter being the default.
325 220
326=cut 221=cut
327 222
328$txn->(generate_chk => sub { 223$txn->(generate_chk => sub {
329 my ($self, $metadata, $data, $cipher) = @_; 224 my ($self, $metadata, $data, $cipher) = @_;
330 225
226 $metadata = Net::FCP::Metadata::build_metadata $metadata;
227
331 $self->txn (generate_chk => 228 $self->txn (generate_chk =>
332 data => "$metadata$data", 229 data => "$metadata$data",
333 metadata_length => length $metadata, 230 metadata_length => xeh length $metadata,
334 cipher => $cipher || "Twofish"); 231 cipher => $cipher || "Twofish");
335}); 232});
336 233
337=item $txn = $fcp->txn_generate_svk_pair 234=item $txn = $fcp->txn_generate_svk_pair
338 235
339=item ($public, $private) = @{ $fcp->generate_svk_pair } 236=item ($public, $private, $crypto) = @{ $fcp->generate_svk_pair }
340 237
341Creates 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.
342 240
343 [ 241 [
344 "hKs0-WDQA4pVZyMPKNFsK1zapWY", 242 "acLx4dux9fvvABH15Gk6~d3I-yw",
345 "ZnmvMITaTXBMFGl4~jrjuyWxOWg" 243 "cPoDkDMXDGSMM32plaPZDhJDxSs",
244 "BH7LXCov0w51-y9i~BoB3g",
346 ] 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!
347 256
348=cut 257=cut
349 258
350$txn->(generate_svk_pair => sub { 259$txn->(generate_svk_pair => sub {
351 my ($self) = @_; 260 my ($self) = @_;
352 261
353 $self->txn ("generate_svk_pair"); 262 $self->txn ("generate_svk_pair");
354}); 263});
355 264
356=item $txn = $fcp->txn_insert_private_key ($private) 265=item $txn = $fcp->txn_invert_private_key ($private)
357 266
358=item $public = $fcp->insert_private_key ($private) 267=item $public = $fcp->invert_private_key ($private)
359 268
360Inserts 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
361with 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.
362back from C<generate_svk_pair>). 271the private value you get back from C<generate_svk_pair>).
363 272
364Returns the public key. 273Returns the public key.
365 274
366UNTESTED.
367
368=cut 275=cut
369 276
370$txn->(insert_private_key => sub { 277$txn->(invert_private_key => sub {
371 my ($self, $privkey) = @_; 278 my ($self, $privkey) = @_;
372 279
373 $self->txn (invert_private_key => private => $privkey); 280 $self->txn (invert_private_key => private => $privkey);
374}); 281});
375 282
… …
378=item $length = $fcp->get_size ($uri) 285=item $length = $fcp->get_size ($uri)
379 286
380Finds 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
381given document. 288given document.
382 289
383UNTESTED.
384
385=cut 290=cut
386 291
387$txn->(get_size => sub { 292$txn->(get_size => sub {
388 my ($self, $uri) = @_; 293 my ($self, $uri) = @_;
389 294
… …
392 297
393=item $txn = $fcp->txn_client_get ($uri [, $htl = 15 [, $removelocal = 0]]) 298=item $txn = $fcp->txn_client_get ($uri [, $htl = 15 [, $removelocal = 0]])
394 299
395=item ($metadata, $data) = @{ $fcp->client_get ($uri, $htl, $removelocal) 300=item ($metadata, $data) = @{ $fcp->client_get ($uri, $htl, $removelocal)
396 301
397Fetches a (small, as it should fit into memory) file from 302Fetches a (small, as it should fit into memory) key content block from
398freenet. 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>).
399C<undef>).
400 304
401Due 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.
402 307
403 my ($meta, $data) = @{ 308 my ($meta, $data) = @{
404 $fcp->client_get ( 309 $fcp->client_get (
405 "freenet:CHK@hdXaxkwZ9rA8-SidT0AN-bniQlgPAwI,XdCDmBuGsd-ulqbLnZ8v~w" 310 "freenet:CHK@hdXaxkwZ9rA8-SidT0AN-bniQlgPAwI,XdCDmBuGsd-ulqbLnZ8v~w"
406 ) 311 )
… …
409=cut 314=cut
410 315
411$txn->(client_get => sub { 316$txn->(client_get => sub {
412 my ($self, $uri, $htl, $removelocal) = @_; 317 my ($self, $uri, $htl, $removelocal) = @_;
413 318
319 $uri =~ s/^freenet://; $uri = "freenet:$uri";
320
414 $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),
415 remove_local_key => $removelocal ? "true" : "false"); 322 remove_local_key => $removelocal ? "true" : "false");
416}); 323});
417 324
418=item $txn = $fcp->txn_client_put ($uri, $metadata, $data, $htl, $removelocal) 325=item $txn = $fcp->txn_client_put ($uri, $metadata, $data, $htl, $removelocal)
419 326
420=item my $uri = $fcp->client_put ($uri, $metadata, $data, $htl, $removelocal); 327=item my $uri = $fcp->client_put ($uri, $metadata, $data, $htl, $removelocal);
421 328
422Insert 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
423abbreviated as just CHK@. In this case, the node will calculate the 330abbreviated as just CHK@. In this case, the node will calculate the
424CHK. 331CHK. If the key is a private SSK key, the node will calculcate the public
332key and the resulting public URI.
425 333
426C<$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.
427 336
428THIS INTERFACE IS UNTESTED AND SUBJECT TO CHANGE. 337The result is an arrayref with the keys C<uri>, C<public_key> and C<private_key>.
429 338
430=cut 339=cut
431 340
432$txn->(client_put => sub { 341$txn->(client_put => sub {
433 my ($self, $uri, $meta, $data, $htl, $removelocal) = @_; 342 my ($self, $uri, $metadata, $data, $htl, $removelocal) = @_;
434 343
435 $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),
436 remove_local_key => $removelocal ? "true" : "false", 349 remove_local_key => $removelocal ? "true" : "false",
437 data => "$meta$data", metadata_length => length $meta); 350 data => "$metadata$data", metadata_length => xeh length $metadata);
438}); 351});
439 352
440} # transactions 353} # transactions
441 354
442=item MISSING: (ClientPut), InsretKey
443
444=back 355=back
445 356
446=head2 THE Net::FCP::Txn CLASS 357=head2 THE Net::FCP::Txn CLASS
447 358
448All requests (or transactions) are executed in a asynchroneous way (LIE: 359All requests (or transactions) are executed in a asynchronous way. For
449uploads 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
450created (worse: a tcp connection is created, too). 361connection is created, too).
451 362
452For 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
453to subclass these, although of course not documented). 364to subclass these, although of course not documented).
454 365
455The most interesting method is C<result>. 366The most interesting method is C<result>.
… …
471 382
472sub new { 383sub new {
473 my $class = shift; 384 my $class = shift;
474 my $self = bless { @_ }, $class; 385 my $self = bless { @_ }, $class;
475 386
476 $self->{signal} = $EVENT->new_signal; 387 $self->{signal} = AnyEvent->condvar;
477 388
478 $self->{fcp}{txn}{$self} = $self; 389 $self->{fcp}{txn}{$self} = $self;
479 390
480 my $attr = ""; 391 my $attr = "";
481 my $data = delete $self->{attr}{data}; 392 my $data = delete $self->{attr}{data};
… …
507 418
508 #shutdown $fh, 1; # freenet buggy?, well, it's java... 419 #shutdown $fh, 1; # freenet buggy?, well, it's java...
509 420
510 $self->{fh} = $fh; 421 $self->{fh} = $fh;
511 422
512 $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 });
513 424
514 $self; 425 $self;
515} 426}
516 427
517=item $txn = $txn->cb ($coderef) 428=item $txn = $txn->cb ($coderef)
… …
553 $self; 464 $self;
554} 465}
555 466
556=item $txn->cancel (%attr) 467=item $txn->cancel (%attr)
557 468
558Cancels the operation with a C<cancel> exception anf the given attributes 469Cancels the operation with a C<cancel> exception and the given attributes
559(consider at least giving the attribute C<reason>). 470(consider at least giving the attribute C<reason>).
560 471
561UNTESTED. 472UNTESTED.
562 473
563=cut 474=cut
… …
576 487
577 if ($len > 0) { 488 if ($len > 0) {
578 substr $self->{sbuf}, 0, $len, ""; 489 substr $self->{sbuf}, 0, $len, "";
579 unless (length $self->{sbuf}) { 490 unless (length $self->{sbuf}) {
580 fcntl $self->{fh}, F_SETFL, 0; 491 fcntl $self->{fh}, F_SETFL, 0;
581 $self->{w}->cb(sub { $self->fh_ready_r })->poll (1, 0, 1); 492 $self->{w} = AnyEvent->io (fh => $self->{fh}, poll => 'r', cb => sub { $self->fh_ready_r });
582 } 493 }
583 } elsif (defined $len) { 494 } elsif (defined $len) {
584 $self->throw (Net::FCP::Exception->new (network_error => { reason => "unexpected end of file while writing" })); 495 $self->throw (Net::FCP::Exception->new (network_error => { reason => "unexpected end of file while writing" }));
585 } else { 496 } else {
586 $self->throw (Net::FCP::Exception->new (network_error => { reason => "$!" })); 497 $self->throw (Net::FCP::Exception->new (network_error => { reason => "$!" }));
… …
588} 499}
589 500
590sub fh_ready_r { 501sub fh_ready_r {
591 my ($self) = @_; 502 my ($self) = @_;
592 503
593 if (sysread $self->{fh}, $self->{buf}, 65536, length $self->{buf}) { 504 if (sysread $self->{fh}, $self->{buf}, 16384 + 1024, length $self->{buf}) {
594 for (;;) { 505 for (;;) {
595 if ($self->{datalen}) { 506 if ($self->{datalen}) {
596 #warn "expecting new datachunk $self->{datalen}, got ".(length $self->{buf})."\n";#d# 507 #warn "expecting new datachunk $self->{datalen}, got ".(length $self->{buf})."\n";#d#
597 if (length $self->{buf} >= $self->{datalen}) { 508 if (length $self->{buf} >= $self->{datalen}) {
598 $self->rcv_data (substr $self->{buf}, 0, delete $self->{datalen}, ""); 509 $self->rcv_data (substr $self->{buf}, 0, delete $self->{datalen}, "");
… …
651 my ($self, $result) = @_; 562 my ($self, $result) = @_;
652 563
653 unless (exists $self->{result}) { 564 unless (exists $self->{result}) {
654 $self->{result} = $result; 565 $self->{result} = $result;
655 $self->{cb}->($self) if exists $self->{cb}; 566 $self->{cb}->($self) if exists $self->{cb};
656 $self->{signal}->send; 567 $self->{signal}->broadcast;
657 } 568 }
658} 569}
659 570
660sub eof { 571sub eof {
661 my ($self) = @_; 572 my ($self) = @_;
… …
672 } 583 }
673} 584}
674 585
675sub progress { 586sub progress {
676 my ($self, $type, $attr) = @_; 587 my ($self, $type, $attr) = @_;
588
677 $self->{fcp}->progress ($self, $type, $attr); 589 $self->{fcp}->progress ($self, $type, $attr);
678} 590}
679 591
680=item $result = $txn->result 592=item $result = $txn->result
681 593
682Waits until a result is available and then returns it. 594Waits until a result is available and then returns it.
683 595
684This waiting is (depending on your event model) not very efficient, as it 596This waiting is (depending on your event model) not very efficient, as it
685is done outside the "mainloop". 597is done outside the "mainloop". The biggest problem, however, is that it's
598blocking one thread of execution. Try to use the callback mechanism, if
599possible, and call result from within the callback (or after is has been
600run), as then no waiting is necessary.
686 601
687=cut 602=cut
688 603
689sub result { 604sub result {
690 my ($self) = @_; 605 my ($self) = @_;
… …
730 645
731use base Net::FCP::Txn; 646use base Net::FCP::Txn;
732 647
733sub rcv_success { 648sub rcv_success {
734 my ($self, $attr) = @_; 649 my ($self, $attr) = @_;
735 $self->set_result ([$attr->{PublicKey}, $attr->{PrivateKey}]); 650 $self->set_result ([$attr->{public_key}, $attr->{private_key}, $attr->{crypto_key}]);
736} 651}
737 652
738package Net::FCP::Txn::InsertPrivateKey; 653package Net::FCP::Txn::InvertPrivateKey;
739 654
740use base Net::FCP::Txn; 655use base Net::FCP::Txn;
741 656
742sub rcv_success { 657sub rcv_success {
743 my ($self, $attr) = @_; 658 my ($self, $attr) = @_;
744 $self->set_result ($attr->{PublicKey}); 659 $self->set_result ($attr->{public_key});
745} 660}
746 661
747package Net::FCP::Txn::GetSize; 662package Net::FCP::Txn::GetSize;
748 663
749use base Net::FCP::Txn; 664use base Net::FCP::Txn;
750 665
751sub rcv_success { 666sub rcv_success {
752 my ($self, $attr) = @_; 667 my ($self, $attr) = @_;
753 $self->set_result ($attr->{Length}); 668 $self->set_result (hex $attr->{length});
754} 669}
755 670
756package Net::FCP::Txn::GetPut; 671package Net::FCP::Txn::GetPut;
757 672
758# base class for get and put 673# base class for get and put
759 674
760use base Net::FCP::Txn; 675use base Net::FCP::Txn;
761 676
762*rcv_uri_error = \&Net::FCP::Txn::rcv_throw_exception; 677*rcv_uri_error = \&Net::FCP::Txn::rcv_throw_exception;
763*rcv_route_not_found = \&Net::FCP::Txn::rcv_throw_exception; 678*rcv_route_not_found = \&Net::FCP::Txn::rcv_throw_exception;
764 679
765sub rcv_restarted { 680sub rcv_restarted {
766 my ($self, $attr, $type) = @_; 681 my ($self, $attr, $type) = @_;
767 682
768 delete $self->{datalength}; 683 delete $self->{datalength};
… …
785 700
786 $self->progress ("data", { chunk => length $chunk, received => length $self->{data}, total => $self->{datalength} }); 701 $self->progress ("data", { chunk => length $chunk, received => length $self->{data}, total => $self->{datalength} });
787 702
788 if ($self->{datalength} == length $self->{data}) { 703 if ($self->{datalength} == length $self->{data}) {
789 my $data = delete $self->{data}; 704 my $data = delete $self->{data};
790 my $meta = Net::FCP::parse_metadata substr $data, 0, $self->{metalength}, ""; 705 my $meta = new Net::FCP::Metadata (substr $data, 0, $self->{metalength}, "");
791 706
792 $self->set_result ([$meta, $data]); 707 $self->set_result ([$meta, $data]);
708 $self->eof;
793 } 709 }
794} 710}
795 711
796sub rcv_data_found { 712sub rcv_data_found {
797 my ($self, $attr, $type) = @_; 713 my ($self, $attr, $type) = @_;
… …
805package Net::FCP::Txn::ClientPut; 721package Net::FCP::Txn::ClientPut;
806 722
807use base Net::FCP::Txn::GetPut; 723use base Net::FCP::Txn::GetPut;
808 724
809*rcv_size_error = \&Net::FCP::Txn::rcv_throw_exception; 725*rcv_size_error = \&Net::FCP::Txn::rcv_throw_exception;
810*rcv_key_collision = \&Net::FCP::Txn::rcv_throw_exception;
811 726
812sub rcv_pending { 727sub rcv_pending {
813 my ($self, $attr, $type) = @_; 728 my ($self, $attr, $type) = @_;
814 $self->progress ($type, $attr); 729 $self->progress ($type, $attr);
815} 730}
… …
817sub rcv_success { 732sub rcv_success {
818 my ($self, $attr, $type) = @_; 733 my ($self, $attr, $type) = @_;
819 $self->set_result ($attr); 734 $self->set_result ($attr);
820} 735}
821 736
737sub rcv_key_collision {
738 my ($self, $attr, $type) = @_;
739 $self->set_result ({ key_collision => 1, %$attr });
740}
741
822=back 742=back
823 743
824=head2 The Net::FCP::Exception CLASS 744=head2 The Net::FCP::Exception CLASS
825 745
826Any unexpected (non-standard) responses that make it impossible to return 746Any unexpected (non-standard) responses that make it impossible to return
… …
835 755
836package Net::FCP::Exception; 756package Net::FCP::Exception;
837 757
838use overload 758use overload
839 '""' => sub { 759 '""' => sub {
840 "Net::FCP::Exception<<$_[0][0]," . (join ":", %{$_[0][1]}) . ">>\n"; 760 "Net::FCP::Exception<<$_[0][0]," . (join ":", %{$_[0][1]}) . ">>";
841 }; 761 };
842 762
843=item $exc = new Net::FCP::Exception $type, \%attr 763=item $exc = new Net::FCP::Exception $type, \%attr
844 764
845Create a new exception object of the given type (a string like 765Create a new exception object of the given type (a string like
… …
892 812
893=head1 BUGS 813=head1 BUGS
894 814
895=head1 AUTHOR 815=head1 AUTHOR
896 816
897 Marc Lehmann <pcg@goof.com> 817 Marc Lehmann <schmorp@schmorp.de>
898 http://www.goof.com/pcg/marc/ 818 http://home.schmorp.de/
899 819
900=cut 820=cut
901 821
902package Net::FCP::Event::Auto; 8221
903 823
904my @models = (
905 [Coro => Coro::Event:: ],
906 [Event => Event::],
907 [Glib => Glib:: ],
908 [Tk => Tk::],
909);
910
911sub AUTOLOAD {
912 $AUTOLOAD =~ s/.*://;
913
914 for (@models) {
915 my ($model, $package) = @$_;
916 if (defined ${"$package\::VERSION"}) {
917 $EVENT = "Net::FCP::Event::$model";
918 eval "require $EVENT"; die if $@;
919 goto &{"$EVENT\::$AUTOLOAD"};
920 }
921 }
922
923 for (@models) {
924 my ($model, $package) = @$_;
925 $EVENT = "Net::FCP::Event::$model";
926 if (eval "require $EVENT") {
927 goto &{"$EVENT\::$AUTOLOAD"};
928 }
929 }
930
931 die "No event module selected for Net::FCP and autodetect failed. Install any of these: Coro, Event, Glib or Tk.";
932}
933
9341;
935

Diff Legend

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