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.19 by root, Sun Sep 14 09:48:01 2003 UTC vs.
Revision 1.23 by root, Wed Sep 17 08:57:32 2003 UTC

34 34
35The import tag to use is named C<event=xyz>, e.g. C<event=Event>, 35The import tag to use is named C<event=xyz>, e.g. C<event=Event>,
36C<event=Glib> etc. 36C<event=Glib> etc.
37 37
38You should specify the event module to use only in the main program. 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.
39 42
40=head2 FREENET BASICS 43=head2 FREENET BASICS
41 44
42Ok, this section will not explain any freenet basics to you, just some 45Ok, this section will not explain any freenet basics to you, just some
43problems I found that you might want to avoid: 46problems I found that you might want to avoid:
69 72
70package Net::FCP; 73package Net::FCP;
71 74
72use Carp; 75use Carp;
73 76
74$VERSION = 0.08; 77$VERSION = 0.5;
75 78
76no warnings; 79no warnings;
77 80
78our $EVENT = Net::FCP::Event::Auto::; 81our $EVENT = Net::FCP::Event::Auto::;
79$EVENT = Net::FCP::Event::Event;#d#
80 82
81sub import { 83sub import {
82 shift; 84 shift;
83 85
84 for (@_) { 86 for (@_) {
85 if (/^event=(\w+)$/) { 87 if (/^event=(\w+)$/) {
86 $EVENT = "Net::FCP::Event::$1"; 88 $EVENT = "Net::FCP::Event::$1";
89 eval "require $EVENT";
87 } 90 }
88 } 91 }
89 eval "require $EVENT";
90 die $@ if $@; 92 die $@ if $@;
91} 93}
92 94
93sub touc($) { 95sub touc($) {
94 local $_ = shift; 96 local $_ = shift;
101 local $_ = shift; 103 local $_ = shift;
102 s/(?<=[a-z])(?=[A-Z])/_/g; 104 s/(?<=[a-z])(?=[A-Z])/_/g;
103 lc $_; 105 lc $_;
104} 106}
105 107
108# the opposite of hex
109sub xeh($) {
110 sprintf "%x", $_[0];
111}
112
106=item $meta = Net::FCP::parse_metadata $string 113=item $meta = Net::FCP::parse_metadata $string
107 114
108Parse a metadata string and return it. 115Parse a metadata string and return it.
109 116
110The metadata will be a hashref with key C<version> (containing 117The metadata will be a hashref with key C<version> (containing the
111the mandatory version header entries). 118mandatory version header entries) and key C<raw> containing the original
119metadata string.
112 120
113All other headers are represented by arrayrefs (they can be repeated). 121All other headers are represented by arrayrefs (they can be repeated).
114 122
115Since this is confusing, here is a rather verbose example of a parsed 123Since this description is confusing, here is a rather verbose example of a
116manifest: 124parsed manifest:
117 125
118 ( 126 (
127 raw => "Version...",
119 version => { revision => 1 }, 128 version => { revision => 1 },
120 document => [ 129 document => [
121 { 130 {
122 info => { format" => "image/jpeg" }, 131 info => { format" => "image/jpeg" },
123 name => "background.jpg", 132 name => "background.jpg",
136 ) 145 )
137 146
138=cut 147=cut
139 148
140sub parse_metadata { 149sub parse_metadata {
141 my $meta;
142
143 my $data = shift; 150 my $data = shift;
151 my $meta = { raw => $data };
152
144 if ($data =~ /^Version\015?\012/gc) { 153 if ($data =~ /^Version\015?\012/gc) {
145 my $hdr = $meta->{version} = {}; 154 my $hdr = $meta->{version} = {};
146 155
147 for (;;) { 156 for (;;) {
148 while ($data =~ /\G([^=\015\012]+)=([^\015\012]*)\015?\012/gc) { 157 while ($data =~ /\G([^=\015\012]+)=([^\015\012]*)\015?\012/gc) {
310 my ($self) = @_; 319 my ($self) = @_;
311 320
312 $self->txn ("client_info"); 321 $self->txn ("client_info");
313}); 322});
314 323
315=item $txn = $fcp->txn_generate_chk ($metadata, $data) 324=item $txn = $fcp->txn_generate_chk ($metadata, $data[, $cipher])
316 325
317=item $uri = $fcp->generate_chk ($metadata, $data) 326=item $uri = $fcp->generate_chk ($metadata, $data[, $cipher])
318 327
319Creates a new CHK, given the metadata and data. UNTESTED. 328Calculcates a CHK, given the metadata and data. C<$cipher> is either
329C<Rijndael> or C<Twofish>, with the latter being the default.
320 330
321=cut 331=cut
322 332
323$txn->(generate_chk => sub { 333$txn->(generate_chk => sub {
324 my ($self, $metadata, $data) = @_; 334 my ($self, $metadata, $data, $cipher) = @_;
325 335
326 $self->txn (generate_chk => data => "$metadata$data", metadata_length => length $metadata); 336 $self->txn (generate_chk =>
337 data => "$metadata$data",
338 metadata_length => xeh length $metadata,
339 cipher => $cipher || "Twofish");
327}); 340});
328 341
329=item $txn = $fcp->txn_generate_svk_pair 342=item $txn = $fcp->txn_generate_svk_pair
330 343
331=item ($public, $private) = @{ $fcp->generate_svk_pair } 344=item ($public, $private) = @{ $fcp->generate_svk_pair }
401=cut 414=cut
402 415
403$txn->(client_get => sub { 416$txn->(client_get => sub {
404 my ($self, $uri, $htl, $removelocal) = @_; 417 my ($self, $uri, $htl, $removelocal) = @_;
405 418
406 $self->txn (client_get => URI => $uri, hops_to_live => (defined $htl ? $htl :15), 419 $self->txn (client_get => URI => $uri, hops_to_live => xeh (defined $htl ? $htl : 15),
407 remove_local_key => $removelocal ? "true" : "false"); 420 remove_local_key => $removelocal ? "true" : "false");
408}); 421});
409 422
410=item $txn = $fcp->txn_client_put ($uri, $metadata, $data, $htl, $removelocal) 423=item $txn = $fcp->txn_client_put ($uri, $metadata, $data, $htl, $removelocal)
411 424
422=cut 435=cut
423 436
424$txn->(client_put => sub { 437$txn->(client_put => sub {
425 my ($self, $uri, $meta, $data, $htl, $removelocal) = @_; 438 my ($self, $uri, $meta, $data, $htl, $removelocal) = @_;
426 439
427 $self->txn (client_put => URI => $uri, hops_to_live => (defined $htl ? $htl :15), 440 $self->txn (client_put => URI => $uri, xeh (defined $htl ? $htl : 15),
428 remove_local_key => $removelocal ? "true" : "false", 441 remove_local_key => $removelocal ? "true" : "false",
429 data => "$meta$data", metadata_length => length $meta); 442 data => "$meta$data", metadata_length => xeh length $meta);
430}); 443});
431 444
432} # transactions 445} # transactions
433 446
434=item MISSING: (ClientPut), InsretKey 447=item MISSING: (ClientPut), InsertKey
435 448
436=back 449=back
437 450
438=head2 THE Net::FCP::Txn CLASS 451=head2 THE Net::FCP::Txn CLASS
439 452
440All requests (or transactions) are executed in a asynchroneous way (LIE: 453All requests (or transactions) are executed in a asynchronous way. For
441uploads are blocking). For each request, a C<Net::FCP::Txn> object is 454each request, a C<Net::FCP::Txn> object is created (worse: a tcp
442created (worse: a tcp connection is created, too). 455connection is created, too).
443 456
444For each request there is actually a different subclass (and it's possible 457For each request there is actually a different subclass (and it's possible
445to subclass these, although of course not documented). 458to subclass these, although of course not documented).
446 459
447The most interesting method is C<result>. 460The most interesting method is C<result>.
475 while (my ($k, $v) = each %{$self->{attr}}) { 488 while (my ($k, $v) = each %{$self->{attr}}) {
476 $attr .= (Net::FCP::touc $k) . "=$v\012" 489 $attr .= (Net::FCP::touc $k) . "=$v\012"
477 } 490 }
478 491
479 if (defined $data) { 492 if (defined $data) {
480 $attr .= "DataLength=" . (length $data) . "\012"; 493 $attr .= sprintf "DataLength=%x\012", length $data;
481 $data = "Data\012$data"; 494 $data = "Data\012$data";
482 } else { 495 } else {
483 $data = "EndMessage\012"; 496 $data = "EndMessage\012";
484 } 497 }
485 498
492 and !$!{EINPROGRESS} 505 and !$!{EINPROGRESS}
493 and Carp::croak "FCP::txn: unable to connect to $self->{fcp}{host}:$self->{fcp}{port}: $!\n"; 506 and Carp::croak "FCP::txn: unable to connect to $self->{fcp}{host}:$self->{fcp}{port}: $!\n";
494 507
495 $self->{sbuf} = 508 $self->{sbuf} =
496 "\x00\x00\x00\x02" 509 "\x00\x00\x00\x02"
497 . Net::FCP::touc $self->{type} 510 . (Net::FCP::touc $self->{type})
498 . "\012$attr$data"; 511 . "\012$attr$data";
499 512
500 #$fh->shutdown (1); # freenet buggy?, well, it's java... 513 #shutdown $fh, 1; # freenet buggy?, well, it's java...
501 514
502 $self->{fh} = $fh; 515 $self->{fh} = $fh;
503 516
504 $self->{w} = $EVENT->new_from_fh ($fh)->cb(sub { $self->fh_ready_w })->poll(0, 1, 1); 517 $self->{w} = $EVENT->new_from_fh ($fh)->cb(sub { $self->fh_ready_w })->poll(0, 1, 1);
505 518
672=item $result = $txn->result 685=item $result = $txn->result
673 686
674Waits until a result is available and then returns it. 687Waits until a result is available and then returns it.
675 688
676This waiting is (depending on your event model) not very efficient, as it 689This waiting is (depending on your event model) not very efficient, as it
677is done outside the "mainloop". 690is done outside the "mainloop". The biggest problem, however, is that it's
691blocking one thread of execution. Try to use the callback mechanism, if
692possible, and call result from within the callback (or after is has been
693run), as then no waiting is necessary.
678 694
679=cut 695=cut
680 696
681sub result { 697sub result {
682 my ($self) = @_; 698 my ($self) = @_;
713use base Net::FCP::Txn; 729use base Net::FCP::Txn;
714 730
715sub rcv_success { 731sub rcv_success {
716 my ($self, $attr) = @_; 732 my ($self, $attr) = @_;
717 733
718 $self->set_result ($attr); 734 $self->set_result ($attr->{uri});
719} 735}
720 736
721package Net::FCP::Txn::GenerateSVKPair; 737package Net::FCP::Txn::GenerateSVKPair;
722 738
723use base Net::FCP::Txn; 739use base Net::FCP::Txn;
740 756
741use base Net::FCP::Txn; 757use base Net::FCP::Txn;
742 758
743sub rcv_success { 759sub rcv_success {
744 my ($self, $attr) = @_; 760 my ($self, $attr) = @_;
745 $self->set_result ($attr->{Length}); 761 $self->set_result (hex $attr->{Length});
746} 762}
747 763
748package Net::FCP::Txn::GetPut; 764package Net::FCP::Txn::GetPut;
749 765
750# base class for get and put 766# base class for get and put
780 if ($self->{datalength} == length $self->{data}) { 796 if ($self->{datalength} == length $self->{data}) {
781 my $data = delete $self->{data}; 797 my $data = delete $self->{data};
782 my $meta = Net::FCP::parse_metadata substr $data, 0, $self->{metalength}, ""; 798 my $meta = Net::FCP::parse_metadata substr $data, 0, $self->{metalength}, "";
783 799
784 $self->set_result ([$meta, $data]); 800 $self->set_result ([$meta, $data]);
801 $self->eof;
785 } 802 }
786} 803}
787 804
788sub rcv_data_found { 805sub rcv_data_found {
789 my ($self, $attr, $type) = @_; 806 my ($self, $attr, $type) = @_;
827 844
828package Net::FCP::Exception; 845package Net::FCP::Exception;
829 846
830use overload 847use overload
831 '""' => sub { 848 '""' => sub {
832 "Net::FCP::Exception<<$_[0][0]," . (join ":", %{$_[0][1]}) . ">>\n"; 849 "Net::FCP::Exception<<$_[0][0]," . (join ":", %{$_[0][1]}) . ">>";
833 }; 850 };
834 851
835=item $exc = new Net::FCP::Exception $type, \%attr 852=item $exc = new Net::FCP::Exception $type, \%attr
836 853
837Create a new exception object of the given type (a string like 854Create a new exception object of the given type (a string like
889 Marc Lehmann <pcg@goof.com> 906 Marc Lehmann <pcg@goof.com>
890 http://www.goof.com/pcg/marc/ 907 http://www.goof.com/pcg/marc/
891 908
892=cut 909=cut
893 910
911package Net::FCP::Event::Auto;
912
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
8941; 9431;
895 944

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines