… | |
… | |
34 | |
34 | |
35 | The import tag to use is named C<event=xyz>, e.g. C<event=Event>, |
35 | The import tag to use is named C<event=xyz>, e.g. C<event=Event>, |
36 | C<event=Glib> etc. |
36 | C<event=Glib> etc. |
37 | |
37 | |
38 | You should specify the event module to use only in the main program. |
38 | You should specify the event module to use only in the main program. |
|
|
39 | |
|
|
40 | If no event model has been specified, FCP tries to autodetect it on first |
|
|
41 | use (e.g. first transaction), in this order: Coro, Event, Glib, Tk. |
39 | |
42 | |
40 | =head2 FREENET BASICS |
43 | =head2 FREENET BASICS |
41 | |
44 | |
42 | Ok, this section will not explain any freenet basics to you, just some |
45 | Ok, this section will not explain any freenet basics to you, just some |
43 | problems I found that you might want to avoid: |
46 | problems I found that you might want to avoid: |
… | |
… | |
69 | |
72 | |
70 | package Net::FCP; |
73 | package Net::FCP; |
71 | |
74 | |
72 | use Carp; |
75 | use Carp; |
73 | |
76 | |
74 | $VERSION = 0.08; |
77 | $VERSION = 0.5; |
75 | |
78 | |
76 | no warnings; |
79 | no warnings; |
77 | |
80 | |
78 | our $EVENT = Net::FCP::Event::Auto::; |
81 | our $EVENT = Net::FCP::Event::Auto::; |
79 | $EVENT = Net::FCP::Event::Event;#d# |
|
|
80 | |
82 | |
81 | sub import { |
83 | sub 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 | |
93 | sub touc($) { |
95 | sub 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 | |
108 | Parse a metadata string and return it. |
110 | Parse a metadata string and return it. |
109 | |
111 | |
110 | The metadata will be a hashref with key C<version> (containing |
112 | The metadata will be a hashref with key C<version> (containing the |
111 | the mandatory version header entries). |
113 | mandatory version header entries) and key C<raw> containing the original |
|
|
114 | metadata string. |
112 | |
115 | |
113 | All other headers are represented by arrayrefs (they can be repeated). |
116 | All other headers are represented by arrayrefs (they can be repeated). |
114 | |
117 | |
115 | Since this is confusing, here is a rather verbose example of a parsed |
118 | Since this description is confusing, here is a rather verbose example of a |
116 | manifest: |
119 | parsed 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 | |
140 | sub parse_metadata { |
144 | sub 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) { |
… | |
… | |
310 | my ($self) = @_; |
314 | my ($self) = @_; |
311 | |
315 | |
312 | $self->txn ("client_info"); |
316 | $self->txn ("client_info"); |
313 | }); |
317 | }); |
314 | |
318 | |
315 | =item $txn = $fcp->txn_generate_chk ($metadata, $data) |
319 | =item $txn = $fcp->txn_generate_chk ($metadata, $data[, $cipher]) |
316 | |
320 | |
317 | =item $uri = $fcp->generate_chk ($metadata, $data) |
321 | =item $uri = $fcp->generate_chk ($metadata, $data[, $cipher]) |
318 | |
322 | |
319 | Creates a new CHK, given the metadata and data. UNTESTED. |
323 | Calculcates a CHK, given the metadata and data. C<$cipher> is either |
|
|
324 | C<Rijndael> or C<Twofish>, with the latter being the default. |
320 | |
325 | |
321 | =cut |
326 | =cut |
322 | |
327 | |
323 | $txn->(generate_chk => sub { |
328 | $txn->(generate_chk => sub { |
324 | my ($self, $metadata, $data) = @_; |
329 | my ($self, $metadata, $data, $cipher) = @_; |
325 | |
330 | |
326 | $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"); |
327 | }); |
335 | }); |
328 | |
336 | |
329 | =item $txn = $fcp->txn_generate_svk_pair |
337 | =item $txn = $fcp->txn_generate_svk_pair |
330 | |
338 | |
331 | =item ($public, $private) = @{ $fcp->generate_svk_pair } |
339 | =item ($public, $private) = @{ $fcp->generate_svk_pair } |
… | |
… | |
475 | while (my ($k, $v) = each %{$self->{attr}}) { |
483 | while (my ($k, $v) = each %{$self->{attr}}) { |
476 | $attr .= (Net::FCP::touc $k) . "=$v\012" |
484 | $attr .= (Net::FCP::touc $k) . "=$v\012" |
477 | } |
485 | } |
478 | |
486 | |
479 | if (defined $data) { |
487 | if (defined $data) { |
480 | $attr .= "DataLength=" . (length $data) . "\012"; |
488 | $attr .= sprintf "DataLength=%x\012", length $data; |
481 | $data = "Data\012$data"; |
489 | $data = "Data\012$data"; |
482 | } else { |
490 | } else { |
483 | $data = "EndMessage\012"; |
491 | $data = "EndMessage\012"; |
484 | } |
492 | } |
485 | |
493 | |
… | |
… | |
492 | and !$!{EINPROGRESS} |
500 | and !$!{EINPROGRESS} |
493 | 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"; |
494 | |
502 | |
495 | $self->{sbuf} = |
503 | $self->{sbuf} = |
496 | "\x00\x00\x00\x02" |
504 | "\x00\x00\x00\x02" |
497 | . Net::FCP::touc $self->{type} |
505 | . (Net::FCP::touc $self->{type}) |
498 | . "\012$attr$data"; |
506 | . "\012$attr$data"; |
499 | |
507 | |
500 | #$fh->shutdown (1); # freenet buggy?, well, it's java... |
508 | #shutdown $fh, 1; # freenet buggy?, well, it's java... |
501 | |
509 | |
502 | $self->{fh} = $fh; |
510 | $self->{fh} = $fh; |
503 | |
511 | |
504 | $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); |
505 | |
513 | |
… | |
… | |
713 | use base Net::FCP::Txn; |
721 | use base Net::FCP::Txn; |
714 | |
722 | |
715 | sub rcv_success { |
723 | sub rcv_success { |
716 | my ($self, $attr) = @_; |
724 | my ($self, $attr) = @_; |
717 | |
725 | |
718 | $self->set_result ($attr); |
726 | $self->set_result ($attr->{uri}); |
719 | } |
727 | } |
720 | |
728 | |
721 | package Net::FCP::Txn::GenerateSVKPair; |
729 | package Net::FCP::Txn::GenerateSVKPair; |
722 | |
730 | |
723 | use base Net::FCP::Txn; |
731 | use base Net::FCP::Txn; |
… | |
… | |
780 | if ($self->{datalength} == length $self->{data}) { |
788 | if ($self->{datalength} == length $self->{data}) { |
781 | my $data = delete $self->{data}; |
789 | my $data = delete $self->{data}; |
782 | my $meta = Net::FCP::parse_metadata substr $data, 0, $self->{metalength}, ""; |
790 | my $meta = Net::FCP::parse_metadata substr $data, 0, $self->{metalength}, ""; |
783 | |
791 | |
784 | $self->set_result ([$meta, $data]); |
792 | $self->set_result ([$meta, $data]); |
|
|
793 | $self->eof; |
785 | } |
794 | } |
786 | } |
795 | } |
787 | |
796 | |
788 | sub rcv_data_found { |
797 | sub rcv_data_found { |
789 | my ($self, $attr, $type) = @_; |
798 | my ($self, $attr, $type) = @_; |
… | |
… | |
827 | |
836 | |
828 | package Net::FCP::Exception; |
837 | package Net::FCP::Exception; |
829 | |
838 | |
830 | use overload |
839 | use overload |
831 | '""' => sub { |
840 | '""' => sub { |
832 | "Net::FCP::Exception<<$_[0][0]," . (join ":", %{$_[0][1]}) . ">>\n"; |
841 | "Net::FCP::Exception<<$_[0][0]," . (join ":", %{$_[0][1]}) . ">>"; |
833 | }; |
842 | }; |
834 | |
843 | |
835 | =item $exc = new Net::FCP::Exception $type, \%attr |
844 | =item $exc = new Net::FCP::Exception $type, \%attr |
836 | |
845 | |
837 | Create a new exception object of the given type (a string like |
846 | Create a new exception object of the given type (a string like |
… | |
… | |
889 | Marc Lehmann <pcg@goof.com> |
898 | Marc Lehmann <pcg@goof.com> |
890 | http://www.goof.com/pcg/marc/ |
899 | http://www.goof.com/pcg/marc/ |
891 | |
900 | |
892 | =cut |
901 | =cut |
893 | |
902 | |
|
|
903 | package Net::FCP::Event::Auto; |
|
|
904 | |
|
|
905 | my @models = ( |
|
|
906 | [Coro => Coro::Event:: ], |
|
|
907 | [Event => Event::], |
|
|
908 | [Glib => Glib:: ], |
|
|
909 | [Tk => Tk::], |
|
|
910 | ); |
|
|
911 | |
|
|
912 | sub AUTOLOAD { |
|
|
913 | $AUTOLOAD =~ s/.*://; |
|
|
914 | |
|
|
915 | for (@models) { |
|
|
916 | my ($model, $package) = @$_; |
|
|
917 | if (defined ${"$package\::VERSION"}) { |
|
|
918 | $EVENT = "Net::FCP::Event::$model"; |
|
|
919 | eval "require $EVENT"; die if $@; |
|
|
920 | goto &{"$EVENT\::$AUTOLOAD"}; |
|
|
921 | } |
|
|
922 | } |
|
|
923 | |
|
|
924 | for (@models) { |
|
|
925 | my ($model, $package) = @$_; |
|
|
926 | $EVENT = "Net::FCP::Event::$model"; |
|
|
927 | if (eval "require $EVENT") { |
|
|
928 | goto &{"$EVENT\::$AUTOLOAD"}; |
|
|
929 | } |
|
|
930 | } |
|
|
931 | |
|
|
932 | die "No event module selected for Net::FCP and autodetect failed. Install any of these: Coro, Event, Glib or Tk."; |
|
|
933 | } |
|
|
934 | |
894 | 1; |
935 | 1; |
895 | |
936 | |