… | |
… | |
72 | |
72 | |
73 | package Net::FCP; |
73 | package Net::FCP; |
74 | |
74 | |
75 | use Carp; |
75 | use Carp; |
76 | |
76 | |
77 | $VERSION = 0.5; |
77 | $VERSION = 0.6; |
78 | |
78 | |
79 | no warnings; |
79 | no warnings; |
80 | |
80 | |
81 | our $EVENT = Net::FCP::Event::Auto::; |
81 | our $EVENT = Net::FCP::Event::Auto::; |
82 | |
82 | |
… | |
… | |
101 | |
101 | |
102 | sub tolc($) { |
102 | sub tolc($) { |
103 | local $_ = shift; |
103 | local $_ = shift; |
104 | s/(?<=[a-z])(?=[A-Z])/_/g; |
104 | s/(?<=[a-z])(?=[A-Z])/_/g; |
105 | lc $_; |
105 | lc $_; |
|
|
106 | } |
|
|
107 | |
|
|
108 | # the opposite of hex |
|
|
109 | sub xeh($) { |
|
|
110 | sprintf "%x", $_[0]; |
106 | } |
111 | } |
107 | |
112 | |
108 | =item $meta = Net::FCP::parse_metadata $string |
113 | =item $meta = Net::FCP::parse_metadata $string |
109 | |
114 | |
110 | Parse a metadata string and return it. |
115 | Parse a metadata string and return it. |
… | |
… | |
328 | $txn->(generate_chk => sub { |
333 | $txn->(generate_chk => sub { |
329 | my ($self, $metadata, $data, $cipher) = @_; |
334 | my ($self, $metadata, $data, $cipher) = @_; |
330 | |
335 | |
331 | $self->txn (generate_chk => |
336 | $self->txn (generate_chk => |
332 | data => "$metadata$data", |
337 | data => "$metadata$data", |
333 | metadata_length => length $metadata, |
338 | metadata_length => xeh length $metadata, |
334 | cipher => $cipher || "Twofish"); |
339 | cipher => $cipher || "Twofish"); |
335 | }); |
340 | }); |
336 | |
341 | |
337 | =item $txn = $fcp->txn_generate_svk_pair |
342 | =item $txn = $fcp->txn_generate_svk_pair |
338 | |
343 | |
… | |
… | |
409 | =cut |
414 | =cut |
410 | |
415 | |
411 | $txn->(client_get => sub { |
416 | $txn->(client_get => sub { |
412 | my ($self, $uri, $htl, $removelocal) = @_; |
417 | my ($self, $uri, $htl, $removelocal) = @_; |
413 | |
418 | |
414 | $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), |
415 | remove_local_key => $removelocal ? "true" : "false"); |
420 | remove_local_key => $removelocal ? "true" : "false"); |
416 | }); |
421 | }); |
417 | |
422 | |
418 | =item $txn = $fcp->txn_client_put ($uri, $metadata, $data, $htl, $removelocal) |
423 | =item $txn = $fcp->txn_client_put ($uri, $metadata, $data, $htl, $removelocal) |
419 | |
424 | |
… | |
… | |
430 | =cut |
435 | =cut |
431 | |
436 | |
432 | $txn->(client_put => sub { |
437 | $txn->(client_put => sub { |
433 | my ($self, $uri, $meta, $data, $htl, $removelocal) = @_; |
438 | my ($self, $uri, $meta, $data, $htl, $removelocal) = @_; |
434 | |
439 | |
435 | $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), |
436 | remove_local_key => $removelocal ? "true" : "false", |
441 | remove_local_key => $removelocal ? "true" : "false", |
437 | data => "$meta$data", metadata_length => length $meta); |
442 | data => "$meta$data", metadata_length => xeh length $meta); |
438 | }); |
443 | }); |
439 | |
444 | |
440 | } # transactions |
445 | } # transactions |
441 | |
446 | |
442 | =item MISSING: (ClientPut), InsretKey |
447 | =item MISSING: (ClientPut), InsertKey |
443 | |
448 | |
444 | =back |
449 | =back |
445 | |
450 | |
446 | =head2 THE Net::FCP::Txn CLASS |
451 | =head2 THE Net::FCP::Txn CLASS |
447 | |
452 | |
448 | All requests (or transactions) are executed in a asynchroneous way (LIE: |
453 | All requests (or transactions) are executed in a asynchronous way. For |
449 | uploads are blocking). For each request, a C<Net::FCP::Txn> object is |
454 | each request, a C<Net::FCP::Txn> object is created (worse: a tcp |
450 | created (worse: a tcp connection is created, too). |
455 | connection is created, too). |
451 | |
456 | |
452 | For each request there is actually a different subclass (and it's possible |
457 | For each request there is actually a different subclass (and it's possible |
453 | to subclass these, although of course not documented). |
458 | to subclass these, although of course not documented). |
454 | |
459 | |
455 | The most interesting method is C<result>. |
460 | The most interesting method is C<result>. |
… | |
… | |
680 | =item $result = $txn->result |
685 | =item $result = $txn->result |
681 | |
686 | |
682 | Waits until a result is available and then returns it. |
687 | Waits until a result is available and then returns it. |
683 | |
688 | |
684 | This waiting is (depending on your event model) not very efficient, as it |
689 | This waiting is (depending on your event model) not very efficient, as it |
685 | is done outside the "mainloop". |
690 | is done outside the "mainloop". The biggest problem, however, is that it's |
|
|
691 | blocking one thread of execution. Try to use the callback mechanism, if |
|
|
692 | possible, and call result from within the callback (or after is has been |
|
|
693 | run), as then no waiting is necessary. |
686 | |
694 | |
687 | =cut |
695 | =cut |
688 | |
696 | |
689 | sub result { |
697 | sub result { |
690 | my ($self) = @_; |
698 | my ($self) = @_; |
… | |
… | |
748 | |
756 | |
749 | use base Net::FCP::Txn; |
757 | use base Net::FCP::Txn; |
750 | |
758 | |
751 | sub rcv_success { |
759 | sub rcv_success { |
752 | my ($self, $attr) = @_; |
760 | my ($self, $attr) = @_; |
753 | $self->set_result ($attr->{Length}); |
761 | $self->set_result (hex $attr->{Length}); |
754 | } |
762 | } |
755 | |
763 | |
756 | package Net::FCP::Txn::GetPut; |
764 | package Net::FCP::Txn::GetPut; |
757 | |
765 | |
758 | # base class for get and put |
766 | # base class for get and put |
759 | |
767 | |
760 | use base Net::FCP::Txn; |
768 | use base Net::FCP::Txn; |
761 | |
769 | |
762 | *rcv_uri_error = \&Net::FCP::Txn::rcv_throw_exception; |
770 | *rcv_urierror = \&Net::FCP::Txn::rcv_throw_exception; |
763 | *rcv_route_not_found = \&Net::FCP::Txn::rcv_throw_exception; |
771 | *rcv_route_not_found = \&Net::FCP::Txn::rcv_throw_exception; |
764 | |
772 | |
765 | sub rcv_restarted { |
773 | sub rcv_restarted { |
766 | my ($self, $attr, $type) = @_; |
774 | my ($self, $attr, $type) = @_; |
767 | |
775 | |