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.17 by root, Fri Sep 12 03:28:45 2003 UTC vs.
Revision 1.21 by root, Tue Sep 16 07:00:59 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.07; 77$VERSION = 0.08;
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;
105 107
106=item $meta = Net::FCP::parse_metadata $string 108=item $meta = Net::FCP::parse_metadata $string
107 109
108Parse a metadata string and return it. 110Parse a metadata string and return it.
109 111
110The metadata will be a hashref with key C<version> (containing 112The metadata will be a hashref with key C<version> (containing the
111the mandatory version header entries). 113mandatory version header entries) and key C<raw> containing the original
114metadata string.
112 115
113All other headers are represented by arrayrefs (they can be repeated). 116All other headers are represented by arrayrefs (they can be repeated).
114 117
115Since this is confusing, here is a rather verbose example of a parsed 118Since this description is confusing, here is a rather verbose example of a
116manifest: 119parsed manifest:
117 120
118 ( 121 (
122 raw => "Version...",
119 version => { revision => 1 }, 123 version => { revision => 1 },
120 document => [ 124 document => [
121 { 125 {
122 info => { format" => "image/jpeg" }, 126 info => { format" => "image/jpeg" },
123 name => "background.jpg", 127 name => "background.jpg",
136 ) 140 )
137 141
138=cut 142=cut
139 143
140sub parse_metadata { 144sub parse_metadata {
141 my $meta;
142
143 my $data = shift; 145 my $data = shift;
146 my $meta = { raw => $data };
147
144 if ($data =~ /^Version\015?\012/gc) { 148 if ($data =~ /^Version\015?\012/gc) {
145 my $hdr = $meta->{version} = {}; 149 my $hdr = $meta->{version} = {};
146 150
147 for (;;) { 151 for (;;) {
148 while ($data =~ /\G([^=\015\012]+)=([^\015\012]*)\015?\012/gc) { 152 while ($data =~ /\G([^=\015\012]+)=([^\015\012]*)\015?\012/gc) {
160 } elsif ($data =~ /\GEnd(\015?\012|$)/gc) { 164 } elsif ($data =~ /\GEnd(\015?\012|$)/gc) {
161 last; 165 last;
162 } elsif ($data =~ /\G([A-Za-z0-9.\-]+)\015?\012/gcs) { 166 } elsif ($data =~ /\G([A-Za-z0-9.\-]+)\015?\012/gcs) {
163 push @{$meta->{tolc $1}}, $hdr = {}; 167 push @{$meta->{tolc $1}}, $hdr = {};
164 } elsif ($data =~ /\G(.*)/gcs) { 168 } elsif ($data =~ /\G(.*)/gcs) {
165 die "metadata format error ($1), please report this string: <<$data>>"; 169 print STDERR "metadata format error ($1), please report this string: <<$data>>";
170 die "metadata format error";
166 } 171 }
167 } 172 }
168 } 173 }
169 174
170 #$meta->{tail} = substr $data, pos $data; 175 #$meta->{tail} = substr $data, pos $data;
202 $self; 207 $self;
203} 208}
204 209
205sub progress { 210sub progress {
206 my ($self, $txn, $type, $attr) = @_; 211 my ($self, $txn, $type, $attr) = @_;
207 warn "progress<$txn,$type," . (join ":", %$attr) . ">\n"; 212 #warn "progress<$txn,$type," . (join ":", %$attr) . ">\n";
208} 213}
209 214
210=item $txn = $fcp->txn(type => attr => val,...) 215=item $txn = $fcp->txn(type => attr => val,...)
211 216
212The low-level interface to transactions. Don't use it. 217The low-level interface to transactions. Don't use it.
309 my ($self) = @_; 314 my ($self) = @_;
310 315
311 $self->txn ("client_info"); 316 $self->txn ("client_info");
312}); 317});
313 318
314=item $txn = $fcp->txn_generate_chk ($metadata, $data) 319=item $txn = $fcp->txn_generate_chk ($metadata, $data[, $cipher])
315 320
316=item $uri = $fcp->generate_chk ($metadata, $data) 321=item $uri = $fcp->generate_chk ($metadata, $data[, $cipher])
317 322
318Creates a new CHK, given the metadata and data. UNTESTED. 323Calculcates a CHK, given the metadata and data. C<$cipher> is either
324C<Rijndael> or C<Twofish>, with the latter being the default.
319 325
320=cut 326=cut
321 327
322$txn->(generate_chk => sub { 328$txn->(generate_chk => sub {
323 my ($self, $metadata, $data) = @_; 329 my ($self, $metadata, $data, $cipher) = @_;
324 330
325 $self->txn (generate_chk => data => "$metadata$data", metadata_length => length $metadata); 331 $self->txn (generate_chk =>
332 data => "$metadata$data",
333 metadata_length => length $metadata,
334 cipher => $cipher || "Twofish");
326}); 335});
327 336
328=item $txn = $fcp->txn_generate_svk_pair 337=item $txn = $fcp->txn_generate_svk_pair
329 338
330=item ($public, $private) = @{ $fcp->generate_svk_pair } 339=item ($public, $private) = @{ $fcp->generate_svk_pair }
474 while (my ($k, $v) = each %{$self->{attr}}) { 483 while (my ($k, $v) = each %{$self->{attr}}) {
475 $attr .= (Net::FCP::touc $k) . "=$v\012" 484 $attr .= (Net::FCP::touc $k) . "=$v\012"
476 } 485 }
477 486
478 if (defined $data) { 487 if (defined $data) {
479 $attr .= "DataLength=" . (length $data) . "\012"; 488 $attr .= sprintf "DataLength=%x\012", length $data;
480 $data = "Data\012$data"; 489 $data = "Data\012$data";
481 } else { 490 } else {
482 $data = "EndMessage\012"; 491 $data = "EndMessage\012";
483 } 492 }
484 493
491 and !$!{EINPROGRESS} 500 and !$!{EINPROGRESS}
492 and Carp::croak "FCP::txn: unable to connect to $self->{fcp}{host}:$self->{fcp}{port}: $!\n"; 501 and Carp::croak "FCP::txn: unable to connect to $self->{fcp}{host}:$self->{fcp}{port}: $!\n";
493 502
494 $self->{sbuf} = 503 $self->{sbuf} =
495 "\x00\x00\x00\x02" 504 "\x00\x00\x00\x02"
496 . Net::FCP::touc $self->{type} 505 . (Net::FCP::touc $self->{type})
497 . "\012$attr$data"; 506 . "\012$attr$data";
498 507
499 #$fh->shutdown (1); # freenet buggy?, well, it's java... 508 #shutdown $fh, 1; # freenet buggy?, well, it's java...
500 509
501 $self->{fh} = $fh; 510 $self->{fh} = $fh;
502 511
503 $self->{w} = $EVENT->new_from_fh ($fh)->cb(sub { $self->fh_ready_w })->poll(0, 1, 1); 512 $self->{w} = $EVENT->new_from_fh ($fh)->cb(sub { $self->fh_ready_w })->poll(0, 1, 1);
504 513
712use base Net::FCP::Txn; 721use base Net::FCP::Txn;
713 722
714sub rcv_success { 723sub rcv_success {
715 my ($self, $attr) = @_; 724 my ($self, $attr) = @_;
716 725
717 $self->set_result ($attr); 726 $self->set_result ($attr->{uri});
718} 727}
719 728
720package Net::FCP::Txn::GenerateSVKPair; 729package Net::FCP::Txn::GenerateSVKPair;
721 730
722use base Net::FCP::Txn; 731use base Net::FCP::Txn;
772sub rcv_data { 781sub rcv_data {
773 my ($self, $chunk) = @_; 782 my ($self, $chunk) = @_;
774 783
775 $self->{data} .= $chunk; 784 $self->{data} .= $chunk;
776 785
777 $self->progress ("data", { chunk => length $chunk, total => length $self->{data}, end => $self->{datalength} }); 786 $self->progress ("data", { chunk => length $chunk, received => length $self->{data}, total => $self->{datalength} });
778 787
779 if ($self->{datalength} == length $self->{data}) { 788 if ($self->{datalength} == length $self->{data}) {
780 my $data = delete $self->{data}; 789 my $data = delete $self->{data};
781 my $meta = Net::FCP::parse_metadata substr $data, 0, $self->{metalength}, ""; 790 my $meta = Net::FCP::parse_metadata substr $data, 0, $self->{metalength}, "";
782 791
888 Marc Lehmann <pcg@goof.com> 897 Marc Lehmann <pcg@goof.com>
889 http://www.goof.com/pcg/marc/ 898 http://www.goof.com/pcg/marc/
890 899
891=cut 900=cut
892 901
902package Net::FCP::Event::Auto;
903
904my @models = (
905 [Coro => Coro::Event:: ],
906 [Event => Event::],
907 [Glib => Glib:: ],
908 [Tk => Tk::],
909);
910
911sub AUTOLOAD {
912 $AUTOLOAD =~ s/.*://;
913
914 for (@models) {
915 my ($model, $package) = @$_;
916 if (defined ${"$package\::VERSION"}) {
917 $EVENT = "Net::FCP::Event::$model";
918 eval "require $EVENT"; die if $@;
919 goto &{"$EVENT\::$AUTOLOAD"};
920 }
921 }
922
923 for (@models) {
924 my ($model, $package) = @$_;
925 $EVENT = "Net::FCP::Event::$model";
926 if (eval "require $EVENT") {
927 goto &{"$EVENT\::$AUTOLOAD"};
928 }
929 }
930
931 die "No event module selected for Net::FCP and autodetect failed. Install any of these: Coro, Event, Glib or Tk.";
932}
933
8931; 9341;
894 935

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines