[ViewVC] Diff of: cvs/Net-FCP/FCP.pm

Comparing Net-FCP/FCP.pm (file contents):
Revision 1.13 by root, Wed Sep 10 05:06:16 2003 UTC vs.
Revision 1.34 by root, Wed Jan 12 20:37:33 2005 UTC

…		…
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		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.
		42
		43	=head2 FREENET BASICS
		44
		45	Ok, this section will not explain any freenet basics to you, just some
		46	problems I found that you might want to avoid:
		47
		48	=over 4
		49
		50	=item freenet URIs are _NOT_ URIs
		51
		52	Whenever a "uri" is required by the protocol, freenet expects a kind of
		53	URI prefixed with the "freenet:" scheme, e.g. "freenet:CHK...". However,
		54	these are not URIs, as freeent fails to parse them correctly, that is, you
		55	must unescape an escaped characters ("%2c" => ",") yourself. Maybe in the
		56	future this library will do it for you, so watch out for this incompatible
		57	change.
		58
		59	=item Numbers are in HEX
		60
		61	Virtually every number in the FCP protocol is in hex. Be sure to use
		62	C<hex()> on all such numbers, as the module (currently) does nothing to
		63	convert these for you.
		64
		65	=back
		66
40	=head2 THE Net::FCP CLASS	67	=head2 THE Net::FCP CLASS
41		68
42	=over 4	69	=over 4
43		70
44	=cut	71	=cut
45		72
46	package Net::FCP;	73	package Net::FCP;
47		74
48	use Carp;	75	use Carp;
49		76
50	$VERSION = 0.05;	77	$VERSION = 0.7;
51		78
52	no warnings;	79	no warnings;
53		80
		81	use Net::FCP::Metadata;
		82	use Net::FCP::Util qw(tolc touc xeh);
		83
54	our $EVENT = Net::FCP::Event::Auto::;	84	our $EVENT = Net::FCP::Event::Auto::;
55	$EVENT = Net::FCP::Event::Event;#d#
56		85
57	sub import {	86	sub import {
58	shift;	87	shift;
59		88
60	for (@_) {	89	for (@_) {
61	if (/^event=(\w+)$/) {	90	if (/^event=(\w+)$/) {
62	$EVENT = "Net::FCP::Event::$1";	91	$EVENT = "Net::FCP::Event::$1";
		92	eval "require $EVENT";
63	}	93	}
64	}	94	}
65	eval "require $EVENT";
66	die $@ if $@;	95	die $@ if $@;
67	}	96	}
68		97
69	sub touc($) {
70	local $_ = shift;
71	1 while s/((?:^\|_)(?:svk\|chk\|uri)(?:_\|$))/\U$1/;
72	s/(?:^\|_)(.)/\U$1/g;
73	$_;
74	}
75
76	sub tolc($) {
77	local $_ = shift;
78	s/(?<=[a-z])(?=[A-Z])/_/g;
79	lc $_;
80	}
81
82	=item $meta = Net::FCP::parse_metadata $string
83
84	Parse a metadata string and return it.
85
86	The metadata will be a hashref with key C<version> (containing
87	the mandatory version header entries).
88
89	All other headers are represented by arrayrefs (they can be repeated).
90
91	Since this is confusing, here is a rather verbose example of a parsed
92	manifest:
93
94	(
95	version => { revision => 1 },
96	document => [
97	{
98	"info.format" => "image/jpeg",
99	name => "background.jpg",
100	"redirect.target" => "freenet:CHK\@ZcagI,ra726bSw"
101	},
102	{
103	"info.format" => "text/html",
104	name => ".next",
105	"redirect.target" => "freenet:SSK\@ilUPAgM/TFEE/3"
106	},
107	{
108	"info.format" => "text/html",
109	"redirect.target" => "freenet:CHK\@8M8Po8ucwI,8xA"
110	}
111	]
112	)
113
114	=cut
115
116	sub parse_metadata {
117	my $meta;
118
119	my $data = shift;
120	if ($data =~ /^Version\015?\012/gc) {
121	my $hdr = $meta->{version} = {};
122
123	for (;;) {
124	while ($data =~ /\G([^=\015\012]+)=([^\015\012]*)\015?\012/gc) {
125	my ($k, $v) = ($1, $2);
126	my @p = split /\./, tolc $k, 3;
127
128	$hdr->{$p[0]} = $v if @p == 1; # lamest code I ever wrote
129	$hdr->{$p[0]}{$p[1]} = $v if @p == 2;
130	$hdr->{$p[0]}{$p[1]}{$p[3]} = $v if @p == 3;
131	die "FATAL: 4+ dot metadata" if @p >= 4;
132	}
133
134	if ($data =~ /\GEndPart\015?\012/gc) {
135	# nop
136	} elsif ($data =~ /\GEnd\015?\012/gc) {
137	last;
138	} elsif ($data =~ /\G([A-Za-z0-9.\-]+)\015?\012/gcs) {
139	push @{$meta->{tolc $1}}, $hdr = {};
140	} elsif ($data =~ /\G(.*)/gcs) {
141	die "metadata format error ($1)";
142	}
143	}
144	}
145
146	#$meta->{tail} = substr $data, pos $data;
147
148	$meta;
149	}
150
151	=item $fcp = new Net::FCP [host => $host][, port => $port]	98	=item $fcp = new Net::FCP [host => $host][, port => $port][, progress => \&cb]
152		99
153	Create a new virtual FCP connection to the given host and port (default	100	Create a new virtual FCP connection to the given host and port (default
154	127.0.0.1:8481, or the environment variables C<FREDHOST> and C<FREDPORT>).	101	127.0.0.1:8481, or the environment variables C<FREDHOST> and C<FREDPORT>).
155		102
156	Connections are virtual because no persistent physical connection is	103	Connections are virtual because no persistent physical connection is
157	established. However, the existance of the node is checked by executing a	104	established.
158	C<ClientHello> transaction.	105
		106	You can install a progress callback that is being called with the Net::FCP
		107	object, a txn object, the type of the transaction and the attributes. Use
		108	it like this:
		109
		110	sub progress_cb {
		111	my ($self, $txn, $type, $attr) = @_;
		112
		113	warn "progress<$txn,$type," . (join ":", %$attr) . ">\n";
		114	}
159		115
160	=cut	116	=cut
161		117
162	sub new {	118	sub new {
163	my $class = shift;	119	my $class = shift;
164	my $self = bless { @_ }, $class;	120	my $self = bless { @_ }, $class;
165		121
166	$self->{host} \|\|= $ENV{FREDHOST} \|\| "127.0.0.1";	122	$self->{host} \|\|= $ENV{FREDHOST} \|\| "127.0.0.1";
167	$self->{port} \|\|= $ENV{FREDPORT} \|\| 8481;	123	$self->{port} \|\|= $ENV{FREDPORT} \|\| 8481;
168		124
169	#$self->{nodehello} = $self->client_hello
170	# or croak "unable to get nodehello from node\n";
171
172	$self;	125	$self;
173	}	126	}
174		127
175	sub progress {	128	sub progress {
176	my ($self, $txn, $type, $attr) = @_;	129	my ($self, $txn, $type, $attr) = @_;
177	warn "progress<$txn,$type," . (join ":", %$attr) . ">\n";
178	}
179		130
		131	$self->{progress}->($self, $txn, $type, $attr)
		132	if $self->{progress};
		133	}
		134
180	=item $txn = $fcp->txn(type => attr => val,...)	135	=item $txn = $fcp->txn (type => attr => val,...)
181		136
182	The low-level interface to transactions. Don't use it.	137	The low-level interface to transactions. Don't use it unless you have
183		138	"special needs". Instead, use predefiend transactions like this:
184	Here are some examples of using transactions:
185		139
186	The blocking case, no (visible) transactions involved:	140	The blocking case, no (visible) transactions involved:
187		141
188	my $nodehello = $fcp->client_hello;	142	my $nodehello = $fcp->client_hello;
189		143
…		…
208	sub txn {	162	sub txn {
209	my ($self, $type, %attr) = @_;	163	my ($self, $type, %attr) = @_;
210		164
211	$type = touc $type;	165	$type = touc $type;
212		166
213	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);
214		168
215	$txn;	169	$txn;
216	}	170	}
217		171
218	sub _txn($&) {	172	{ # transactions
		173
		174	my $txn = sub {
219	my ($name, $sub) = @_;	175	my ($name, $sub) = @_;
220	*{"$name\_txn"} = $sub;	176	*{"txn_$name"} = $sub;
221	*{$name} = sub { $sub->(@_)->result };	177	*{$name} = sub { $sub->(@_)->result };
222	}	178	};
223		179
224	=item $txn = $fcp->txn_client_hello	180	=item $txn = $fcp->txn_client_hello
225		181
226	=item $nodehello = $fcp->client_hello	182	=item $nodehello = $fcp->client_hello
227		183
…		…
233	protocol => "1.2",	189	protocol => "1.2",
234	}	190	}
235		191
236	=cut	192	=cut
237		193
238	_txn client_hello => sub {	194	$txn->(client_hello => sub {
239	my ($self) = @_;	195	my ($self) = @_;
240		196
241	$self->txn ("client_hello");	197	$self->txn ("client_hello");
242	};	198	});
243		199
244	=item $txn = $fcp->txn_client_info	200	=item $txn = $fcp->txn_client_info
245		201
246	=item $nodeinfo = $fcp->client_info	202	=item $nodeinfo = $fcp->client_info
247		203
…		…
271	routing_time => "a5",	227	routing_time => "a5",
272	}	228	}
273		229
274	=cut	230	=cut
275		231
276	_txn client_info => sub {	232	$txn->(client_info => sub {
277	my ($self) = @_;	233	my ($self) = @_;
278		234
279	$self->txn ("client_info");	235	$self->txn ("client_info");
280	};	236	});
281		237
282	=item $txn = $fcp->txn_generate_chk ($metadata, $data)	238	=item $txn = $fcp->txn_generate_chk ($metadata, $data[, $cipher])
283		239
284	=item $uri = $fcp->generate_chk ($metadata, $data)	240	=item $uri = $fcp->generate_chk ($metadata, $data[, $cipher])
285		241
286	Creates a new CHK, given the metadata and data. UNTESTED.	242	Calculates a CHK, given the metadata and data. C<$cipher> is either
		243	C<Rijndael> or C<Twofish>, with the latter being the default.
287		244
288	=cut	245	=cut
289		246
290	_txn generate_chk => sub {	247	$txn->(generate_chk => sub {
291	my ($self, $metadata, $data) = @_;	248	my ($self, $metadata, $data, $cipher) = @_;
292		249
293	$self->txn (generate_chk => data => "$data$metadata", 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");
294	};	256	});
295		257
296	=item $txn = $fcp->txn_generate_svk_pair	258	=item $txn = $fcp->txn_generate_svk_pair
297		259
298	=item ($public, $private) = @{ $fcp->generate_svk_pair }	260	=item ($public, $private, $crypto) = @{ $fcp->generate_svk_pair }
299		261
300	Creates a new SVK pair. Returns an arrayref.	262	Creates a new SVK pair. Returns an arrayref with the public key, the
		263	private key and a crypto key, which is just additional entropy.
301		264
302	[	265	[
303	"hKs0-WDQA4pVZyMPKNFsK1zapWY",	266	"acLx4dux9fvvABH15Gk6~d3I-yw",
304	"ZnmvMITaTXBMFGl4~jrjuyWxOWg"	267	"cPoDkDMXDGSMM32plaPZDhJDxSs",
		268	"BH7LXCov0w51-y9i~BoB3g",
305	]	269	]
306		270
307	=cut	271	A private key (for inserting) can be constructed like this:
308		272
		273	SSK@<private_key>,<crypto_key>/<name>
		274
		275	It can be used to insert data. The corresponding public key looks like this:
		276
		277	SSK@<public_key>PAgM,<crypto_key>/<name>
		278
		279	Watch out for the C<PAgM>-part!
		280
		281	=cut
		282
309	_txn generate_svk_pair => sub {	283	$txn->(generate_svk_pair => sub {
310	my ($self) = @_;	284	my ($self) = @_;
311		285
312	$self->txn ("generate_svk_pair");	286	$self->txn ("generate_svk_pair");
313	};	287	});
314		288
315	=item $txn = $fcp->txn_insert_private_key ($private)	289	=item $txn = $fcp->txn_invert_private_key ($private)
316		290
317	=item $uri = $fcp->insert_private_key ($private)	291	=item $public = $fcp->invert_private_key ($private)
318		292
319	Inserts a private key. $private can be either an insert URI (must start	293	Inverts a private key (returns the public key). C<$private> can be either
320	with freenet:SSK@) or a raw private key (i.e. the private value you get back	294	an insert URI (must start with C<freenet:SSK@>) or a raw private key (i.e.
321	from C<generate_svk_pair>).	295	the private value you get back from C<generate_svk_pair>).
322		296
323	Returns the public key.	297	Returns the public key.
324		298
325	UNTESTED.
326
327	=cut	299	=cut
328		300
329	_txn insert_private_key => sub {	301	$txn->(invert_private_key => sub {
330	my ($self, $privkey) = @_;	302	my ($self, $privkey) = @_;
331		303
332	$self->txn (invert_private_key => private => $privkey);	304	$self->txn (invert_private_key => private => $privkey);
333	};	305	});
334		306
335	=item $txn = $fcp->txn_get_size ($uri)	307	=item $txn = $fcp->txn_get_size ($uri)
336		308
337	=item $length = $fcp->get_size ($uri)	309	=item $length = $fcp->get_size ($uri)
338		310
339	Finds and returns the size (rounded up to the nearest power of two) of the	311	Finds and returns the size (rounded up to the nearest power of two) of the
340	given document.	312	given document.
341		313
342	UNTESTED.
343
344	=cut	314	=cut
345		315
346	_txn get_size => sub {	316	$txn->(get_size => sub {
347	my ($self, $uri) = @_;	317	my ($self, $uri) = @_;
348		318
349	$self->txn (get_size => URI => $uri);	319	$self->txn (get_size => URI => $uri);
350	};	320	});
351		321
352	=item $txn = $fcp->txn_client_get ($uri [, $htl = 15 [, $removelocal = 0]])	322	=item $txn = $fcp->txn_client_get ($uri [, $htl = 15 [, $removelocal = 0]])
353		323
354	=item ($metadata, $data) = @{ $fcp->client_get ($uri, $htl, $removelocal)	324	=item ($metadata, $data) = @{ $fcp->client_get ($uri, $htl, $removelocal)
355		325
356	Fetches a (small, as it should fit into memory) file from	326	Fetches a (small, as it should fit into memory) key content block from
357	freenet. C<$meta> is the metadata (as returned by C<parse_metadata> or	327	freenet. C<$meta> is a C<Net::FCP::Metadata> object or C<undef>).
358	C<undef>).
359		328
360	Due to the overhead, a better method to download big files should be used.	329	The C<$uri> should begin with C<freenet:>, but the scheme is currently
		330	added, if missing.
361		331
362	my ($meta, $data) = @{	332	my ($meta, $data) = @{
363	$fcp->client_get (	333	$fcp->client_get (
364	"freenet:CHK@hdXaxkwZ9rA8-SidT0AN-bniQlgPAwI,XdCDmBuGsd-ulqbLnZ8v~w"	334	"freenet:CHK@hdXaxkwZ9rA8-SidT0AN-bniQlgPAwI,XdCDmBuGsd-ulqbLnZ8v~w"
365	)	335	)
366	};	336	};
367		337
368	=cut	338	=cut
369		339
370	_txn client_get => sub {	340	$txn->(client_get => sub {
371	my ($self, $uri, $htl, $removelocal) = @_;	341	my ($self, $uri, $htl, $removelocal) = @_;
372		342
373	$self->txn (client_get => URI => $uri, hops_to_live => ($htl \|\| 15), remove_local_key => $removelocal ? "true" : "false");	343	$uri =~ s/^freenet://; $uri = "freenet:$uri";
		344
		345	$self->txn (client_get => URI => $uri, hops_to_live => xeh (defined $htl ? $htl : 15),
		346	remove_local_key => $removelocal ? "true" : "false");
374	};	347	});
375		348
376	=item MISSING: ClientPut	349	=item $txn = $fcp->txn_client_put ($uri, $metadata, $data, $htl, $removelocal)
		350
		351	=item my $uri = $fcp->client_put ($uri, $metadata, $data, $htl, $removelocal);
		352
		353	Insert a new key. If the client is inserting a CHK, the URI may be
		354	abbreviated as just CHK@. In this case, the node will calculate the
		355	CHK. If the key is a private SSK key, the node will calculcate the public
		356	key and the resulting public URI.
		357
		358	C<$meta> can be a hash reference (same format as returned by
		359	C<Net::FCP::parse_metadata>) or a string.
		360
		361	The result is an arrayref with the keys C<uri>, C<public_key> and C<private_key>.
		362
		363	=cut
		364
		365	$txn->(client_put => sub {
		366	my ($self, $uri, $metadata, $data, $htl, $removelocal) = @_;
		367
		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),
		373	remove_local_key => $removelocal ? "true" : "false",
		374	data => "$metadata$data", metadata_length => xeh length $metadata);
		375	});
		376
		377	} # transactions
377		378
378	=back	379	=back
379		380
380	=head2 THE Net::FCP::Txn CLASS	381	=head2 THE Net::FCP::Txn CLASS
381		382
382	All requests (or transactions) are executed in a asynchroneous way (LIE:	383	All requests (or transactions) are executed in a asynchronous way. For
383	uploads are blocking). For each request, a C<Net::FCP::Txn> object is	384	each request, a C<Net::FCP::Txn> object is created (worse: a tcp
384	created (worse: a tcp connection is created, too).	385	connection is created, too).
385		386
386	For each request there is actually a different subclass (and it's possible	387	For each request there is actually a different subclass (and it's possible
387	to subclass these, although of course not documented).	388	to subclass these, although of course not documented).
388		389
389	The most interesting method is C<result>.	390	The most interesting method is C<result>.
…		…
417	while (my ($k, $v) = each %{$self->{attr}}) {	418	while (my ($k, $v) = each %{$self->{attr}}) {
418	$attr .= (Net::FCP::touc $k) . "=$v\012"	419	$attr .= (Net::FCP::touc $k) . "=$v\012"
419	}	420	}
420		421
421	if (defined $data) {	422	if (defined $data) {
422	$attr .= "DataLength=" . (length $data) . "\012";	423	$attr .= sprintf "DataLength=%x\012", length $data;
423	$data = "Data\012$data";	424	$data = "Data\012$data";
424	} else {	425	} else {
425	$data = "EndMessage\012";	426	$data = "EndMessage\012";
426	}	427	}
427		428
…		…
434	and !$!{EINPROGRESS}	435	and !$!{EINPROGRESS}
435	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";
436		437
437	$self->{sbuf} =	438	$self->{sbuf} =
438	"\x00\x00\x00\x02"	439	"\x00\x00\x00\x02"
439	. Net::FCP::touc $self->{type}	440	. (Net::FCP::touc $self->{type})
440	. "\012$attr$data";	441	. "\012$attr$data";
441		442
442	#$fh->shutdown (1); # freenet buggy?, well, it's java...	443	#shutdown $fh, 1; # freenet buggy?, well, it's java...
443		444
444	$self->{fh} = $fh;	445	$self->{fh} = $fh;
445		446
446	$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);
447		450
448	$self;	451	$self;
449	}	452	}
450		453
451	=item $txn = $txn->cb ($coderef)	454	=item $txn = $txn->cb ($coderef)
…		…
483		486
484	sub userdata($$) {	487	sub userdata($$) {
485	my ($self, $data) = @_;	488	my ($self, $data) = @_;
486	$self->{userdata} = $data;	489	$self->{userdata} = $data;
487	$self;	490	$self;
		491	}
		492
		493	=item $txn->cancel (%attr)
		494
		495	Cancels the operation with a C<cancel> exception and the given attributes
		496	(consider at least giving the attribute C<reason>).
		497
		498	UNTESTED.
		499
		500	=cut
		501
		502	sub cancel {
		503	my ($self, %attr) = @_;
		504	$self->throw (Net::FCP::Exception->new (cancel => { %attr }));
		505	$self->set_result;
		506	$self->eof;
488	}	507	}
489		508
490	sub fh_ready_w {	509	sub fh_ready_w {
491	my ($self) = @_;	510	my ($self) = @_;
492		511
…		…
532	} else {	551	} else {
533	$self->eof;	552	$self->eof;
534	}	553	}
535	}	554	}
536		555
537	sub rcv_data {
538	my ($self, $chunk) = @_;
539
540	$self->{data} .= $chunk;
541
542	$self->progress ("data", { chunk => length $chunk, total => length $self->{data}, end => $self->{datalength} });
543	}
544
545	sub rcv {	556	sub rcv {
546	my ($self, $type, $attr) = @_;	557	my ($self, $type, $attr) = @_;
547		558
548	$type = Net::FCP::tolc $type;	559	$type = Net::FCP::tolc $type;
549		560
…		…
557	}	568	}
558		569
559	# used as a default exception thrower	570	# used as a default exception thrower
560	sub rcv_throw_exception {	571	sub rcv_throw_exception {
561	my ($self, $attr, $type) = @_;	572	my ($self, $attr, $type) = @_;
562	$self->throw (new Net::FCP::Exception $type, $attr);	573	$self->throw (Net::FCP::Exception->new ($type, $attr));
563	}	574	}
564		575
565	*rcv_failed = \&Net::FCP::Txn::rcv_throw_exception;	576	*rcv_failed = \&Net::FCP::Txn::rcv_throw_exception;
566	*rcv_format_error = \&Net::FCP::Txn::rcv_throw_exception;	577	*rcv_format_error = \&Net::FCP::Txn::rcv_throw_exception;
567		578
568	sub throw {	579	sub throw {
569	my ($self, $exc) = @_;	580	my ($self, $exc) = @_;
570		581
571	$self->{exception} = $exc;	582	$self->{exception} = $exc;
572	$self->set_result (1);	583	$self->set_result;
573	$self->eof; # must be last to avoid loops	584	$self->eof; # must be last to avoid loops
574	}	585	}
575		586
576	sub set_result {	587	sub set_result {
577	my ($self, $result) = @_;	588	my ($self, $result) = @_;
…		…
589	delete $self->{w};	600	delete $self->{w};
590	delete $self->{fh};	601	delete $self->{fh};
591		602
592	delete $self->{fcp}{txn}{$self};	603	delete $self->{fcp}{txn}{$self};
593		604
594	$self->set_result; # just in case	605	unless (exists $self->{result}) {
		606	$self->throw (Net::FCP::Exception->new (short_data => {
		607	reason => "unexpected eof or internal node error",
		608	}));
		609	}
595	}	610	}
596		611
597	sub progress {	612	sub progress {
598	my ($self, $type, $attr) = @_;	613	my ($self, $type, $attr) = @_;
		614
599	$self->{fcp}->progress ($self, $type, $attr);	615	$self->{fcp}->progress ($self, $type, $attr);
600	}	616	}
601		617
602	=item $result = $txn->result	618	=item $result = $txn->result
603		619
604	Waits until a result is available and then returns it.	620	Waits until a result is available and then returns it.
605		621
606	This waiting is (depending on your event model) not very efficient, as it	622	This waiting is (depending on your event model) not very efficient, as it
607	is done outside the "mainloop".	623	is done outside the "mainloop". The biggest problem, however, is that it's
		624	blocking one thread of execution. Try to use the callback mechanism, if
		625	possible, and call result from within the callback (or after is has been
		626	run), as then no waiting is necessary.
608		627
609	=cut	628	=cut
610		629
611	sub result {	630	sub result {
612	my ($self) = @_;	631	my ($self) = @_;
…		…
643	use base Net::FCP::Txn;	662	use base Net::FCP::Txn;
644		663
645	sub rcv_success {	664	sub rcv_success {
646	my ($self, $attr) = @_;	665	my ($self, $attr) = @_;
647		666
648	$self->set_result ($attr);	667	$self->set_result ($attr->{uri});
649	}	668	}
650		669
651	package Net::FCP::Txn::GenerateSVKPair;	670	package Net::FCP::Txn::GenerateSVKPair;
652		671
653	use base Net::FCP::Txn;	672	use base Net::FCP::Txn;
654		673
655	sub rcv_success {	674	sub rcv_success {
656	my ($self, $attr) = @_;	675	my ($self, $attr) = @_;
657
658	$self->set_result ([$attr->{PublicKey}, $attr->{PrivateKey}]);	676	$self->set_result ([$attr->{public_key}, $attr->{private_key}, $attr->{crypto_key}]);
659	}	677	}
660		678
661	package Net::FCP::Txn::InvertPrivateKey;	679	package Net::FCP::Txn::InvertPrivateKey;
662		680
663	use base Net::FCP::Txn;	681	use base Net::FCP::Txn;
664		682
665	sub rcv_success {	683	sub rcv_success {
666	my ($self, $attr) = @_;	684	my ($self, $attr) = @_;
667
668	$self->set_result ($attr->{PublicKey});	685	$self->set_result ($attr->{public_key});
669	}	686	}
670		687
671	package Net::FCP::Txn::GetSize;	688	package Net::FCP::Txn::GetSize;
672		689
673	use base Net::FCP::Txn;	690	use base Net::FCP::Txn;
674		691
675	sub rcv_success {	692	sub rcv_success {
676	my ($self, $attr) = @_;	693	my ($self, $attr) = @_;
677
678	$self->set_result ($attr->{Length});	694	$self->set_result (hex $attr->{length});
679	}	695	}
680		696
681	package Net::FCP::Txn::GetPut;	697	package Net::FCP::Txn::GetPut;
682		698
683	# base class for get and put	699	# base class for get and put
684		700
685	use base Net::FCP::Txn;	701	use base Net::FCP::Txn;
686		702
687	*rcv_uri_error = \&Net::FCP::Txn::rcv_throw_exception;	703	*rcv_uri_error = \&Net::FCP::Txn::rcv_throw_exception;
688	*rcv_route_not_found = \&Net::FCP::Txn::rcv_throw_exception;	704	*rcv_route_not_found = \&Net::FCP::Txn::rcv_throw_exception;
689		705
690	sub rcv_restarted {	706	sub rcv_restarted {
691	my ($self, $attr, $type) = @_;	707	my ($self, $attr, $type) = @_;
692		708
693	delete $self->{datalength};	709	delete $self->{datalength};
…		…
701		717
702	use base Net::FCP::Txn::GetPut;	718	use base Net::FCP::Txn::GetPut;
703		719
704	*rcv_data_not_found = \&Net::FCP::Txn::rcv_throw_exception;	720	*rcv_data_not_found = \&Net::FCP::Txn::rcv_throw_exception;
705		721
		722	sub rcv_data {
		723	my ($self, $chunk) = @_;
		724
		725	$self->{data} .= $chunk;
		726
		727	$self->progress ("data", { chunk => length $chunk, received => length $self->{data}, total => $self->{datalength} });
		728
		729	if ($self->{datalength} == length $self->{data}) {
		730	my $data = delete $self->{data};
		731	my $meta = new Net::FCP::Metadata (substr $data, 0, $self->{metalength}, "");
		732
		733	$self->set_result ([$meta, $data]);
		734	$self->eof;
		735	}
		736	}
		737
706	sub rcv_data_found {	738	sub rcv_data_found {
707	my ($self, $attr, $type) = @_;	739	my ($self, $attr, $type) = @_;
708		740
709	$self->progress ($type, $attr);	741	$self->progress ($type, $attr);
710		742
711	$self->{datalength} = hex $attr->{data_length};	743	$self->{datalength} = hex $attr->{data_length};
712	$self->{metalength} = hex $attr->{metadata_length};	744	$self->{metalength} = hex $attr->{metadata_length};
713	}	745	}
714		746
715	sub eof {
716	my ($self) = @_;
717
718	if ($self->{datalength} == length $self->{data}) {
719	my $data = delete $self->{data};
720	my $meta = Net::FCP::parse_metadata substr $data, 0, $self->{metalength}, "";
721
722	$self->set_result ([$meta, $data]);
723	} elsif (!exists $self->{result}) {
724	$self->throw (Net::FCP::Exception->new (short_data => {
725	reason => "unexpected eof or internal node error",
726	received => length $self->{data},
727	expected => $self->{datalength},
728	}));
729	}
730	}
731
732	package Net::FCP::Txn::ClientPut;	747	package Net::FCP::Txn::ClientPut;
733		748
734	use base Net::FCP::Txn::GetPut;	749	use base Net::FCP::Txn::GetPut;
735		750
736	*rcv_size_error = \&Net::FCP::Txn::rcv_throw_exception;	751	*rcv_size_error = \&Net::FCP::Txn::rcv_throw_exception;
737	*rcv_key_collision = \&Net::FCP::Txn::rcv_throw_exception;
738		752
739	sub rcv_pending {	753	sub rcv_pending {
740	my ($self, $attr, $type) = @_;	754	my ($self, $attr, $type) = @_;
741	$self->progress ($type, $attr);	755	$self->progress ($type, $attr);
742	}	756	}
…		…
744	sub rcv_success {	758	sub rcv_success {
745	my ($self, $attr, $type) = @_;	759	my ($self, $attr, $type) = @_;
746	$self->set_result ($attr);	760	$self->set_result ($attr);
747	}	761	}
748		762
		763	sub rcv_key_collision {
		764	my ($self, $attr, $type) = @_;
		765	$self->set_result ({ key_collision => 1, %$attr });
		766	}
		767
		768	=back
		769
		770	=head2 The Net::FCP::Exception CLASS
		771
		772	Any unexpected (non-standard) responses that make it impossible to return
		773	the advertised result will result in an exception being thrown when the
		774	C<result> method is called.
		775
		776	These exceptions are represented by objects of this class.
		777
		778	=over 4
		779
		780	=cut
		781
749	package Net::FCP::Exception;	782	package Net::FCP::Exception;
750		783
751	use overload	784	use overload
752	'""' => sub {	785	'""' => sub {
753	"Net::FCP::Exception<<$_[0][0]," . (join ":", %{$_[0][1]}) . ">>\n";	786	"Net::FCP::Exception<<$_[0][0]," . (join ":", %{$_[0][1]}) . ">>";
754	};	787	};
		788
		789	=item $exc = new Net::FCP::Exception $type, \%attr
		790
		791	Create a new exception object of the given type (a string like
		792	C<route_not_found>), and a hashref containing additional attributes
		793	(usually the attributes of the message causing the exception).
		794
		795	=cut
755		796
756	sub new {	797	sub new {
757	my ($class, $type, $attr) = @_;	798	my ($class, $type, $attr) = @_;
758		799
759	bless [Net::FCP::tolc $type, { %$attr }], $class;	800	bless [Net::FCP::tolc $type, { %$attr }], $class;
760	}	801	}
761		802
		803	=item $exc->type([$type])
		804
		805	With no arguments, returns the exception type. Otherwise a boolean
		806	indicating wether the exception is of the given type is returned.
		807
		808	=cut
		809
		810	sub type {
		811	my ($self, $type) = @_;
		812
		813	@_ >= 2
		814	? $self->[0] eq $type
		815	: $self->[0];
		816	}
		817
		818	=item $exc->attr([$attr])
		819
		820	With no arguments, returns the attributes. Otherwise the named attribute
		821	value is returned.
		822
		823	=cut
		824
		825	sub attr {
		826	my ($self, $attr) = @_;
		827
		828	@_ >= 2
		829	? $self->[1]{$attr}
		830	: $self->[1];
		831	}
		832
762	=back	833	=back
763		834
764	=head1 SEE ALSO	835	=head1 SEE ALSO
765		836
766	L<http://freenet.sf.net>.	837	L<http://freenet.sf.net>.
…		…
768	=head1 BUGS	839	=head1 BUGS
769		840
770	=head1 AUTHOR	841	=head1 AUTHOR
771		842
772	Marc Lehmann <pcg@goof.com>	843	Marc Lehmann <pcg@goof.com>
773	http://www.goof.com/pcg/marc/	844	http://home.schmorp.de/
774		845
775	=cut	846	=cut
		847
		848	package Net::FCP::Event::Auto;
		849
		850	my @models = (
		851	[Coro => Coro::Event::],
		852	[Event => Event::],
		853	[Glib => Glib::],
		854	[Tk => Tk::],
		855	);
		856
		857	sub 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	}
776		879
777	1;	880	1;
778		881

Diff Legend

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

Comparing Net-FCP/FCP.pm (file contents): Revision 1.13 by root, Wed Sep 10 05:06:16 2003 UTC vs. Revision 1.34 by root, Wed Jan 12 20:37:33 2005 UTC

Diff Legend

Comparing Net-FCP/FCP.pm (file contents):
Revision 1.13 by root, Wed Sep 10 05:06:16 2003 UTC vs.
Revision 1.34 by root, Wed Jan 12 20:37:33 2005 UTC