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.39 by root, Tue Nov 28 15:18:17 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};
… …
498 404
499 socket my $fh, PF_INET, SOCK_STREAM, 0 405 socket my $fh, PF_INET, SOCK_STREAM, 0
500 or Carp::croak "unable to create new tcp socket: $!"; 406 or Carp::croak "unable to create new tcp socket: $!";
501 binmode $fh, ":raw"; 407 binmode $fh, ":raw";
502 fcntl $fh, F_SETFL, O_NONBLOCK; 408 fcntl $fh, F_SETFL, O_NONBLOCK;
503 connect $fh, (sockaddr_in $self->{fcp}{port}, inet_aton $self->{fcp}{host}) 409 connect $fh, (sockaddr_in $self->{fcp}{port}, inet_aton $self->{fcp}{host});
504 and !$!{EWOULDBLOCK}
505 and !$!{EINPROGRESS}
506 and Carp::croak "FCP::txn: unable to connect to $self->{fcp}{host}:$self->{fcp}{port}: $!\n"; 410# and Carp::croak "FCP::txn: unable to connect to $self->{fcp}{host}:$self->{fcp}{port}: $!\n";
507 411
508 $self->{sbuf} = 412 $self->{sbuf} =
509 "\x00\x00\x00\x02" 413 "\x00\x00\x00\x02"
510 . (Net::FCP::touc $self->{type}) 414 . (Net::FCP::touc $self->{type})
511 . "\012$attr$data"; 415 . "\012$attr$data";
512 416
513 #shutdown $fh, 1; # freenet buggy?, well, it's java... 417 #shutdown $fh, 1; # freenet buggy?, well, it's java...
514 418
515 $self->{fh} = $fh; 419 $self->{fh} = $fh;
516 420
517 $self->{w} = $EVENT->new_from_fh ($fh)->cb(sub { $self->fh_ready_w })->poll(0, 1, 1); 421 $self->{w} = AnyEvent->io (fh => $fh, poll => 'w', cb => sub { $self->fh_ready_w });
518 422
519 $self; 423 $self;
520} 424}
521 425
522=item $txn = $txn->cb ($coderef) 426=item $txn = $txn->cb ($coderef)
… …
558 $self; 462 $self;
559} 463}
560 464
561=item $txn->cancel (%attr) 465=item $txn->cancel (%attr)
562 466
563Cancels the operation with a C<cancel> exception anf the given attributes 467Cancels the operation with a C<cancel> exception and the given attributes
564(consider at least giving the attribute C<reason>). 468(consider at least giving the attribute C<reason>).
565 469
566UNTESTED. 470UNTESTED.
567 471
568=cut 472=cut
… …
581 485
582 if ($len > 0) { 486 if ($len > 0) {
583 substr $self->{sbuf}, 0, $len, ""; 487 substr $self->{sbuf}, 0, $len, "";
584 unless (length $self->{sbuf}) { 488 unless (length $self->{sbuf}) {
585 fcntl $self->{fh}, F_SETFL, 0; 489 fcntl $self->{fh}, F_SETFL, 0;
586 $self->{w}->cb(sub { $self->fh_ready_r })->poll (1, 0, 1); 490 $self->{w} = AnyEvent->io (fh => $self->{fh}, poll => 'r', cb => sub { $self->fh_ready_r });
587 } 491 }
588 } elsif (defined $len) { 492 } elsif (defined $len) {
589 $self->throw (Net::FCP::Exception->new (network_error => { reason => "unexpected end of file while writing" })); 493 $self->throw (Net::FCP::Exception->new (network_error => { reason => "unexpected end of file while writing" }));
590 } else { 494 } else {
591 $self->throw (Net::FCP::Exception->new (network_error => { reason => "$!" })); 495 $self->throw (Net::FCP::Exception->new (network_error => { reason => "$!" }));
… …
593} 497}
594 498
595sub fh_ready_r { 499sub fh_ready_r {
596 my ($self) = @_; 500 my ($self) = @_;
597 501
598 if (sysread $self->{fh}, $self->{buf}, 65536, length $self->{buf}) { 502 if (sysread $self->{fh}, $self->{buf}, 16384 + 1024, length $self->{buf}) {
599 for (;;) { 503 for (;;) {
600 if ($self->{datalen}) { 504 if ($self->{datalen}) {
601 #warn "expecting new datachunk $self->{datalen}, got ".(length $self->{buf})."\n";#d# 505 #warn "expecting new datachunk $self->{datalen}, got ".(length $self->{buf})."\n";#d#
602 if (length $self->{buf} >= $self->{datalen}) { 506 if (length $self->{buf} >= $self->{datalen}) {
603 $self->rcv_data (substr $self->{buf}, 0, delete $self->{datalen}, ""); 507 $self->rcv_data (substr $self->{buf}, 0, delete $self->{datalen}, "");
… …
656 my ($self, $result) = @_; 560 my ($self, $result) = @_;
657 561
658 unless (exists $self->{result}) { 562 unless (exists $self->{result}) {
659 $self->{result} = $result; 563 $self->{result} = $result;
660 $self->{cb}->($self) if exists $self->{cb}; 564 $self->{cb}->($self) if exists $self->{cb};
661 $self->{signal}->send; 565 $self->{signal}->broadcast;
662 } 566 }
663} 567}
664 568
665sub eof { 569sub eof {
666 my ($self) = @_; 570 my ($self) = @_;
… …
677 } 581 }
678} 582}
679 583
680sub progress { 584sub progress {
681 my ($self, $type, $attr) = @_; 585 my ($self, $type, $attr) = @_;
586
682 $self->{fcp}->progress ($self, $type, $attr); 587 $self->{fcp}->progress ($self, $type, $attr);
683} 588}
684 589
685=item $result = $txn->result 590=item $result = $txn->result
686 591
… …
738 643
739use base Net::FCP::Txn; 644use base Net::FCP::Txn;
740 645
741sub rcv_success { 646sub rcv_success {
742 my ($self, $attr) = @_; 647 my ($self, $attr) = @_;
743 $self->set_result ([$attr->{PublicKey}, $attr->{PrivateKey}]); 648 $self->set_result ([$attr->{public_key}, $attr->{private_key}, $attr->{crypto_key}]);
744} 649}
745 650
746package Net::FCP::Txn::InsertPrivateKey; 651package Net::FCP::Txn::InvertPrivateKey;
747 652
748use base Net::FCP::Txn; 653use base Net::FCP::Txn;
749 654
750sub rcv_success { 655sub rcv_success {
751 my ($self, $attr) = @_; 656 my ($self, $attr) = @_;
752 $self->set_result ($attr->{PublicKey}); 657 $self->set_result ($attr->{public_key});
753} 658}
754 659
755package Net::FCP::Txn::GetSize; 660package Net::FCP::Txn::GetSize;
756 661
757use base Net::FCP::Txn; 662use base Net::FCP::Txn;
758 663
759sub rcv_success { 664sub rcv_success {
760 my ($self, $attr) = @_; 665 my ($self, $attr) = @_;
761 $self->set_result (hex $attr->{Length}); 666 $self->set_result (hex $attr->{length});
762} 667}
763 668
764package Net::FCP::Txn::GetPut; 669package Net::FCP::Txn::GetPut;
765 670
766# base class for get and put 671# base class for get and put
767 672
768use base Net::FCP::Txn; 673use base Net::FCP::Txn;
769 674
770*rcv_uri_error = \&Net::FCP::Txn::rcv_throw_exception; 675*rcv_uri_error = \&Net::FCP::Txn::rcv_throw_exception;
771*rcv_route_not_found = \&Net::FCP::Txn::rcv_throw_exception; 676*rcv_route_not_found = \&Net::FCP::Txn::rcv_throw_exception;
772 677
773sub rcv_restarted { 678sub rcv_restarted {
774 my ($self, $attr, $type) = @_; 679 my ($self, $attr, $type) = @_;
775 680
776 delete $self->{datalength}; 681 delete $self->{datalength};
… …
793 698
794 $self->progress ("data", { chunk => length $chunk, received => length $self->{data}, total => $self->{datalength} }); 699 $self->progress ("data", { chunk => length $chunk, received => length $self->{data}, total => $self->{datalength} });
795 700
796 if ($self->{datalength} == length $self->{data}) { 701 if ($self->{datalength} == length $self->{data}) {
797 my $data = delete $self->{data}; 702 my $data = delete $self->{data};
798 my $meta = Net::FCP::parse_metadata substr $data, 0, $self->{metalength}, ""; 703 my $meta = new Net::FCP::Metadata (substr $data, 0, $self->{metalength}, "");
799 704
800 $self->set_result ([$meta, $data]); 705 $self->set_result ([$meta, $data]);
801 $self->eof; 706 $self->eof;
802 } 707 }
803} 708}
… …
814package Net::FCP::Txn::ClientPut; 719package Net::FCP::Txn::ClientPut;
815 720
816use base Net::FCP::Txn::GetPut; 721use base Net::FCP::Txn::GetPut;
817 722
818*rcv_size_error = \&Net::FCP::Txn::rcv_throw_exception; 723*rcv_size_error = \&Net::FCP::Txn::rcv_throw_exception;
819*rcv_key_collision = \&Net::FCP::Txn::rcv_throw_exception;
820 724
821sub rcv_pending { 725sub rcv_pending {
822 my ($self, $attr, $type) = @_; 726 my ($self, $attr, $type) = @_;
823 $self->progress ($type, $attr); 727 $self->progress ($type, $attr);
824} 728}
825 729
826sub rcv_success { 730sub rcv_success {
827 my ($self, $attr, $type) = @_; 731 my ($self, $attr, $type) = @_;
828 $self->set_result ($attr); 732 $self->set_result ($attr);
733}
734
735sub rcv_key_collision {
736 my ($self, $attr, $type) = @_;
737 $self->set_result ({ key_collision => 1, %$attr });
829} 738}
830 739
831=back 740=back
832 741
833=head2 The Net::FCP::Exception CLASS 742=head2 The Net::FCP::Exception CLASS
… …
901 810
902=head1 BUGS 811=head1 BUGS
903 812
904=head1 AUTHOR 813=head1 AUTHOR
905 814
906 Marc Lehmann <pcg@goof.com> 815 Marc Lehmann <schmorp@schmorp.de>
907 http://www.goof.com/pcg/marc/ 816 http://home.schmorp.de/
908 817
909=cut 818=cut
910 819
911package Net::FCP::Event::Auto; 8201
912 821
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