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.28 by root, Thu May 13 16:13:42 2004 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)([^_])/$1\_$2/i;
105 1 while s/([^_])(SVK|CHK|URI)/$1\_$2/i;
104 s/(?<=[a-z])(?=[A-Z])/_/g; 106 s/(?<=[a-z])(?=[A-Z])/_/g;
105 lc $_; 107 lc $_;
106} 108}
107 109
110# the opposite of hex
111sub xeh($) {
112 sprintf "%x", $_[0];
113}
114
108=item $meta = Net::FCP::parse_metadata $string 115=item $meta = Net::FCP::parse_metadata $string
109 116
110Parse a metadata string and return it. 117Parse a metadata string and return it.
111 118
112The metadata will be a hashref with key C<version> (containing 119The metadata will be a hashref with key C<version> (containing the
113the mandatory version header entries). 120mandatory version header entries) and key C<raw> containing the original
121metadata string.
114 122
115All other headers are represented by arrayrefs (they can be repeated). 123All other headers are represented by arrayrefs (they can be repeated).
116 124
117Since this is confusing, here is a rather verbose example of a parsed 125Since this description is confusing, here is a rather verbose example of a
118manifest: 126parsed manifest:
119 127
120 ( 128 (
129 raw => "Version...",
121 version => { revision => 1 }, 130 version => { revision => 1 },
122 document => [ 131 document => [
123 { 132 {
124 info => { format" => "image/jpeg" }, 133 info => { format" => "image/jpeg" },
125 name => "background.jpg", 134 name => "background.jpg",
… …
138 ) 147 )
139 148
140=cut 149=cut
141 150
142sub parse_metadata { 151sub parse_metadata {
143 my $meta;
144
145 my $data = shift; 152 my $data = shift;
153 my $meta = { raw => $data };
154
146 if ($data =~ /^Version\015?\012/gc) { 155 if ($data =~ /^Version\015?\012/gc) {
147 my $hdr = $meta->{version} = {}; 156 my $hdr = $meta->{version} = {};
148 157
149 for (;;) { 158 for (;;) {
150 while ($data =~ /\G([^=\015\012]+)=([^\015\012]*)\015?\012/gc) { 159 while ($data =~ /\G([^=\015\012]+)=([^\015\012]*)\015?\012/gc) {
… …
173 #$meta->{tail} = substr $data, pos $data; 182 #$meta->{tail} = substr $data, pos $data;
174 183
175 $meta; 184 $meta;
176} 185}
177 186
178=item $fcp = new Net::FCP [host => $host][, port => $port] 187=item $fcp = new Net::FCP [host => $host][, port => $port][, progress => \&cb]
179 188
180Create a new virtual FCP connection to the given host and port (default 189Create 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>). 190127.0.0.1:8481, or the environment variables C<FREDHOST> and C<FREDPORT>).
182 191
183Connections are virtual because no persistent physical connection is 192Connections are virtual because no persistent physical connection is
184established. 193established.
194
195You can install a progress callback that is being called with the Net::FCP
196object, a txn object, the type of the transaction and the attributes. Use
197it like this:
198
199 sub progress_cb {
200 my ($self, $txn, $type, $attr) = @_;
201
202 warn "progress<$txn,$type," . (join ":", %$attr) . ">\n";
203 }
185 204
186=begin comment 205=begin comment
187 206
188However, the existance of the node is checked by executing a 207However, the existance of the node is checked by executing a
189C<ClientHello> transaction. 208C<ClientHello> transaction.
… …
205 $self; 224 $self;
206} 225}
207 226
208sub progress { 227sub progress {
209 my ($self, $txn, $type, $attr) = @_; 228 my ($self, $txn, $type, $attr) = @_;
210 #warn "progress<$txn,$type," . (join ":", %$attr) . ">\n"; 229
230 $self->{progress}->($self, $txn, $type, $attr)
231 if $self->{progress};
211} 232}
212 233
213=item $txn = $fcp->txn(type => attr => val,...) 234=item $txn = $fcp->txn(type => attr => val,...)
214 235
215The low-level interface to transactions. Don't use it. 236The low-level interface to transactions. Don't use it.
… …
312 my ($self) = @_; 333 my ($self) = @_;
313 334
314 $self->txn ("client_info"); 335 $self->txn ("client_info");
315}); 336});
316 337
317=item $txn = $fcp->txn_generate_chk ($metadata, $data) 338=item $txn = $fcp->txn_generate_chk ($metadata, $data[, $cipher])
318 339
319=item $uri = $fcp->generate_chk ($metadata, $data) 340=item $uri = $fcp->generate_chk ($metadata, $data[, $cipher])
320 341
321Creates a new CHK, given the metadata and data. UNTESTED. 342Calculates a CHK, given the metadata and data. C<$cipher> is either
343C<Rijndael> or C<Twofish>, with the latter being the default.
322 344
323=cut 345=cut
324 346
325$txn->(generate_chk => sub { 347$txn->(generate_chk => sub {
326 my ($self, $metadata, $data) = @_; 348 my ($self, $metadata, $data, $cipher) = @_;
327 349
328 $self->txn (generate_chk => data => "$metadata$data", metadata_length => length $metadata); 350 $self->txn (generate_chk =>
351 data => "$metadata$data",
352 metadata_length => xeh length $metadata,
353 cipher => $cipher || "Twofish");
329}); 354});
330 355
331=item $txn = $fcp->txn_generate_svk_pair 356=item $txn = $fcp->txn_generate_svk_pair
332 357
333=item ($public, $private) = @{ $fcp->generate_svk_pair } 358=item ($public, $private) = @{ $fcp->generate_svk_pair }
… …
389=item ($metadata, $data) = @{ $fcp->client_get ($uri, $htl, $removelocal) 414=item ($metadata, $data) = @{ $fcp->client_get ($uri, $htl, $removelocal)
390 415
391Fetches a (small, as it should fit into memory) file from 416Fetches a (small, as it should fit into memory) file from
392freenet. C<$meta> is the metadata (as returned by C<parse_metadata> or 417freenet. C<$meta> is the metadata (as returned by C<parse_metadata> or
393C<undef>). 418C<undef>).
419
420The C<$uri> should begin with C<freenet:>, but the scheme is currently
421added, if missing.
394 422
395Due to the overhead, a better method to download big files should be used. 423Due to the overhead, a better method to download big files should be used.
396 424
397 my ($meta, $data) = @{ 425 my ($meta, $data) = @{
398 $fcp->client_get ( 426 $fcp->client_get (
… …
403=cut 431=cut
404 432
405$txn->(client_get => sub { 433$txn->(client_get => sub {
406 my ($self, $uri, $htl, $removelocal) = @_; 434 my ($self, $uri, $htl, $removelocal) = @_;
407 435
436 $uri =~ s/^freenet://;
437 $uri = "freenet:$uri";
438
408 $self->txn (client_get => URI => $uri, hops_to_live => (defined $htl ? $htl :15), 439 $self->txn (client_get => URI => $uri, hops_to_live => xeh (defined $htl ? $htl : 15),
409 remove_local_key => $removelocal ? "true" : "false"); 440 remove_local_key => $removelocal ? "true" : "false");
410}); 441});
411 442
412=item $txn = $fcp->txn_client_put ($uri, $metadata, $data, $htl, $removelocal) 443=item $txn = $fcp->txn_client_put ($uri, $metadata, $data, $htl, $removelocal)
413 444
… …
424=cut 455=cut
425 456
426$txn->(client_put => sub { 457$txn->(client_put => sub {
427 my ($self, $uri, $meta, $data, $htl, $removelocal) = @_; 458 my ($self, $uri, $meta, $data, $htl, $removelocal) = @_;
428 459
429 $self->txn (client_put => URI => $uri, hops_to_live => (defined $htl ? $htl :15), 460 $self->txn (client_put => URI => $uri, xeh (defined $htl ? $htl : 15),
430 remove_local_key => $removelocal ? "true" : "false", 461 remove_local_key => $removelocal ? "true" : "false",
431 data => "$meta$data", metadata_length => length $meta); 462 data => "$meta$data", metadata_length => xeh length $meta);
432}); 463});
433 464
434} # transactions 465} # transactions
435 466
436=item MISSING: (ClientPut), InsretKey 467=item MISSING: (ClientPut), InsertKey
437 468
438=back 469=back
439 470
440=head2 THE Net::FCP::Txn CLASS 471=head2 THE Net::FCP::Txn CLASS
441 472
442All requests (or transactions) are executed in a asynchroneous way (LIE: 473All requests (or transactions) are executed in a asynchronous way. For
443uploads are blocking). For each request, a C<Net::FCP::Txn> object is 474each request, a C<Net::FCP::Txn> object is created (worse: a tcp
444created (worse: a tcp connection is created, too). 475connection is created, too).
445 476
446For each request there is actually a different subclass (and it's possible 477For each request there is actually a different subclass (and it's possible
447to subclass these, although of course not documented). 478to subclass these, although of course not documented).
448 479
449The most interesting method is C<result>. 480The most interesting method is C<result>.
… …
477 while (my ($k, $v) = each %{$self->{attr}}) { 508 while (my ($k, $v) = each %{$self->{attr}}) {
478 $attr .= (Net::FCP::touc $k) . "=$v\012" 509 $attr .= (Net::FCP::touc $k) . "=$v\012"
479 } 510 }
480 511
481 if (defined $data) { 512 if (defined $data) {
482 $attr .= "DataLength=" . (length $data) . "\012"; 513 $attr .= sprintf "DataLength=%x\012", length $data;
483 $data = "Data\012$data"; 514 $data = "Data\012$data";
484 } else { 515 } else {
485 $data = "EndMessage\012"; 516 $data = "EndMessage\012";
486 } 517 }
487 518
… …
494 and !$!{EINPROGRESS} 525 and !$!{EINPROGRESS}
495 and Carp::croak "FCP::txn: unable to connect to $self->{fcp}{host}:$self->{fcp}{port}: $!\n"; 526 and Carp::croak "FCP::txn: unable to connect to $self->{fcp}{host}:$self->{fcp}{port}: $!\n";
496 527
497 $self->{sbuf} = 528 $self->{sbuf} =
498 "\x00\x00\x00\x02" 529 "\x00\x00\x00\x02"
499 . Net::FCP::touc $self->{type} 530 . (Net::FCP::touc $self->{type})
500 . "\012$attr$data"; 531 . "\012$attr$data";
501 532
502 #$fh->shutdown (1); # freenet buggy?, well, it's java... 533 #shutdown $fh, 1; # freenet buggy?, well, it's java...
503 534
504 $self->{fh} = $fh; 535 $self->{fh} = $fh;
505 536
506 $self->{w} = $EVENT->new_from_fh ($fh)->cb(sub { $self->fh_ready_w })->poll(0, 1, 1); 537 $self->{w} = $EVENT->new_from_fh ($fh)->cb(sub { $self->fh_ready_w })->poll(0, 1, 1);
507 538
… …
666 } 697 }
667} 698}
668 699
669sub progress { 700sub progress {
670 my ($self, $type, $attr) = @_; 701 my ($self, $type, $attr) = @_;
702
671 $self->{fcp}->progress ($self, $type, $attr); 703 $self->{fcp}->progress ($self, $type, $attr);
672} 704}
673 705
674=item $result = $txn->result 706=item $result = $txn->result
675 707
676Waits until a result is available and then returns it. 708Waits until a result is available and then returns it.
677 709
678This waiting is (depending on your event model) not very efficient, as it 710This waiting is (depending on your event model) not very efficient, as it
679is done outside the "mainloop". 711is done outside the "mainloop". The biggest problem, however, is that it's
712blocking one thread of execution. Try to use the callback mechanism, if
713possible, and call result from within the callback (or after is has been
714run), as then no waiting is necessary.
680 715
681=cut 716=cut
682 717
683sub result { 718sub result {
684 my ($self) = @_; 719 my ($self) = @_;
… …
715use base Net::FCP::Txn; 750use base Net::FCP::Txn;
716 751
717sub rcv_success { 752sub rcv_success {
718 my ($self, $attr) = @_; 753 my ($self, $attr) = @_;
719 754
720 $self->set_result ($attr); 755 $self->set_result ($attr->{uri});
721} 756}
722 757
723package Net::FCP::Txn::GenerateSVKPair; 758package Net::FCP::Txn::GenerateSVKPair;
724 759
725use base Net::FCP::Txn; 760use base Net::FCP::Txn;
… …
742 777
743use base Net::FCP::Txn; 778use base Net::FCP::Txn;
744 779
745sub rcv_success { 780sub rcv_success {
746 my ($self, $attr) = @_; 781 my ($self, $attr) = @_;
747 $self->set_result ($attr->{Length}); 782 $self->set_result (hex $attr->{Length});
748} 783}
749 784
750package Net::FCP::Txn::GetPut; 785package Net::FCP::Txn::GetPut;
751 786
752# base class for get and put 787# base class for get and put
753 788
754use base Net::FCP::Txn; 789use base Net::FCP::Txn;
755 790
756*rcv_uri_error = \&Net::FCP::Txn::rcv_throw_exception; 791*rcv_uri_error = \&Net::FCP::Txn::rcv_throw_exception;
757*rcv_route_not_found = \&Net::FCP::Txn::rcv_throw_exception; 792*rcv_route_not_found = \&Net::FCP::Txn::rcv_throw_exception;
758 793
759sub rcv_restarted { 794sub rcv_restarted {
760 my ($self, $attr, $type) = @_; 795 my ($self, $attr, $type) = @_;
761 796
762 delete $self->{datalength}; 797 delete $self->{datalength};
… …
782 if ($self->{datalength} == length $self->{data}) { 817 if ($self->{datalength} == length $self->{data}) {
783 my $data = delete $self->{data}; 818 my $data = delete $self->{data};
784 my $meta = Net::FCP::parse_metadata substr $data, 0, $self->{metalength}, ""; 819 my $meta = Net::FCP::parse_metadata substr $data, 0, $self->{metalength}, "";
785 820
786 $self->set_result ([$meta, $data]); 821 $self->set_result ([$meta, $data]);
822 $self->eof;
787 } 823 }
788} 824}
789 825
790sub rcv_data_found { 826sub rcv_data_found {
791 my ($self, $attr, $type) = @_; 827 my ($self, $attr, $type) = @_;
… …
829 865
830package Net::FCP::Exception; 866package Net::FCP::Exception;
831 867
832use overload 868use overload
833 '""' => sub { 869 '""' => sub {
834 "Net::FCP::Exception<<$_[0][0]," . (join ":", %{$_[0][1]}) . ">>\n"; 870 "Net::FCP::Exception<<$_[0][0]," . (join ":", %{$_[0][1]}) . ">>";
835 }; 871 };
836 872
837=item $exc = new Net::FCP::Exception $type, \%attr 873=item $exc = new Net::FCP::Exception $type, \%attr
838 874
839Create a new exception object of the given type (a string like 875Create a new exception object of the given type (a string like
… …
894=cut 930=cut
895 931
896package Net::FCP::Event::Auto; 932package Net::FCP::Event::Auto;
897 933
898my @models = ( 934my @models = (
899 [Coro => Coro::Event:: ], 935 [Coro => Coro::Event::],
900 [Event => Event::], 936 [Event => Event::],
901 [Glib => Glib:: ], 937 [Glib => Glib::],
902 [Tk => Tk::], 938 [Tk => Tk::],
903); 939);
904 940
905sub AUTOLOAD { 941sub AUTOLOAD {
906 $AUTOLOAD =~ s/.*://; 942 $AUTOLOAD =~ s/.*://;

Diff Legend

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