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.26 by root, Wed Dec 10 02:36:37 2003 UTC

… …
72 72
73package Net::FCP; 73package Net::FCP;
74 74
75use Carp; 75use Carp;
76 76
77$VERSION = 0.08; 77$VERSION = 0.6;
78 78
79no warnings; 79no warnings;
80 80
81our $EVENT = Net::FCP::Event::Auto::; 81our $EVENT = Net::FCP::Event::Auto::;
82 82
… …
99 $_; 99 $_;
100} 100}
101 101
102sub tolc($) { 102sub tolc($) {
103 local $_ = shift; 103 local $_ = shift;
104 1 while s/(SVK|CHK|URI)/\L$1\_/;
104 s/(?<=[a-z])(?=[A-Z])/_/g; 105 s/(?<=[a-z])(?=[A-Z])/_/g;
105 lc $_; 106 lc $_;
106} 107}
107 108
109# the opposite of hex
110sub xeh($) {
111 sprintf "%x", $_[0];
112}
113
108=item $meta = Net::FCP::parse_metadata $string 114=item $meta = Net::FCP::parse_metadata $string
109 115
110Parse a metadata string and return it. 116Parse a metadata string and return it.
111 117
112The metadata will be a hashref with key C<version> (containing 118The metadata will be a hashref with key C<version> (containing the
113the mandatory version header entries). 119mandatory version header entries) and key C<raw> containing the original
120metadata string.
114 121
115All other headers are represented by arrayrefs (they can be repeated). 122All other headers are represented by arrayrefs (they can be repeated).
116 123
117Since this is confusing, here is a rather verbose example of a parsed 124Since this description is confusing, here is a rather verbose example of a
118manifest: 125parsed manifest:
119 126
120 ( 127 (
128 raw => "Version...",
121 version => { revision => 1 }, 129 version => { revision => 1 },
122 document => [ 130 document => [
123 { 131 {
124 info => { format" => "image/jpeg" }, 132 info => { format" => "image/jpeg" },
125 name => "background.jpg", 133 name => "background.jpg",
… …
138 ) 146 )
139 147
140=cut 148=cut
141 149
142sub parse_metadata { 150sub parse_metadata {
143 my $meta;
144
145 my $data = shift; 151 my $data = shift;
152 my $meta = { raw => $data };
153
146 if ($data =~ /^Version\015?\012/gc) { 154 if ($data =~ /^Version\015?\012/gc) {
147 my $hdr = $meta->{version} = {}; 155 my $hdr = $meta->{version} = {};
148 156
149 for (;;) { 157 for (;;) {
150 while ($data =~ /\G([^=\015\012]+)=([^\015\012]*)\015?\012/gc) { 158 while ($data =~ /\G([^=\015\012]+)=([^\015\012]*)\015?\012/gc) {
… …
312 my ($self) = @_; 320 my ($self) = @_;
313 321
314 $self->txn ("client_info"); 322 $self->txn ("client_info");
315}); 323});
316 324
317=item $txn = $fcp->txn_generate_chk ($metadata, $data) 325=item $txn = $fcp->txn_generate_chk ($metadata, $data[, $cipher])
318 326
319=item $uri = $fcp->generate_chk ($metadata, $data) 327=item $uri = $fcp->generate_chk ($metadata, $data[, $cipher])
320 328
321Creates a new CHK, given the metadata and data. UNTESTED. 329Calculcates a CHK, given the metadata and data. C<$cipher> is either
330C<Rijndael> or C<Twofish>, with the latter being the default.
322 331
323=cut 332=cut
324 333
325$txn->(generate_chk => sub { 334$txn->(generate_chk => sub {
326 my ($self, $metadata, $data) = @_; 335 my ($self, $metadata, $data, $cipher) = @_;
327 336
328 $self->txn (generate_chk => data => "$metadata$data", metadata_length => length $metadata); 337 $self->txn (generate_chk =>
338 data => "$metadata$data",
339 metadata_length => xeh length $metadata,
340 cipher => $cipher || "Twofish");
329}); 341});
330 342
331=item $txn = $fcp->txn_generate_svk_pair 343=item $txn = $fcp->txn_generate_svk_pair
332 344
333=item ($public, $private) = @{ $fcp->generate_svk_pair } 345=item ($public, $private) = @{ $fcp->generate_svk_pair }
… …
403=cut 415=cut
404 416
405$txn->(client_get => sub { 417$txn->(client_get => sub {
406 my ($self, $uri, $htl, $removelocal) = @_; 418 my ($self, $uri, $htl, $removelocal) = @_;
407 419
420 $uri =~ s/^freenet://;
421 $uri = "freenet:$uri";
422
408 $self->txn (client_get => URI => $uri, hops_to_live => (defined $htl ? $htl :15), 423 $self->txn (client_get => URI => $uri, hops_to_live => xeh (defined $htl ? $htl : 15),
409 remove_local_key => $removelocal ? "true" : "false"); 424 remove_local_key => $removelocal ? "true" : "false");
410}); 425});
411 426
412=item $txn = $fcp->txn_client_put ($uri, $metadata, $data, $htl, $removelocal) 427=item $txn = $fcp->txn_client_put ($uri, $metadata, $data, $htl, $removelocal)
413 428
… …
424=cut 439=cut
425 440
426$txn->(client_put => sub { 441$txn->(client_put => sub {
427 my ($self, $uri, $meta, $data, $htl, $removelocal) = @_; 442 my ($self, $uri, $meta, $data, $htl, $removelocal) = @_;
428 443
429 $self->txn (client_put => URI => $uri, hops_to_live => (defined $htl ? $htl :15), 444 $self->txn (client_put => URI => $uri, xeh (defined $htl ? $htl : 15),
430 remove_local_key => $removelocal ? "true" : "false", 445 remove_local_key => $removelocal ? "true" : "false",
431 data => "$meta$data", metadata_length => length $meta); 446 data => "$meta$data", metadata_length => xeh length $meta);
432}); 447});
433 448
434} # transactions 449} # transactions
435 450
436=item MISSING: (ClientPut), InsretKey 451=item MISSING: (ClientPut), InsertKey
437 452
438=back 453=back
439 454
440=head2 THE Net::FCP::Txn CLASS 455=head2 THE Net::FCP::Txn CLASS
441 456
442All requests (or transactions) are executed in a asynchroneous way (LIE: 457All requests (or transactions) are executed in a asynchronous way. For
443uploads are blocking). For each request, a C<Net::FCP::Txn> object is 458each request, a C<Net::FCP::Txn> object is created (worse: a tcp
444created (worse: a tcp connection is created, too). 459connection is created, too).
445 460
446For each request there is actually a different subclass (and it's possible 461For each request there is actually a different subclass (and it's possible
447to subclass these, although of course not documented). 462to subclass these, although of course not documented).
448 463
449The most interesting method is C<result>. 464The most interesting method is C<result>.
… …
477 while (my ($k, $v) = each %{$self->{attr}}) { 492 while (my ($k, $v) = each %{$self->{attr}}) {
478 $attr .= (Net::FCP::touc $k) . "=$v\012" 493 $attr .= (Net::FCP::touc $k) . "=$v\012"
479 } 494 }
480 495
481 if (defined $data) { 496 if (defined $data) {
482 $attr .= "DataLength=" . (length $data) . "\012"; 497 $attr .= sprintf "DataLength=%x\012", length $data;
483 $data = "Data\012$data"; 498 $data = "Data\012$data";
484 } else { 499 } else {
485 $data = "EndMessage\012"; 500 $data = "EndMessage\012";
486 } 501 }
487 502
… …
494 and !$!{EINPROGRESS} 509 and !$!{EINPROGRESS}
495 and Carp::croak "FCP::txn: unable to connect to $self->{fcp}{host}:$self->{fcp}{port}: $!\n"; 510 and Carp::croak "FCP::txn: unable to connect to $self->{fcp}{host}:$self->{fcp}{port}: $!\n";
496 511
497 $self->{sbuf} = 512 $self->{sbuf} =
498 "\x00\x00\x00\x02" 513 "\x00\x00\x00\x02"
499 . Net::FCP::touc $self->{type} 514 . (Net::FCP::touc $self->{type})
500 . "\012$attr$data"; 515 . "\012$attr$data";
501 516
502 #$fh->shutdown (1); # freenet buggy?, well, it's java... 517 #shutdown $fh, 1; # freenet buggy?, well, it's java...
503 518
504 $self->{fh} = $fh; 519 $self->{fh} = $fh;
505 520
506 $self->{w} = $EVENT->new_from_fh ($fh)->cb(sub { $self->fh_ready_w })->poll(0, 1, 1); 521 $self->{w} = $EVENT->new_from_fh ($fh)->cb(sub { $self->fh_ready_w })->poll(0, 1, 1);
507 522
… …
674=item $result = $txn->result 689=item $result = $txn->result
675 690
676Waits until a result is available and then returns it. 691Waits until a result is available and then returns it.
677 692
678This waiting is (depending on your event model) not very efficient, as it 693This waiting is (depending on your event model) not very efficient, as it
679is done outside the "mainloop". 694is done outside the "mainloop". The biggest problem, however, is that it's
695blocking one thread of execution. Try to use the callback mechanism, if
696possible, and call result from within the callback (or after is has been
697run), as then no waiting is necessary.
680 698
681=cut 699=cut
682 700
683sub result { 701sub result {
684 my ($self) = @_; 702 my ($self) = @_;
… …
715use base Net::FCP::Txn; 733use base Net::FCP::Txn;
716 734
717sub rcv_success { 735sub rcv_success {
718 my ($self, $attr) = @_; 736 my ($self, $attr) = @_;
719 737
720 $self->set_result ($attr); 738 $self->set_result ($attr->{uri});
721} 739}
722 740
723package Net::FCP::Txn::GenerateSVKPair; 741package Net::FCP::Txn::GenerateSVKPair;
724 742
725use base Net::FCP::Txn; 743use base Net::FCP::Txn;
… …
742 760
743use base Net::FCP::Txn; 761use base Net::FCP::Txn;
744 762
745sub rcv_success { 763sub rcv_success {
746 my ($self, $attr) = @_; 764 my ($self, $attr) = @_;
747 $self->set_result ($attr->{Length}); 765 $self->set_result (hex $attr->{Length});
748} 766}
749 767
750package Net::FCP::Txn::GetPut; 768package Net::FCP::Txn::GetPut;
751 769
752# base class for get and put 770# base class for get and put
… …
782 if ($self->{datalength} == length $self->{data}) { 800 if ($self->{datalength} == length $self->{data}) {
783 my $data = delete $self->{data}; 801 my $data = delete $self->{data};
784 my $meta = Net::FCP::parse_metadata substr $data, 0, $self->{metalength}, ""; 802 my $meta = Net::FCP::parse_metadata substr $data, 0, $self->{metalength}, "";
785 803
786 $self->set_result ([$meta, $data]); 804 $self->set_result ([$meta, $data]);
805 $self->eof;
787 } 806 }
788} 807}
789 808
790sub rcv_data_found { 809sub rcv_data_found {
791 my ($self, $attr, $type) = @_; 810 my ($self, $attr, $type) = @_;
… …
829 848
830package Net::FCP::Exception; 849package Net::FCP::Exception;
831 850
832use overload 851use overload
833 '""' => sub { 852 '""' => sub {
834 "Net::FCP::Exception<<$_[0][0]," . (join ":", %{$_[0][1]}) . ">>\n"; 853 "Net::FCP::Exception<<$_[0][0]," . (join ":", %{$_[0][1]}) . ">>";
835 }; 854 };
836 855
837=item $exc = new Net::FCP::Exception $type, \%attr 856=item $exc = new Net::FCP::Exception $type, \%attr
838 857
839Create a new exception object of the given type (a string like 858Create a new exception object of the given type (a string like

Diff Legend

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