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.19 by root, Sun Sep 14 09:48:01 2003 UTC vs.
Revision 1.33 by root, Sun May 16 00:19:38 2004 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.7;
75 78
76no warnings; 79no warnings;
77 80
81use Net::FCP::Metadata;
82use Net::FCP::Util qw(tolc touc xeh);
83
78our $EVENT = Net::FCP::Event::Auto::; 84our $EVENT = Net::FCP::Event::Auto::;
79$EVENT = Net::FCP::Event::Event;#d#
80 85
81sub import { 86sub import {
82 shift; 87 shift;
83 88
84 for (@_) { 89 for (@_) {
85 if (/^event=(\w+)$/) { 90 if (/^event=(\w+)$/) {
86 $EVENT = "Net::FCP::Event::$1"; 91 $EVENT = "Net::FCP::Event::$1";
92 eval "require $EVENT";
87 } 93 }
88 } 94 }
89 eval "require $EVENT";
90 die $@ if $@; 95 die $@ if $@;
91} 96}
92 97
93sub touc($) {
94 local $_ = shift;
95 1 while s/((?:^|_)(?:svk|chk|uri)(?:_|$))/\U$1/;
96 s/(?:^|_)(.)/\U$1/g;
97 $_;
98}
99
100sub tolc($) {
101 local $_ = shift;
102 s/(?<=[a-z])(?=[A-Z])/_/g;
103 lc $_;
104}
105
106=item $meta = Net::FCP::parse_metadata $string
107
108Parse a metadata string and return it.
109
110The metadata will be a hashref with key C<version> (containing
111the mandatory version header entries).
112
113All other headers are represented by arrayrefs (they can be repeated).
114
115Since this is confusing, here is a rather verbose example of a parsed
116manifest:
117
118 (
119 version => { revision => 1 },
120 document => [
121 {
122 info => { format" => "image/jpeg" },
123 name => "background.jpg",
124 redirect => { target => "freenet:CHK\@ZcagI,ra726bSw" },
125 },
126 {
127 info => { format" => "text/html" },
128 name => ".next",
129 redirect => { target => "freenet:SSK\@ilUPAgM/TFEE/3" },
130 },
131 {
132 info => { format" => "text/html" },
133 redirect => { target => "freenet:CHK\@8M8Po8ucwI,8xA" },
134 }
135 ]
136 )
137
138=cut
139
140sub parse_metadata {
141 my $meta;
142
143 my $data = shift;
144 if ($data =~ /^Version\015?\012/gc) {
145 my $hdr = $meta->{version} = {};
146
147 for (;;) {
148 while ($data =~ /\G([^=\015\012]+)=([^\015\012]*)\015?\012/gc) {
149 my ($k, $v) = ($1, $2);
150 my @p = split /\./, tolc $k, 3;
151
152 $hdr->{$p[0]} = $v if @p == 1; # lamest code I ever wrote
153 $hdr->{$p[0]}{$p[1]} = $v if @p == 2;
154 $hdr->{$p[0]}{$p[1]}{$p[2]} = $v if @p == 3;
155 die "FATAL: 4+ dot metadata" if @p >= 4;
156 }
157
158 if ($data =~ /\GEndPart\015?\012/gc) {
159 # nop
160 } elsif ($data =~ /\GEnd(\015?\012|$)/gc) {
161 last;
162 } elsif ($data =~ /\G([A-Za-z0-9.\-]+)\015?\012/gcs) {
163 push @{$meta->{tolc $1}}, $hdr = {};
164 } elsif ($data =~ /\G(.*)/gcs) {
165 print STDERR "metadata format error ($1), please report this string: <<$data>>";
166 die "metadata format error";
167 }
168 }
169 }
170
171 #$meta->{tail} = substr $data, pos $data;
172
173 $meta;
174}
175
176=item $fcp = new Net::FCP [host => $host][, port => $port] 98=item $fcp = new Net::FCP [host => $host][, port => $port][, progress => \&cb]
177 99
178Create a new virtual FCP connection to the given host and port (default 100Create a new virtual FCP connection to the given host and port (default
179127.0.0.1:8481, or the environment variables C<FREDHOST> and C<FREDPORT>). 101127.0.0.1:8481, or the environment variables C<FREDHOST> and C<FREDPORT>).
180 102
181Connections are virtual because no persistent physical connection is 103Connections are virtual because no persistent physical connection is
182established. 104established.
183 105
184=begin comment 106You can install a progress callback that is being called with the Net::FCP
107object, a txn object, the type of the transaction and the attributes. Use
108it like this:
185 109
186However, the existance of the node is checked by executing a 110 sub progress_cb {
187C<ClientHello> transaction. 111 my ($self, $txn, $type, $attr) = @_;
188 112
189=end 113 warn "progress<$txn,$type," . (join ":", %$attr) . ">\n";
114 }
190 115
191=cut 116=cut
192 117
193sub new { 118sub new {
194 my $class = shift; 119 my $class = shift;
195 my $self = bless { @_ }, $class; 120 my $self = bless { @_ }, $class;
196 121
197 $self->{host} ||= $ENV{FREDHOST} || "127.0.0.1"; 122 $self->{host} ||= $ENV{FREDHOST} || "127.0.0.1";
198 $self->{port} ||= $ENV{FREDPORT} || 8481; 123 $self->{port} ||= $ENV{FREDPORT} || 8481;
199 124
200 #$self->{nodehello} = $self->client_hello
201 # or croak "unable to get nodehello from node\n";
202
203 $self; 125 $self;
204} 126}
205 127
206sub progress { 128sub progress {
207 my ($self, $txn, $type, $attr) = @_; 129 my ($self, $txn, $type, $attr) = @_;
208 #warn "progress<$txn,$type," . (join ":", %$attr) . ">\n";
209}
210 130
131 $self->{progress}->($self, $txn, $type, $attr)
132 if $self->{progress};
133}
134
211=item $txn = $fcp->txn(type => attr => val,...) 135=item $txn = $fcp->txn (type => attr => val,...)
212 136
213The low-level interface to transactions. Don't use it. 137The low-level interface to transactions. Don't use it unless you have
214 138"special needs". Instead, use predefiend transactions like this:
215Here are some examples of using transactions:
216 139
217The blocking case, no (visible) transactions involved: 140The blocking case, no (visible) transactions involved:
218 141
219 my $nodehello = $fcp->client_hello; 142 my $nodehello = $fcp->client_hello;
220 143
… …
239sub txn { 162sub txn {
240 my ($self, $type, %attr) = @_; 163 my ($self, $type, %attr) = @_;
241 164
242 $type = touc $type; 165 $type = touc $type;
243 166
244 my $txn = "Net::FCP::Txn::$type"->new(fcp => $self, type => tolc $type, attr => \%attr); 167 my $txn = "Net::FCP::Txn::$type"->new (fcp => $self, type => tolc $type, attr => \%attr);
245 168
246 $txn; 169 $txn;
247} 170}
248 171
249{ # transactions 172{ # transactions
… …
310 my ($self) = @_; 233 my ($self) = @_;
311 234
312 $self->txn ("client_info"); 235 $self->txn ("client_info");
313}); 236});
314 237
315=item $txn = $fcp->txn_generate_chk ($metadata, $data) 238=item $txn = $fcp->txn_generate_chk ($metadata, $data[, $cipher])
316 239
317=item $uri = $fcp->generate_chk ($metadata, $data) 240=item $uri = $fcp->generate_chk ($metadata, $data[, $cipher])
318 241
319Creates a new CHK, given the metadata and data. UNTESTED. 242Calculates a CHK, given the metadata and data. C<$cipher> is either
243C<Rijndael> or C<Twofish>, with the latter being the default.
320 244
321=cut 245=cut
322 246
323$txn->(generate_chk => sub { 247$txn->(generate_chk => sub {
324 my ($self, $metadata, $data) = @_; 248 my ($self, $metadata, $data, $cipher) = @_;
325 249
326 $self->txn (generate_chk => data => "$metadata$data", metadata_length => length $metadata); 250 $metadata = Net::FCP::Metadata::build_metadata $metadata;
251
252 $self->txn (generate_chk =>
253 data => "$metadata$data",
254 metadata_length => xeh length $metadata,
255 cipher => $cipher || "Twofish");
327}); 256});
328 257
329=item $txn = $fcp->txn_generate_svk_pair 258=item $txn = $fcp->txn_generate_svk_pair
330 259
331=item ($public, $private) = @{ $fcp->generate_svk_pair } 260=item ($public, $private, $crypto) = @{ $fcp->generate_svk_pair }
332 261
333Creates a new SVK pair. Returns an arrayref. 262Creates a new SVK pair. Returns an arrayref with the public key, the
263private key and a crypto key, which is just additional entropy.
334 264
335 [ 265 [
336 "hKs0-WDQA4pVZyMPKNFsK1zapWY", 266 "acLx4dux9fvvABH15Gk6~d3I-yw",
337 "ZnmvMITaTXBMFGl4~jrjuyWxOWg" 267 "cPoDkDMXDGSMM32plaPZDhJDxSs",
268 "BH7LXCov0w51-y9i~BoB3g",
338 ] 269 ]
270
271A private key (for inserting) can be constructed like this:
272
273 SSK@<private_key>,<crypto_key>/<name>
274
275It can be used to insert data. The corresponding public key looks like this:
276
277 SSK@<public_key>PAgM,<crypto_key>/<name>
278
279Watch out for the C<PAgM>-part!
339 280
340=cut 281=cut
341 282
342$txn->(generate_svk_pair => sub { 283$txn->(generate_svk_pair => sub {
343 my ($self) = @_; 284 my ($self) = @_;
344 285
345 $self->txn ("generate_svk_pair"); 286 $self->txn ("generate_svk_pair");
346}); 287});
347 288
348=item $txn = $fcp->txn_insert_private_key ($private) 289=item $txn = $fcp->txn_invert_private_key ($private)
349 290
350=item $public = $fcp->insert_private_key ($private) 291=item $public = $fcp->invert_private_key ($private)
351 292
352Inserts a private key. $private can be either an insert URI (must start 293Inverts a private key (returns the public key). C<$private> can be either
353with C<freenet:SSK@>) or a raw private key (i.e. the private value you get 294an insert URI (must start with C<freenet:SSK@>) or a raw private key (i.e.
354back from C<generate_svk_pair>). 295the private value you get back from C<generate_svk_pair>).
355 296
356Returns the public key. 297Returns the public key.
357 298
358UNTESTED.
359
360=cut 299=cut
361 300
362$txn->(insert_private_key => sub { 301$txn->(invert_private_key => sub {
363 my ($self, $privkey) = @_; 302 my ($self, $privkey) = @_;
364 303
365 $self->txn (invert_private_key => private => $privkey); 304 $self->txn (invert_private_key => private => $privkey);
366}); 305});
367 306
… …
370=item $length = $fcp->get_size ($uri) 309=item $length = $fcp->get_size ($uri)
371 310
372Finds and returns the size (rounded up to the nearest power of two) of the 311Finds and returns the size (rounded up to the nearest power of two) of the
373given document. 312given document.
374 313
375UNTESTED.
376
377=cut 314=cut
378 315
379$txn->(get_size => sub { 316$txn->(get_size => sub {
380 my ($self, $uri) = @_; 317 my ($self, $uri) = @_;
381 318
… …
384 321
385=item $txn = $fcp->txn_client_get ($uri [, $htl = 15 [, $removelocal = 0]]) 322=item $txn = $fcp->txn_client_get ($uri [, $htl = 15 [, $removelocal = 0]])
386 323
387=item ($metadata, $data) = @{ $fcp->client_get ($uri, $htl, $removelocal) 324=item ($metadata, $data) = @{ $fcp->client_get ($uri, $htl, $removelocal)
388 325
389Fetches a (small, as it should fit into memory) file from 326Fetches a (small, as it should fit into memory) key content block from
390freenet. C<$meta> is the metadata (as returned by C<parse_metadata> or 327freenet. C<$meta> is a C<Net::FCP::Metadata> object or C<undef>).
391C<undef>).
392 328
393Due to the overhead, a better method to download big files should be used. 329The C<$uri> should begin with C<freenet:>, but the scheme is currently
330added, if missing.
394 331
395 my ($meta, $data) = @{ 332 my ($meta, $data) = @{
396 $fcp->client_get ( 333 $fcp->client_get (
397 "freenet:CHK@hdXaxkwZ9rA8-SidT0AN-bniQlgPAwI,XdCDmBuGsd-ulqbLnZ8v~w" 334 "freenet:CHK@hdXaxkwZ9rA8-SidT0AN-bniQlgPAwI,XdCDmBuGsd-ulqbLnZ8v~w"
398 ) 335 )
… …
401=cut 338=cut
402 339
403$txn->(client_get => sub { 340$txn->(client_get => sub {
404 my ($self, $uri, $htl, $removelocal) = @_; 341 my ($self, $uri, $htl, $removelocal) = @_;
405 342
343 $uri =~ s/^freenet://; $uri = "freenet:$uri";
344
406 $self->txn (client_get => URI => $uri, hops_to_live => (defined $htl ? $htl :15), 345 $self->txn (client_get => URI => $uri, hops_to_live => xeh (defined $htl ? $htl : 15),
407 remove_local_key => $removelocal ? "true" : "false"); 346 remove_local_key => $removelocal ? "true" : "false");
408}); 347});
409 348
410=item $txn = $fcp->txn_client_put ($uri, $metadata, $data, $htl, $removelocal) 349=item $txn = $fcp->txn_client_put ($uri, $metadata, $data, $htl, $removelocal)
411 350
412=item my $uri = $fcp->client_put ($uri, $metadata, $data, $htl, $removelocal); 351=item my $uri = $fcp->client_put ($uri, $metadata, $data, $htl, $removelocal);
413 352
414Insert a new key. If the client is inserting a CHK, the URI may be 353Insert a new key. If the client is inserting a CHK, the URI may be
415abbreviated as just CHK@. In this case, the node will calculate the 354abbreviated as just CHK@. In this case, the node will calculate the
416CHK. 355CHK. If the key is a private SSK key, the node will calculcate the public
356key and the resulting public URI.
417 357
418C<$meta> can be a reference or a string (ONLY THE STRING CASE IS IMPLEMENTED!). 358C<$meta> can be a hash reference (same format as returned by
359C<Net::FCP::parse_metadata>) or a string.
419 360
420THIS INTERFACE IS UNTESTED AND SUBJECT TO CHANGE. 361The result is an arrayref with the keys C<uri>, C<public_key> and C<private_key>.
421 362
422=cut 363=cut
423 364
424$txn->(client_put => sub { 365$txn->(client_put => sub {
425 my ($self, $uri, $meta, $data, $htl, $removelocal) = @_; 366 my ($self, $uri, $metadata, $data, $htl, $removelocal) = @_;
426 367
427 $self->txn (client_put => URI => $uri, hops_to_live => (defined $htl ? $htl :15), 368 $metadata = Net::FCP::Metadata::build_metadata $metadata;
369 $uri =~ s/^freenet://; $uri = "freenet:$uri";
370
371 $self->txn (client_put => URI => $uri,
372 hops_to_live => xeh (defined $htl ? $htl : 15),
428 remove_local_key => $removelocal ? "true" : "false", 373 remove_local_key => $removelocal ? "true" : "false",
429 data => "$meta$data", metadata_length => length $meta); 374 data => "$metadata$data", metadata_length => xeh length $metadata);
430}); 375});
431 376
432} # transactions 377} # transactions
433 378
434=item MISSING: (ClientPut), InsretKey
435
436=back 379=back
437 380
438=head2 THE Net::FCP::Txn CLASS 381=head2 THE Net::FCP::Txn CLASS
439 382
440All requests (or transactions) are executed in a asynchroneous way (LIE: 383All requests (or transactions) are executed in a asynchronous way. For
441uploads are blocking). For each request, a C<Net::FCP::Txn> object is 384each request, a C<Net::FCP::Txn> object is created (worse: a tcp
442created (worse: a tcp connection is created, too). 385connection is created, too).
443 386
444For each request there is actually a different subclass (and it's possible 387For each request there is actually a different subclass (and it's possible
445to subclass these, although of course not documented). 388to subclass these, although of course not documented).
446 389
447The most interesting method is C<result>. 390The most interesting method is C<result>.
… …
475 while (my ($k, $v) = each %{$self->{attr}}) { 418 while (my ($k, $v) = each %{$self->{attr}}) {
476 $attr .= (Net::FCP::touc $k) . "=$v\012" 419 $attr .= (Net::FCP::touc $k) . "=$v\012"
477 } 420 }
478 421
479 if (defined $data) { 422 if (defined $data) {
480 $attr .= "DataLength=" . (length $data) . "\012"; 423 $attr .= sprintf "DataLength=%x\012", length $data;
481 $data = "Data\012$data"; 424 $data = "Data\012$data";
482 } else { 425 } else {
483 $data = "EndMessage\012"; 426 $data = "EndMessage\012";
484 } 427 }
485 428
… …
492 and !$!{EINPROGRESS} 435 and !$!{EINPROGRESS}
493 and Carp::croak "FCP::txn: unable to connect to $self->{fcp}{host}:$self->{fcp}{port}: $!\n"; 436 and Carp::croak "FCP::txn: unable to connect to $self->{fcp}{host}:$self->{fcp}{port}: $!\n";
494 437
495 $self->{sbuf} = 438 $self->{sbuf} =
496 "\x00\x00\x00\x02" 439 "\x00\x00\x00\x02"
497 . Net::FCP::touc $self->{type} 440 . (Net::FCP::touc $self->{type})
498 . "\012$attr$data"; 441 . "\012$attr$data";
499 442
500 #$fh->shutdown (1); # freenet buggy?, well, it's java... 443 #shutdown $fh, 1; # freenet buggy?, well, it's java...
501 444
502 $self->{fh} = $fh; 445 $self->{fh} = $fh;
503 446
504 $self->{w} = $EVENT->new_from_fh ($fh)->cb(sub { $self->fh_ready_w })->poll(0, 1, 1); 447 $self->{w} = $EVENT->new_from_fh ($fh)
448 ->cb (sub { $self->fh_ready_w })
449 ->poll (0, 1, 1);
505 450
506 $self; 451 $self;
507} 452}
508 453
509=item $txn = $txn->cb ($coderef) 454=item $txn = $txn->cb ($coderef)
… …
664 } 609 }
665} 610}
666 611
667sub progress { 612sub progress {
668 my ($self, $type, $attr) = @_; 613 my ($self, $type, $attr) = @_;
614
669 $self->{fcp}->progress ($self, $type, $attr); 615 $self->{fcp}->progress ($self, $type, $attr);
670} 616}
671 617
672=item $result = $txn->result 618=item $result = $txn->result
673 619
674Waits until a result is available and then returns it. 620Waits until a result is available and then returns it.
675 621
676This waiting is (depending on your event model) not very efficient, as it 622This waiting is (depending on your event model) not very efficient, as it
677is done outside the "mainloop". 623is done outside the "mainloop". The biggest problem, however, is that it's
624blocking one thread of execution. Try to use the callback mechanism, if
625possible, and call result from within the callback (or after is has been
626run), as then no waiting is necessary.
678 627
679=cut 628=cut
680 629
681sub result { 630sub result {
682 my ($self) = @_; 631 my ($self) = @_;
… …
713use base Net::FCP::Txn; 662use base Net::FCP::Txn;
714 663
715sub rcv_success { 664sub rcv_success {
716 my ($self, $attr) = @_; 665 my ($self, $attr) = @_;
717 666
718 $self->set_result ($attr); 667 $self->set_result ($attr->{uri});
719} 668}
720 669
721package Net::FCP::Txn::GenerateSVKPair; 670package Net::FCP::Txn::GenerateSVKPair;
722 671
723use base Net::FCP::Txn; 672use base Net::FCP::Txn;
724 673
725sub rcv_success { 674sub rcv_success {
726 my ($self, $attr) = @_; 675 my ($self, $attr) = @_;
727 $self->set_result ([$attr->{PublicKey}, $attr->{PrivateKey}]); 676 $self->set_result ([$attr->{public_key}, $attr->{private_key}, $attr->{crypto_key}]);
728} 677}
729 678
730package Net::FCP::Txn::InsertPrivateKey; 679package Net::FCP::Txn::InvertPrivateKey;
731 680
732use base Net::FCP::Txn; 681use base Net::FCP::Txn;
733 682
734sub rcv_success { 683sub rcv_success {
735 my ($self, $attr) = @_; 684 my ($self, $attr) = @_;
736 $self->set_result ($attr->{PublicKey}); 685 $self->set_result ($attr->{public_key});
737} 686}
738 687
739package Net::FCP::Txn::GetSize; 688package Net::FCP::Txn::GetSize;
740 689
741use base Net::FCP::Txn; 690use base Net::FCP::Txn;
742 691
743sub rcv_success { 692sub rcv_success {
744 my ($self, $attr) = @_; 693 my ($self, $attr) = @_;
745 $self->set_result ($attr->{Length}); 694 $self->set_result (hex $attr->{length});
746} 695}
747 696
748package Net::FCP::Txn::GetPut; 697package Net::FCP::Txn::GetPut;
749 698
750# base class for get and put 699# base class for get and put
751 700
752use base Net::FCP::Txn; 701use base Net::FCP::Txn;
753 702
754*rcv_uri_error = \&Net::FCP::Txn::rcv_throw_exception; 703*rcv_uri_error = \&Net::FCP::Txn::rcv_throw_exception;
755*rcv_route_not_found = \&Net::FCP::Txn::rcv_throw_exception; 704*rcv_route_not_found = \&Net::FCP::Txn::rcv_throw_exception;
756 705
757sub rcv_restarted { 706sub rcv_restarted {
758 my ($self, $attr, $type) = @_; 707 my ($self, $attr, $type) = @_;
759 708
760 delete $self->{datalength}; 709 delete $self->{datalength};
… …
777 726
778 $self->progress ("data", { chunk => length $chunk, received => length $self->{data}, total => $self->{datalength} }); 727 $self->progress ("data", { chunk => length $chunk, received => length $self->{data}, total => $self->{datalength} });
779 728
780 if ($self->{datalength} == length $self->{data}) { 729 if ($self->{datalength} == length $self->{data}) {
781 my $data = delete $self->{data}; 730 my $data = delete $self->{data};
782 my $meta = Net::FCP::parse_metadata substr $data, 0, $self->{metalength}, ""; 731 my $meta = new Net::FCP::Metadata (substr $data, 0, $self->{metalength}, "");
783 732
784 $self->set_result ([$meta, $data]); 733 $self->set_result ([$meta, $data]);
734 $self->eof;
785 } 735 }
786} 736}
787 737
788sub rcv_data_found { 738sub rcv_data_found {
789 my ($self, $attr, $type) = @_; 739 my ($self, $attr, $type) = @_;
… …
797package Net::FCP::Txn::ClientPut; 747package Net::FCP::Txn::ClientPut;
798 748
799use base Net::FCP::Txn::GetPut; 749use base Net::FCP::Txn::GetPut;
800 750
801*rcv_size_error = \&Net::FCP::Txn::rcv_throw_exception; 751*rcv_size_error = \&Net::FCP::Txn::rcv_throw_exception;
802*rcv_key_collision = \&Net::FCP::Txn::rcv_throw_exception;
803 752
804sub rcv_pending { 753sub rcv_pending {
805 my ($self, $attr, $type) = @_; 754 my ($self, $attr, $type) = @_;
806 $self->progress ($type, $attr); 755 $self->progress ($type, $attr);
807} 756}
… …
809sub rcv_success { 758sub rcv_success {
810 my ($self, $attr, $type) = @_; 759 my ($self, $attr, $type) = @_;
811 $self->set_result ($attr); 760 $self->set_result ($attr);
812} 761}
813 762
763sub rcv_key_collision {
764 my ($self, $attr, $type) = @_;
765 $self->set_result ({ key_collision => 1, %$attr });
766}
767
814=back 768=back
815 769
816=head2 The Net::FCP::Exception CLASS 770=head2 The Net::FCP::Exception CLASS
817 771
818Any unexpected (non-standard) responses that make it impossible to return 772Any unexpected (non-standard) responses that make it impossible to return
… …
827 781
828package Net::FCP::Exception; 782package Net::FCP::Exception;
829 783
830use overload 784use overload
831 '""' => sub { 785 '""' => sub {
832 "Net::FCP::Exception<<$_[0][0]," . (join ":", %{$_[0][1]}) . ">>\n"; 786 "Net::FCP::Exception<<$_[0][0]," . (join ":", %{$_[0][1]}) . ">>";
833 }; 787 };
834 788
835=item $exc = new Net::FCP::Exception $type, \%attr 789=item $exc = new Net::FCP::Exception $type, \%attr
836 790
837Create a new exception object of the given type (a string like 791Create a new exception object of the given type (a string like
… …
889 Marc Lehmann <pcg@goof.com> 843 Marc Lehmann <pcg@goof.com>
890 http://www.goof.com/pcg/marc/ 844 http://www.goof.com/pcg/marc/
891 845
892=cut 846=cut
893 847
848package Net::FCP::Event::Auto;
849
850my @models = (
851 [Coro => Coro::Event::],
852 [Event => Event::],
853 [Glib => Glib::],
854 [Tk => Tk::],
855);
856
857sub AUTOLOAD {
858 $AUTOLOAD =~ s/.*://;
859
860 for (@models) {
861 my ($model, $package) = @$_;
862 if (defined ${"$package\::VERSION"}) {
863 $EVENT = "Net::FCP::Event::$model";
864 eval "require $EVENT"; die if $@;
865 goto &{"$EVENT\::$AUTOLOAD"};
866 }
867 }
868
869 for (@models) {
870 my ($model, $package) = @$_;
871 $EVENT = "Net::FCP::Event::$model";
872 if (eval "require $EVENT") {
873 goto &{"$EVENT\::$AUTOLOAD"};
874 }
875 }
876
877 die "No event module selected for Net::FCP and autodetect failed. Install any of these: Coro, Event, Glib or Tk.";
878}
879
8941; 8801;
895 881

Diff Legend

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