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.27 by root, Thu May 13 15:41:01 2004 UTC

… …
72 72
73package Net::FCP; 73package Net::FCP;
74 74
75use Carp; 75use Carp;
76 76
77$VERSION = 0.5; 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
108# the opposite of hex 110# the opposite of hex
… …
180 #$meta->{tail} = substr $data, pos $data; 182 #$meta->{tail} = substr $data, pos $data;
181 183
182 $meta; 184 $meta;
183} 185}
184 186
185=item $fcp = new Net::FCP [host => $host][, port => $port] 187=item $fcp = new Net::FCP [host => $host][, port => $port][, progress => \&cb]
186 188
187Create 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
188127.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>).
189 191
190Connections are virtual because no persistent physical connection is 192Connections are virtual because no persistent physical connection is
191established. 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 }
192 204
193=begin comment 205=begin comment
194 206
195However, the existance of the node is checked by executing a 207However, the existance of the node is checked by executing a
196C<ClientHello> transaction. 208C<ClientHello> transaction.
… …
212 $self; 224 $self;
213} 225}
214 226
215sub progress { 227sub progress {
216 my ($self, $txn, $type, $attr) = @_; 228 my ($self, $txn, $type, $attr) = @_;
229
230 $self->{progress}->($self, $txn, $type, $attr)
231 if $self->{progress};
217 #warn "progress<$txn,$type," . (join ":", %$attr) . ">\n"; 232 #warn "progress<$txn,$type," . (join ":", %$attr) . ">\n";
218} 233}
219 234
220=item $txn = $fcp->txn(type => attr => val,...) 235=item $txn = $fcp->txn(type => attr => val,...)
221 236
… …
323 338
324=item $txn = $fcp->txn_generate_chk ($metadata, $data[, $cipher]) 339=item $txn = $fcp->txn_generate_chk ($metadata, $data[, $cipher])
325 340
326=item $uri = $fcp->generate_chk ($metadata, $data[, $cipher]) 341=item $uri = $fcp->generate_chk ($metadata, $data[, $cipher])
327 342
328Calculcates a CHK, given the metadata and data. C<$cipher> is either 343Calculates a CHK, given the metadata and data. C<$cipher> is either
329C<Rijndael> or C<Twofish>, with the latter being the default. 344C<Rijndael> or C<Twofish>, with the latter being the default.
330 345
331=cut 346=cut
332 347
333$txn->(generate_chk => sub { 348$txn->(generate_chk => sub {
… …
401 416
402Fetches a (small, as it should fit into memory) file from 417Fetches a (small, as it should fit into memory) file from
403freenet. C<$meta> is the metadata (as returned by C<parse_metadata> or 418freenet. C<$meta> is the metadata (as returned by C<parse_metadata> or
404C<undef>). 419C<undef>).
405 420
421The C<$uri> should begin with C<freenet:>, but the scheme is currently
422added, if missing.
423
406Due to the overhead, a better method to download big files should be used. 424Due to the overhead, a better method to download big files should be used.
407 425
408 my ($meta, $data) = @{ 426 my ($meta, $data) = @{
409 $fcp->client_get ( 427 $fcp->client_get (
410 "freenet:CHK@hdXaxkwZ9rA8-SidT0AN-bniQlgPAwI,XdCDmBuGsd-ulqbLnZ8v~w" 428 "freenet:CHK@hdXaxkwZ9rA8-SidT0AN-bniQlgPAwI,XdCDmBuGsd-ulqbLnZ8v~w"
… …
413 431
414=cut 432=cut
415 433
416$txn->(client_get => sub { 434$txn->(client_get => sub {
417 my ($self, $uri, $htl, $removelocal) = @_; 435 my ($self, $uri, $htl, $removelocal) = @_;
436
437 $uri =~ s/^freenet://;
438 $uri = "freenet:$uri";
418 439
419 $self->txn (client_get => URI => $uri, hops_to_live => xeh (defined $htl ? $htl : 15), 440 $self->txn (client_get => URI => $uri, hops_to_live => xeh (defined $htl ? $htl : 15),
420 remove_local_key => $removelocal ? "true" : "false"); 441 remove_local_key => $removelocal ? "true" : "false");
421}); 442});
422 443
… …
606 } 627 }
607 } elsif ($self->{buf} =~ s/^DataChunk\015?\012Length=([0-9a-fA-F]+)\015?\012Data\015?\012//) { 628 } elsif ($self->{buf} =~ s/^DataChunk\015?\012Length=([0-9a-fA-F]+)\015?\012Data\015?\012//) {
608 $self->{datalen} = hex $1; 629 $self->{datalen} = hex $1;
609 #warn "expecting new datachunk $self->{datalen}\n";#d# 630 #warn "expecting new datachunk $self->{datalen}\n";#d#
610 } elsif ($self->{buf} =~ s/^([a-zA-Z]+)\015?\012(?:(.+?)\015?\012)?EndMessage\015?\012//s) { 631 } elsif ($self->{buf} =~ s/^([a-zA-Z]+)\015?\012(?:(.+?)\015?\012)?EndMessage\015?\012//s) {
632 print "RECV<$1>\n";
611 $self->rcv ($1, { 633 $self->rcv ($1, {
612 map { my ($a, $b) = split /=/, $_, 2; ((Net::FCP::tolc $a), $b) } 634 map { my ($a, $b) = split /=/, $_, 2; ((Net::FCP::tolc $a), $b) }
613 split /\015?\012/, $2 635 split /\015?\012/, $2
614 }); 636 });
615 } else { 637 } else {
… …
677 } 699 }
678} 700}
679 701
680sub progress { 702sub progress {
681 my ($self, $type, $attr) = @_; 703 my ($self, $type, $attr) = @_;
704
682 $self->{fcp}->progress ($self, $type, $attr); 705 $self->{fcp}->progress ($self, $type, $attr);
683} 706}
684 707
685=item $result = $txn->result 708=item $result = $txn->result
686 709
… …
765 788
766# base class for get and put 789# base class for get and put
767 790
768use base Net::FCP::Txn; 791use base Net::FCP::Txn;
769 792
770*rcv_uri_error = \&Net::FCP::Txn::rcv_throw_exception; 793*rcv_uri_error = \&Net::FCP::Txn::rcv_throw_exception;
771*rcv_route_not_found = \&Net::FCP::Txn::rcv_throw_exception; 794*rcv_route_not_found = \&Net::FCP::Txn::rcv_throw_exception;
772 795
773sub rcv_restarted { 796sub rcv_restarted {
774 my ($self, $attr, $type) = @_; 797 my ($self, $attr, $type) = @_;
775 798
776 delete $self->{datalength}; 799 delete $self->{datalength};
… …
909=cut 932=cut
910 933
911package Net::FCP::Event::Auto; 934package Net::FCP::Event::Auto;
912 935
913my @models = ( 936my @models = (
914 [Coro => Coro::Event:: ], 937 [Coro => Coro::Event::],
915 [Event => Event::], 938 [Event => Event::],
916 [Glib => Glib:: ], 939 [Glib => Glib::],
917 [Tk => Tk::], 940 [Tk => Tk::],
918); 941);
919 942
920sub AUTOLOAD { 943sub AUTOLOAD {
921 $AUTOLOAD =~ s/.*://; 944 $AUTOLOAD =~ s/.*://;

Diff Legend

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