[ViewVC] Diff of: cvs/AnyEvent/lib/AnyEvent/Handle.pm

Comparing AnyEvent/lib/AnyEvent/Handle.pm (file contents):
Revision 1.37 by root, Mon May 26 20:02:22 2008 UTC vs.
Revision 1.44 by root, Thu May 29 00:00:07 2008 UTC

…		…
2		2
3	no warnings;	3	no warnings;
4	use strict;	4	use strict;
5		5
6	use AnyEvent ();	6	use AnyEvent ();
7	use AnyEvent::Util qw(WSAWOULDBLOCK);	7	use AnyEvent::Util qw(WSAEWOULDBLOCK);
8	use Scalar::Util ();	8	use Scalar::Util ();
9	use Carp ();	9	use Carp ();
10	use Fcntl ();	10	use Fcntl ();
11	use Errno qw/EAGAIN EINTR/;	11	use Errno qw(EAGAIN EINTR);
12		12
13	=head1 NAME	13	=head1 NAME
14		14
15	AnyEvent::Handle - non-blocking I/O on file handles via AnyEvent	15	AnyEvent::Handle - non-blocking I/O on file handles via AnyEvent
16		16
…		…
73	The filehandle this L<AnyEvent::Handle> object will operate on.	73	The filehandle this L<AnyEvent::Handle> object will operate on.
74		74
75	NOTE: The filehandle will be set to non-blocking (using	75	NOTE: The filehandle will be set to non-blocking (using
76	AnyEvent::Util::fh_nonblocking).	76	AnyEvent::Util::fh_nonblocking).
77		77
78	=item on_eof => $cb->($self)	78	=item on_eof => $cb->($handle)
79		79
80	Set the callback to be called on EOF.	80	Set the callback to be called on EOF.
81		81
82	While not mandatory, it is highly recommended to set an eof callback,	82	While not mandatory, it is highly recommended to set an eof callback,
83	otherwise you might end up with a closed socket while you are still	83	otherwise you might end up with a closed socket while you are still
84	waiting for data.	84	waiting for data.
85		85
86	=item on_error => $cb->($self)	86	=item on_error => $cb->($handle)
87		87
88	This is the fatal error callback, that is called when, well, a fatal error	88	This is the fatal error callback, that is called when, well, a fatal error
89	occurs, such as not being able to resolve the hostname, failure to connect	89	occurs, such as not being able to resolve the hostname, failure to connect
90	or a read error.	90	or a read error.
91		91
92	The object will not be in a usable state when this callback has been	92	The object will not be in a usable state when this callback has been
93	called.	93	called.
94		94
95	On callback entrance, the value of C<$!> contains the operating system	95	On callback entrance, the value of C<$!> contains the operating system
96	error (or C<ENOSPC>, C<EPIPE> or C<EBADMSG>).	96	error (or C<ENOSPC>, C<EPIPE>, C<ETIMEDOUT> or C<EBADMSG>).
97		97
98	The callbakc should throw an exception. If it returns, then	98	The callback should throw an exception. If it returns, then
99	AnyEvent::Handle will C<croak> for you.	99	AnyEvent::Handle will C<croak> for you.
100		100
101	While not mandatory, it is I<highly> recommended to set this callback, as	101	While not mandatory, it is I<highly> recommended to set this callback, as
102	you will not be notified of errors otherwise. The default simply calls	102	you will not be notified of errors otherwise. The default simply calls
103	die.	103	die.
104		104
105	=item on_read => $cb->($self)	105	=item on_read => $cb->($handle)
106		106
107	This sets the default read callback, which is called when data arrives	107	This sets the default read callback, which is called when data arrives
108	and no read request is in the queue.	108	and no read request is in the queue.
109		109
110	To access (and remove data from) the read buffer, use the C<< ->rbuf >>	110	To access (and remove data from) the read buffer, use the C<< ->rbuf >>
111	method or access the C<$self->{rbuf}> member directly.	111	method or access the C<$handle->{rbuf}> member directly.
112		112
113	When an EOF condition is detected then AnyEvent::Handle will first try to	113	When an EOF condition is detected then AnyEvent::Handle will first try to
114	feed all the remaining data to the queued callbacks and C<on_read> before	114	feed all the remaining data to the queued callbacks and C<on_read> before
115	calling the C<on_eof> callback. If no progress can be made, then a fatal	115	calling the C<on_eof> callback. If no progress can be made, then a fatal
116	error will be raised (with C<$!> set to C<EPIPE>).	116	error will be raised (with C<$!> set to C<EPIPE>).
117		117
118	=item on_drain => $cb->()	118	=item on_drain => $cb->($handle)
119		119
120	This sets the callback that is called when the write buffer becomes empty	120	This sets the callback that is called when the write buffer becomes empty
121	(or when the callback is set and the buffer is empty already).	121	(or when the callback is set and the buffer is empty already).
122		122
123	To append to the write buffer, use the C<< ->push_write >> method.	123	To append to the write buffer, use the C<< ->push_write >> method.
		124
		125	=item timeout => $fractional_seconds
		126
		127	If non-zero, then this enables an "inactivity" timeout: whenever this many
		128	seconds pass without a successful read or write on the underlying file
		129	handle, the C<on_timeout> callback will be invoked (and if that one is
		130	missing, an C<ETIMEDOUT> errror will be raised).
		131
		132	Note that timeout processing is also active when you currently do not have
		133	any outstanding read or write requests: If you plan to keep the connection
		134	idle then you should disable the timout temporarily or ignore the timeout
		135	in the C<on_timeout> callback.
		136
		137	Zero (the default) disables this timeout.
		138
		139	=item on_timeout => $cb->($handle)
		140
		141	Called whenever the inactivity timeout passes. If you return from this
		142	callback, then the timeout will be reset as if some activity had happened,
		143	so this condition is not fatal in any way.
124		144
125	=item rbuf_max => <bytes>	145	=item rbuf_max => <bytes>
126		146
127	If defined, then a fatal error will be raised (with C<$!> set to C<ENOSPC>)	147	If defined, then a fatal error will be raised (with C<$!> set to C<ENOSPC>)
128	when the read buffer ever (strictly) exceeds this size. This is useful to	148	when the read buffer ever (strictly) exceeds this size. This is useful to
…		…
168		188
169	Use the given Net::SSLeay::CTX object to create the new TLS connection	189	Use the given Net::SSLeay::CTX object to create the new TLS connection
170	(unless a connection object was specified directly). If this parameter is	190	(unless a connection object was specified directly). If this parameter is
171	missing, then AnyEvent::Handle will use C<AnyEvent::Handle::TLS_CTX>.	191	missing, then AnyEvent::Handle will use C<AnyEvent::Handle::TLS_CTX>.
172		192
		193	=item json => JSON or JSON::XS object
		194
		195	This is the json coder object used by the C<json> read and write types.
		196
		197	If you don't supply it, then AnyEvent::Handle will create and use a
		198	suitable one, which will write and expect UTF-8 encoded JSON texts.
		199
		200	Note that you are responsible to depend on the JSON module if you want to
		201	use this functionality, as AnyEvent does not have a dependency itself.
		202
		203	=item filter_r => $cb
		204
		205	=item filter_w => $cb
		206
		207	These exist, but are undocumented at this time.
		208
173	=back	209	=back
174		210
175	=cut	211	=cut
176		212
177	sub new {	213	sub new {
…		…
186	if ($self->{tls}) {	222	if ($self->{tls}) {
187	require Net::SSLeay;	223	require Net::SSLeay;
188	$self->starttls (delete $self->{tls}, delete $self->{tls_ctx});	224	$self->starttls (delete $self->{tls}, delete $self->{tls_ctx});
189	}	225	}
190		226
191	$self->on_eof (delete $self->{on_eof} ) if $self->{on_eof};	227	# $self->on_eof (delete $self->{on_eof} ) if $self->{on_eof}; # nop
192	$self->on_error (delete $self->{on_error}) if $self->{on_error};	228	# $self->on_error (delete $self->{on_error}) if $self->{on_error}; # nop
		229	# $self->on_read (delete $self->{on_read} ) if $self->{on_read}; # nop
193	$self->on_drain (delete $self->{on_drain}) if $self->{on_drain};	230	$self->on_drain (delete $self->{on_drain}) if $self->{on_drain};
194	$self->on_read (delete $self->{on_read} ) if $self->{on_read};	231
		232	$self->{_activity} = AnyEvent->now;
		233	$self->_timeout;
195		234
196	$self->start_read;	235	$self->start_read;
197		236
198	$self	237	$self
199	}	238	}
200		239
201	sub _shutdown {	240	sub _shutdown {
202	my ($self) = @_;	241	my ($self) = @_;
203		242
204	delete $self->{rw};	243	delete $self->{_rw};
205	delete $self->{ww};	244	delete $self->{_ww};
206	delete $self->{fh};	245	delete $self->{fh};
207	}	246	}
208		247
209	sub error {	248	sub error {
210	my ($self) = @_;	249	my ($self) = @_;
…		…
224		263
225	This method returns the file handle of the L<AnyEvent::Handle> object.	264	This method returns the file handle of the L<AnyEvent::Handle> object.
226		265
227	=cut	266	=cut
228		267
229	sub fh { $_[0]->{fh} }	268	sub fh { $_[0]{fh} }
230		269
231	=item $handle->on_error ($cb)	270	=item $handle->on_error ($cb)
232		271
233	Replace the current C<on_error> callback (see the C<on_error> constructor argument).	272	Replace the current C<on_error> callback (see the C<on_error> constructor argument).
234		273
…		…
244		283
245	=cut	284	=cut
246		285
247	sub on_eof {	286	sub on_eof {
248	$_[0]{on_eof} = $_[1];	287	$_[0]{on_eof} = $_[1];
		288	}
		289
		290	=item $handle->on_timeout ($cb)
		291
		292	Replace the current C<on_timeout> callback, or disables the callback
		293	(but not the timeout) if C<$cb> = C<undef>. See C<timeout> constructor
		294	argument.
		295
		296	=cut
		297
		298	sub on_timeout {
		299	$_[0]{on_timeout} = $_[1];
		300	}
		301
		302	#############################################################################
		303
		304	=item $handle->timeout ($seconds)
		305
		306	Configures (or disables) the inactivity timeout.
		307
		308	=cut
		309
		310	sub timeout {
		311	my ($self, $timeout) = @_;
		312
		313	$self->{timeout} = $timeout;
		314	$self->_timeout;
		315	}
		316
		317	# reset the timeout watcher, as neccessary
		318	# also check for time-outs
		319	sub _timeout {
		320	my ($self) = @_;
		321
		322	if ($self->{timeout}) {
		323	my $NOW = AnyEvent->now;
		324
		325	# when would the timeout trigger?
		326	my $after = $self->{_activity} + $self->{timeout} - $NOW;
		327
		328	# now or in the past already?
		329	if ($after <= 0) {
		330	$self->{_activity} = $NOW;
		331
		332	if ($self->{on_timeout}) {
		333	$self->{on_timeout}->($self);
		334	} else {
		335	$! = Errno::ETIMEDOUT;
		336	$self->error;
		337	}
		338
		339	# callbakx could have changed timeout value, optimise
		340	return unless $self->{timeout};
		341
		342	# calculate new after
		343	$after = $self->{timeout};
		344	}
		345
		346	Scalar::Util::weaken $self;
		347
		348	$self->{_tw} \|\|= AnyEvent->timer (after => $after, cb => sub {
		349	delete $self->{_tw};
		350	$self->_timeout;
		351	});
		352	} else {
		353	delete $self->{_tw};
		354	}
249	}	355	}
250		356
251	#############################################################################	357	#############################################################################
252		358
253	=back	359	=back
…		…
290	=cut	396	=cut
291		397
292	sub _drain_wbuf {	398	sub _drain_wbuf {
293	my ($self) = @_;	399	my ($self) = @_;
294		400
295	if (!$self->{ww} && length $self->{wbuf}) {	401	if (!$self->{_ww} && length $self->{wbuf}) {
296		402
297	Scalar::Util::weaken $self;	403	Scalar::Util::weaken $self;
298		404
299	my $cb = sub {	405	my $cb = sub {
300	my $len = syswrite $self->{fh}, $self->{wbuf};	406	my $len = syswrite $self->{fh}, $self->{wbuf};
301		407
302	if ($len >= 0) {	408	if ($len >= 0) {
303	substr $self->{wbuf}, 0, $len, "";	409	substr $self->{wbuf}, 0, $len, "";
		410
		411	$self->{_activity} = AnyEvent->now;
304		412
305	$self->{on_drain}($self)	413	$self->{on_drain}($self)
306	if $self->{low_water_mark} >= length $self->{wbuf}	414	if $self->{low_water_mark} >= length $self->{wbuf}
307	&& $self->{on_drain};	415	&& $self->{on_drain};
308		416
309	delete $self->{ww} unless length $self->{wbuf};	417	delete $self->{_ww} unless length $self->{wbuf};
310	} elsif ($! != EAGAIN && $! != EINTR && $! != WSAWOULDBLOCK) {	418	} elsif ($! != EAGAIN && $! != EINTR && $! != WSAEWOULDBLOCK) {
311	$self->error;	419	$self->error;
312	}	420	}
313	};	421	};
314		422
315	# try to write data immediately	423	# try to write data immediately
316	$cb->();	424	$cb->();
317		425
318	# if still data left in wbuf, we need to poll	426	# if still data left in wbuf, we need to poll
319	$self->{ww} = AnyEvent->io (fh => $self->{fh}, poll => "w", cb => $cb)	427	$self->{_ww} = AnyEvent->io (fh => $self->{fh}, poll => "w", cb => $cb)
320	if length $self->{wbuf};	428	if length $self->{wbuf};
321	};	429	};
322	}	430	}
323		431
324	our %WH;	432	our %WH;
…		…
370	my ($self, $string) = @_;	478	my ($self, $string) = @_;
371		479
372	sprintf "%d:%s,", (length $string), $string	480	sprintf "%d:%s,", (length $string), $string
373	};	481	};
374		482
		483	=item json => $array_or_hashref
		484
		485	Encodes the given hash or array reference into a JSON object. Unless you
		486	provide your own JSON object, this means it will be encoded to JSON text
		487	in UTF-8.
		488
		489	JSON objects (and arrays) are self-delimiting, so you can write JSON at
		490	one end of a handle and read them at the other end without using any
		491	additional framing.
		492
		493	The generated JSON text is guaranteed not to contain any newlines: While
		494	this module doesn't need delimiters after or between JSON texts to be
		495	able to read them, many other languages depend on that.
		496
		497	A simple RPC protocol that interoperates easily with others is to send
		498	JSON arrays (or objects, although arrays are usually the better choice as
		499	they mimic how function argument passing works) and a newline after each
		500	JSON text:
		501
		502	$handle->push_write (json => ["method", "arg1", "arg2"]); # whatever
		503	$handle->push_write ("\012");
		504
		505	An AnyEvent::Handle receiver would simply use the C<json> read type and
		506	rely on the fact that the newline will be skipped as leading whitespace:
		507
		508	$handle->push_read (json => sub { my $array = $_[1]; ... });
		509
		510	Other languages could read single lines terminated by a newline and pass
		511	this line into their JSON decoder of choice.
		512
		513	=cut
		514
		515	register_write_type json => sub {
		516	my ($self, $ref) = @_;
		517
		518	require JSON;
		519
		520	$self->{json} ? $self->{json}->encode ($ref)
		521	: JSON::encode_json ($ref)
		522	};
		523
375	=item AnyEvent::Handle::register_write_type type => $coderef->($self, @args)	524	=item AnyEvent::Handle::register_write_type type => $coderef->($handle, @args)
376		525
377	This function (not method) lets you add your own types to C<push_write>.	526	This function (not method) lets you add your own types to C<push_write>.
378	Whenever the given C<type> is used, C<push_write> will invoke the code	527	Whenever the given C<type> is used, C<push_write> will invoke the code
379	reference with the handle object and the remaining arguments.	528	reference with the handle object and the remaining arguments.
380		529
…		…
480	return if $self->{in_drain};	629	return if $self->{in_drain};
481	local $self->{in_drain} = 1;	630	local $self->{in_drain} = 1;
482		631
483	while (my $len = length $self->{rbuf}) {	632	while (my $len = length $self->{rbuf}) {
484	no strict 'refs';	633	no strict 'refs';
485	if (my $cb = shift @{ $self->{queue} }) {	634	if (my $cb = shift @{ $self->{_queue} }) {
486	unless ($cb->($self)) {	635	unless ($cb->($self)) {
487	if ($self->{eof}) {	636	if ($self->{_eof}) {
488	# no progress can be made (not enough data and no data forthcoming)	637	# no progress can be made (not enough data and no data forthcoming)
489	$! = &Errno::EPIPE;	638	$! = &Errno::EPIPE;
490	$self->error;	639	$self->error;
491	}	640	}
492		641
493	unshift @{ $self->{queue} }, $cb;	642	unshift @{ $self->{_queue} }, $cb;
494	return;	643	return;
495	}	644	}
496	} elsif ($self->{on_read}) {	645	} elsif ($self->{on_read}) {
497	$self->{on_read}($self);	646	$self->{on_read}($self);
498		647
499	if (	648	if (
500	$self->{eof} # if no further data will arrive	649	$self->{_eof} # if no further data will arrive
501	&& $len == length $self->{rbuf} # and no data has been consumed	650	&& $len == length $self->{rbuf} # and no data has been consumed
502	&& !@{ $self->{queue} } # and the queue is still empty	651	&& !@{ $self->{_queue} } # and the queue is still empty
503	&& $self->{on_read} # and we still want to read data	652	&& $self->{on_read} # and we still want to read data
504	) {	653	) {
505	# then no progress can be made	654	# then no progress can be made
506	$! = &Errno::EPIPE;	655	$! = &Errno::EPIPE;
507	$self->error;	656	$self->error;
508	}	657	}
509	} else {	658	} else {
510	# read side becomes idle	659	# read side becomes idle
511	delete $self->{rw};	660	delete $self->{_rw};
512	return;	661	return;
513	}	662	}
514	}	663	}
515		664
516	if ($self->{eof}) {	665	if ($self->{_eof}) {
517	$self->_shutdown;	666	$self->_shutdown;
518	$self->{on_eof}($self)	667	$self->{on_eof}($self)
519	if $self->{on_eof};	668	if $self->{on_eof};
520	}	669	}
521	}	670	}
…		…
587		736
588	$cb = ($RH{$type} or Carp::croak "unsupported type passed to AnyEvent::Handle::push_read")	737	$cb = ($RH{$type} or Carp::croak "unsupported type passed to AnyEvent::Handle::push_read")
589	->($self, $cb, @_);	738	->($self, $cb, @_);
590	}	739	}
591		740
592	push @{ $self->{queue} }, $cb;	741	push @{ $self->{_queue} }, $cb;
593	$self->_drain_rbuf;	742	$self->_drain_rbuf;
594	}	743	}
595		744
596	sub unshift_read {	745	sub unshift_read {
597	my $self = shift;	746	my $self = shift;
…		…
603	$cb = ($RH{$type} or Carp::croak "unsupported type passed to AnyEvent::Handle::unshift_read")	752	$cb = ($RH{$type} or Carp::croak "unsupported type passed to AnyEvent::Handle::unshift_read")
604	->($self, $cb, @_);	753	->($self, $cb, @_);
605	}	754	}
606		755
607		756
608	unshift @{ $self->{queue} }, $cb;	757	unshift @{ $self->{_queue} }, $cb;
609	$self->_drain_rbuf;	758	$self->_drain_rbuf;
610	}	759	}
611		760
612	=item $handle->push_read (type => @args, $cb)	761	=item $handle->push_read (type => @args, $cb)
613		762
…		…
620	Predefined types are (if you have ideas for additional types, feel free to	769	Predefined types are (if you have ideas for additional types, feel free to
621	drop by and tell us):	770	drop by and tell us):
622		771
623	=over 4	772	=over 4
624		773
625	=item chunk => $octets, $cb->($self, $data)	774	=item chunk => $octets, $cb->($handle, $data)
626		775
627	Invoke the callback only once C<$octets> bytes have been read. Pass the	776	Invoke the callback only once C<$octets> bytes have been read. Pass the
628	data read to the callback. The callback will never be called with less	777	data read to the callback. The callback will never be called with less
629	data.	778	data.
630		779
…		…
653		802
654	sub unshift_read_chunk {	803	sub unshift_read_chunk {
655	$_[0]->unshift_read (chunk => $_[1], $_[2]);	804	$_[0]->unshift_read (chunk => $_[1], $_[2]);
656	}	805	}
657		806
658	=item line => [$eol, ]$cb->($self, $line, $eol)	807	=item line => [$eol, ]$cb->($handle, $line, $eol)
659		808
660	The callback will be called only once a full line (including the end of	809	The callback will be called only once a full line (including the end of
661	line marker, C<$eol>) has been read. This line (excluding the end of line	810	line marker, C<$eol>) has been read. This line (excluding the end of line
662	marker) will be passed to the callback as second argument (C<$line>), and	811	marker) will be passed to the callback as second argument (C<$line>), and
663	the end of line marker as the third argument (C<$eol>).	812	the end of line marker as the third argument (C<$eol>).
…		…
700	sub unshift_read_line {	849	sub unshift_read_line {
701	my $self = shift;	850	my $self = shift;
702	$self->unshift_read (line => @_);	851	$self->unshift_read (line => @_);
703	}	852	}
704		853
705	=item netstring => $cb->($string)	854	=item netstring => $cb->($handle, $string)
706		855
707	A netstring (http://cr.yp.to/proto/netstrings.txt, this is not an endorsement).	856	A netstring (http://cr.yp.to/proto/netstrings.txt, this is not an endorsement).
708		857
709	Throws an error with C<$!> set to EBADMSG on format violations.	858	Throws an error with C<$!> set to EBADMSG on format violations.
710		859
…		…
738		887
739	1	888	1
740	}	889	}
741	};	890	};
742		891
743	=item regex => $accept[, $reject[, $skip], $cb->($data)	892	=item regex => $accept[, $reject[, $skip], $cb->($handle, $data)
744		893
745	Makes a regex match against the regex object C<$accept> and returns	894	Makes a regex match against the regex object C<$accept> and returns
746	everything up to and including the match.	895	everything up to and including the match.
747		896
748	Example: read a single line terminated by '\n'.	897	Example: read a single line terminated by '\n'.
…		…
809		958
810	()	959	()
811	}	960	}
812	};	961	};
813		962
		963	=item json => $cb->($handle, $hash_or_arrayref)
		964
		965	Reads a JSON object or array, decodes it and passes it to the callback.
		966
		967	If a C<json> object was passed to the constructor, then that will be used
		968	for the final decode, otherwise it will create a JSON coder expecting UTF-8.
		969
		970	This read type uses the incremental parser available with JSON version
		971	2.09 (and JSON::XS version 2.2) and above. You have to provide a
		972	dependency on your own: this module will load the JSON module, but
		973	AnyEvent does not depend on it itself.
		974
		975	Since JSON texts are fully self-delimiting, the C<json> read and write
		976	types are an ideal simple RPC protocol: just exchange JSON datagrams. See
		977	the C<json> write type description, above, for an actual example.
		978
		979	=cut
		980
		981	register_read_type json => sub {
		982	my ($self, $cb, $accept, $reject, $skip) = @_;
		983
		984	require JSON;
		985
		986	my $data;
		987	my $rbuf = \$self->{rbuf};
		988
		989	my $json = $self->{json} \|\|= JSON->new->utf8;
		990
		991	sub {
		992	my $ref = $json->incr_parse ($self->{rbuf});
		993
		994	if ($ref) {
		995	$self->{rbuf} = $json->incr_text;
		996	$json->incr_text = "";
		997	$cb->($self, $ref);
		998
		999	1
		1000	} else {
		1001	$self->{rbuf} = "";
		1002	()
		1003	}
		1004	}
		1005	};
		1006
814	=back	1007	=back
815		1008
816	=item AnyEvent::Handle::register_read_type type => $coderef->($self, $cb, @args)	1009	=item AnyEvent::Handle::register_read_type type => $coderef->($handle, $cb, @args)
817		1010
818	This function (not method) lets you add your own types to C<push_read>.	1011	This function (not method) lets you add your own types to C<push_read>.
819		1012
820	Whenever the given C<type> is used, C<push_read> will invoke the code	1013	Whenever the given C<type> is used, C<push_read> will invoke the code
821	reference with the handle object, the callback and the remaining	1014	reference with the handle object, the callback and the remaining
…		…
823		1016
824	The code reference is supposed to return a callback (usually a closure)	1017	The code reference is supposed to return a callback (usually a closure)
825	that works as a plain read callback (see C<< ->push_read ($cb) >>).	1018	that works as a plain read callback (see C<< ->push_read ($cb) >>).
826		1019
827	It should invoke the passed callback when it is done reading (remember to	1020	It should invoke the passed callback when it is done reading (remember to
828	pass C<$self> as first argument as all other callbacks do that).	1021	pass C<$handle> as first argument as all other callbacks do that).
829		1022
830	Note that this is a function, and all types registered this way will be	1023	Note that this is a function, and all types registered this way will be
831	global, so try to use unique names.	1024	global, so try to use unique names.
832		1025
833	For examples, see the source of this module (F<perldoc -m AnyEvent::Handle>,	1026	For examples, see the source of this module (F<perldoc -m AnyEvent::Handle>,
…		…
845	=cut	1038	=cut
846		1039
847	sub stop_read {	1040	sub stop_read {
848	my ($self) = @_;	1041	my ($self) = @_;
849		1042
850	delete $self->{rw};	1043	delete $self->{_rw};
851	}	1044	}
852		1045
853	sub start_read {	1046	sub start_read {
854	my ($self) = @_;	1047	my ($self) = @_;
855		1048
856	unless ($self->{rw} \|\| $self->{eof}) {	1049	unless ($self->{_rw} \|\| $self->{_eof}) {
857	Scalar::Util::weaken $self;	1050	Scalar::Util::weaken $self;
858		1051
859	$self->{rw} = AnyEvent->io (fh => $self->{fh}, poll => "r", cb => sub {	1052	$self->{_rw} = AnyEvent->io (fh => $self->{fh}, poll => "r", cb => sub {
860	my $rbuf = $self->{filter_r} ? \my $buf : \$self->{rbuf};	1053	my $rbuf = $self->{filter_r} ? \my $buf : \$self->{rbuf};
861	my $len = sysread $self->{fh}, $$rbuf, $self->{read_size} \|\| 8192, length $$rbuf;	1054	my $len = sysread $self->{fh}, $$rbuf, $self->{read_size} \|\| 8192, length $$rbuf;
862		1055
863	if ($len > 0) {	1056	if ($len > 0) {
		1057	$self->{_activity} = AnyEvent->now;
		1058
864	$self->{filter_r}	1059	$self->{filter_r}
865	? $self->{filter_r}->($self, $rbuf)	1060	? $self->{filter_r}->($self, $rbuf)
866	: $self->_drain_rbuf;	1061	: $self->_drain_rbuf;
867		1062
868	} elsif (defined $len) {	1063	} elsif (defined $len) {
869	delete $self->{rw};	1064	delete $self->{_rw};
		1065	delete $self->{_ww};
		1066	delete $self->{_tw};
870	$self->{eof} = 1;	1067	$self->{_eof} = 1;
871	$self->_drain_rbuf;	1068	$self->_drain_rbuf;
872		1069
873	} elsif ($! != EAGAIN && $! != EINTR && $! != &AnyEvent::Util::WSAWOULDBLOCK) {	1070	} elsif ($! != EAGAIN && $! != EINTR && $! != WSAEWOULDBLOCK) {
874	return $self->error;	1071	return $self->error;
875	}	1072	}
876	});	1073	});
877	}	1074	}
878	}	1075	}
879		1076
880	sub _dotls {	1077	sub _dotls {
881	my ($self) = @_;	1078	my ($self) = @_;
882		1079
883	if (length $self->{tls_wbuf}) {	1080	if (length $self->{_tls_wbuf}) {
884	while ((my $len = Net::SSLeay::write ($self->{tls}, $self->{tls_wbuf})) > 0) {	1081	while ((my $len = Net::SSLeay::write ($self->{tls}, $self->{_tls_wbuf})) > 0) {
885	substr $self->{tls_wbuf}, 0, $len, "";	1082	substr $self->{_tls_wbuf}, 0, $len, "";
886	}	1083	}
887	}	1084	}
888		1085
889	if (defined (my $buf = Net::SSLeay::BIO_read ($self->{tls_wbio}))) {	1086	if (defined (my $buf = Net::SSLeay::BIO_read ($self->{_wbio}))) {
890	$self->{wbuf} .= $buf;	1087	$self->{wbuf} .= $buf;
891	$self->_drain_wbuf;	1088	$self->_drain_wbuf;
892	}	1089	}
893		1090
894	while (defined (my $buf = Net::SSLeay::read ($self->{tls}))) {	1091	while (defined (my $buf = Net::SSLeay::read ($self->{tls}))) {
…		…
919	The first argument is the same as the C<tls> constructor argument (either	1116	The first argument is the same as the C<tls> constructor argument (either
920	C<"connect">, C<"accept"> or an existing Net::SSLeay object).	1117	C<"connect">, C<"accept"> or an existing Net::SSLeay object).
921		1118
922	The second argument is the optional C<Net::SSLeay::CTX> object that is	1119	The second argument is the optional C<Net::SSLeay::CTX> object that is
923	used when AnyEvent::Handle has to create its own TLS connection object.	1120	used when AnyEvent::Handle has to create its own TLS connection object.
		1121
		1122	The TLS connection object will end up in C<< $handle->{tls} >> after this
		1123	call and can be used or changed to your liking. Note that the handshake
		1124	might have already started when this function returns.
924		1125
925	=cut	1126	=cut
926		1127
927	# TODO: maybe document...	1128	# TODO: maybe document...
928	sub starttls {	1129	sub starttls {
…		…
947	# http://www.mail-archive.com/openssl-dev@openssl.org/msg22420.html	1148	# http://www.mail-archive.com/openssl-dev@openssl.org/msg22420.html
948	Net::SSLeay::CTX_set_mode ($self->{tls},	1149	Net::SSLeay::CTX_set_mode ($self->{tls},
949	(eval { local $SIG{__DIE__}; Net::SSLeay::MODE_ENABLE_PARTIAL_WRITE () } \|\| 1)	1150	(eval { local $SIG{__DIE__}; Net::SSLeay::MODE_ENABLE_PARTIAL_WRITE () } \|\| 1)
950	\| (eval { local $SIG{__DIE__}; Net::SSLeay::MODE_ACCEPT_MOVING_WRITE_BUFFER () } \|\| 2));	1151	\| (eval { local $SIG{__DIE__}; Net::SSLeay::MODE_ACCEPT_MOVING_WRITE_BUFFER () } \|\| 2));
951		1152
952	$self->{tls_rbio} = Net::SSLeay::BIO_new (Net::SSLeay::BIO_s_mem ());	1153	$self->{_rbio} = Net::SSLeay::BIO_new (Net::SSLeay::BIO_s_mem ());
953	$self->{tls_wbio} = Net::SSLeay::BIO_new (Net::SSLeay::BIO_s_mem ());	1154	$self->{_wbio} = Net::SSLeay::BIO_new (Net::SSLeay::BIO_s_mem ());
954		1155
955	Net::SSLeay::set_bio ($ssl, $self->{tls_rbio}, $self->{tls_wbio});	1156	Net::SSLeay::set_bio ($ssl, $self->{_rbio}, $self->{_wbio});
956		1157
957	$self->{filter_w} = sub {	1158	$self->{filter_w} = sub {
958	$_[0]{tls_wbuf} .= ${$_[1]};	1159	$_[0]{_tls_wbuf} .= ${$_[1]};
959	&_dotls;	1160	&_dotls;
960	};	1161	};
961	$self->{filter_r} = sub {	1162	$self->{filter_r} = sub {
962	Net::SSLeay::BIO_write ($_[0]{tls_rbio}, ${$_[1]});	1163	Net::SSLeay::BIO_write ($_[0]{_rbio}, ${$_[1]});
963	&_dotls;	1164	&_dotls;
964	};	1165	};
965	}	1166	}
966		1167
967	=item $handle->stoptls	1168	=item $handle->stoptls
…		…
973		1174
974	sub stoptls {	1175	sub stoptls {
975	my ($self) = @_;	1176	my ($self) = @_;
976		1177
977	Net::SSLeay::free (delete $self->{tls}) if $self->{tls};	1178	Net::SSLeay::free (delete $self->{tls}) if $self->{tls};
		1179
978	delete $self->{tls_rbio};	1180	delete $self->{_rbio};
979	delete $self->{tls_wbio};	1181	delete $self->{_wbio};
980	delete $self->{tls_wbuf};	1182	delete $self->{_tls_wbuf};
981	delete $self->{filter_r};	1183	delete $self->{filter_r};
982	delete $self->{filter_w};	1184	delete $self->{filter_w};
983	}	1185	}
984		1186
985	sub DESTROY {	1187	sub DESTROY {
…		…
1023	}	1225	}
1024	}	1226	}
1025		1227
1026	=back	1228	=back
1027		1229
		1230	=head1 SUBCLASSING AnyEvent::Handle
		1231
		1232	In many cases, you might want to subclass AnyEvent::Handle.
		1233
		1234	To make this easier, a given version of AnyEvent::Handle uses these
		1235	conventions:
		1236
		1237	=over 4
		1238
		1239	=item * all constructor arguments become object members.
		1240
		1241	At least initially, when you pass a C<tls>-argument to the constructor it
		1242	will end up in C<< $handle->{tls} >>. Those members might be changes or
		1243	mutated later on (for example C<tls> will hold the TLS connection object).
		1244
		1245	=item * other object member names are prefixed with an C<_>.
		1246
		1247	All object members not explicitly documented (internal use) are prefixed
		1248	with an underscore character, so the remaining non-C<_>-namespace is free
		1249	for use for subclasses.
		1250
		1251	=item * all members not documented here and not prefixed with an underscore
		1252	are free to use in subclasses.
		1253
		1254	Of course, new versions of AnyEvent::Handle may introduce more "public"
		1255	member variables, but thats just life, at least it is documented.
		1256
		1257	=back
		1258
1028	=head1 AUTHOR	1259	=head1 AUTHOR
1029		1260
1030	Robin Redeker C<< <elmex at ta-sa.org> >>, Marc Lehmann <schmorp@schmorp.de>.	1261	Robin Redeker C<< <elmex at ta-sa.org> >>, Marc Lehmann <schmorp@schmorp.de>.
1031		1262
1032	=cut	1263	=cut

Diff Legend

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

Comparing AnyEvent/lib/AnyEvent/Handle.pm (file contents): Revision 1.37 by root, Mon May 26 20:02:22 2008 UTC vs. Revision 1.44 by root, Thu May 29 00:00:07 2008 UTC

Diff Legend

Comparing AnyEvent/lib/AnyEvent/Handle.pm (file contents):
Revision 1.37 by root, Mon May 26 20:02:22 2008 UTC vs.
Revision 1.44 by root, Thu May 29 00:00:07 2008 UTC