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

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

Diff Legend

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