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

Comparing AnyEvent/lib/AnyEvent/Handle.pm (file contents):
Revision 1.60 by root, Thu Jun 5 18:30:08 2008 UTC vs.
Revision 1.66 by root, Fri Jun 6 15:32:54 2008 UTC

…		…
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
17	=cut	17	=cut
18		18
19	our $VERSION = 4.14;	19	our $VERSION = 4.15;
20		20
21	=head1 SYNOPSIS	21	=head1 SYNOPSIS
22		22
23	use AnyEvent;	23	use AnyEvent;
24	use AnyEvent::Handle;	24	use AnyEvent::Handle;
…		…
105	C<croak>.	105	C<croak>.
106		106
107	=item on_read => $cb->($handle)	107	=item on_read => $cb->($handle)
108		108
109	This sets the default read callback, which is called when data arrives	109	This sets the default read callback, which is called when data arrives
110	and no read request is in the queue.	110	and no read request is in the queue (unlike read queue callbacks, this
		111	callback will only be called when at least one octet of data is in the
		112	read buffer).
111		113
112	To access (and remove data from) the read buffer, use the C<< ->rbuf >>	114	To access (and remove data from) the read buffer, use the C<< ->rbuf >>
113	method or access the C<$handle->{rbuf}> member directly.	115	method or access the C<$handle->{rbuf}> member directly.
114		116
115	When an EOF condition is detected then AnyEvent::Handle will first try to	117	When an EOF condition is detected then AnyEvent::Handle will first try to
…		…
165		167
166	Sets the amount of bytes (default: C<0>) that make up an "empty" write	168	Sets the amount of bytes (default: C<0>) that make up an "empty" write
167	buffer: If the write reaches this size or gets even samller it is	169	buffer: If the write reaches this size or gets even samller it is
168	considered empty.	170	considered empty.
169		171
		172	=item linger => <seconds>
		173
		174	If non-zero (default: C<3600>), then the destructor of the
		175	AnyEvent::Handle object will check wether there is still outstanding write
		176	data and will install a watcher that will write out this data. No errors
		177	will be reported (this mostly matches how the operating system treats
		178	outstanding data at socket close time).
		179
		180	This will not work for partial TLS data that could not yet been
		181	encoded. This data will be lost.
		182
170	=item tls => "accept" \| "connect" \| Net::SSLeay::SSL object	183	=item tls => "accept" \| "connect" \| Net::SSLeay::SSL object
171		184
172	When this parameter is given, it enables TLS (SSL) mode, that means it	185	When this parameter is given, it enables TLS (SSL) mode, that means it
173	will start making tls handshake and will transparently encrypt/decrypt	186	will start making tls handshake and will transparently encrypt/decrypt
174	data.	187	data.
…		…
228		241
229	$self->{_activity} = AnyEvent->now;	242	$self->{_activity} = AnyEvent->now;
230	$self->_timeout;	243	$self->_timeout;
231		244
232	$self->on_drain (delete $self->{on_drain}) if $self->{on_drain};	245	$self->on_drain (delete $self->{on_drain}) if $self->{on_drain};
233	$self->on_read (delete $self->{on_read} ) if $self->{on_read};	246
		247	$self->start_read
		248	if $self->{on_read} \|\| @{ $self->{_queue} };
234		249
235	$self	250	$self
236	}	251	}
237		252
238	sub _shutdown {	253	sub _shutdown {
…		…
476	my ($self, $string) = @_;	491	my ($self, $string) = @_;
477		492
478	sprintf "%d:%s,", (length $string), $string	493	sprintf "%d:%s,", (length $string), $string
479	};	494	};
480		495
		496	=item packstring => $format, $data
		497
		498	An octet string prefixed with an encoded length. The encoding C<$format>
		499	uses the same format as a Perl C<pack> format, but must specify a single
		500	integer only (only one of C<cCsSlLqQiInNvVjJw> is allowed, plus an
		501	optional C<!>, C<< < >> or C<< > >> modifier).
		502
		503	=cut
		504
		505	register_write_type packstring => sub {
		506	my ($self, $format, $string) = @_;
		507
		508	pack "$format/a*", $string
		509	};
		510
481	=item json => $array_or_hashref	511	=item json => $array_or_hashref
482		512
483	Encodes the given hash or array reference into a JSON object. Unless you	513	Encodes the given hash or array reference into a JSON object. Unless you
484	provide your own JSON object, this means it will be encoded to JSON text	514	provide your own JSON object, this means it will be encoded to JSON text
485	in UTF-8.	515	in UTF-8.
…		…
517		547
518	$self->{json} ? $self->{json}->encode ($ref)	548	$self->{json} ? $self->{json}->encode ($ref)
519	: JSON::encode_json ($ref)	549	: JSON::encode_json ($ref)
520	};	550	};
521		551
		552	=item storable => $reference
		553
		554	Freezes the given reference using L<Storable> and writes it to the
		555	handle. Uses the C<nfreeze> format.
		556
		557	=cut
		558
		559	register_write_type storable => sub {
		560	my ($self, $ref) = @_;
		561
		562	require Storable;
		563
		564	pack "w/a*", Storable::nfreeze ($ref)
		565	};
		566
522	=back	567	=back
523		568
524	=item AnyEvent::Handle::register_write_type type => $coderef->($handle, @args)	569	=item AnyEvent::Handle::register_write_type type => $coderef->($handle, @args)
525		570
526	This function (not method) lets you add your own types to C<push_write>.	571	This function (not method) lets you add your own types to C<push_write>.
…		…
553	enough is there) from the read buffer (C<< $handle->rbuf >>) if you want	598	enough is there) from the read buffer (C<< $handle->rbuf >>) if you want
554	or not.	599	or not.
555		600
556	In the more complex case, you want to queue multiple callbacks. In this	601	In the more complex case, you want to queue multiple callbacks. In this
557	case, AnyEvent::Handle will call the first queued callback each time new	602	case, AnyEvent::Handle will call the first queued callback each time new
558	data arrives and removes it when it has done its job (see C<push_read>,	603	data arrives (also the first time it is queued) and removes it when it has
559	below).	604	done its job (see C<push_read>, below).
560		605
561	This way you can, for example, push three line-reads, followed by reading	606	This way you can, for example, push three line-reads, followed by reading
562	a chunk of data, and AnyEvent::Handle will execute them in order.	607	a chunk of data, and AnyEvent::Handle will execute them in order.
563		608
564	Example 1: EPP protocol parser. EPP sends 4 byte length info, followed by	609	Example 1: EPP protocol parser. EPP sends 4 byte length info, followed by
…		…
634		679
635	if (my $cb = shift @{ $self->{_queue} }) {	680	if (my $cb = shift @{ $self->{_queue} }) {
636	unless ($cb->($self)) {	681	unless ($cb->($self)) {
637	if ($self->{_eof}) {	682	if ($self->{_eof}) {
638	# no progress can be made (not enough data and no data forthcoming)	683	# no progress can be made (not enough data and no data forthcoming)
639	return $self->_error (&Errno::EPIPE, 1);	684	$self->_error (&Errno::EPIPE, 1), last;
640	}	685	}
641		686
642	unshift @{ $self->{_queue} }, $cb;	687	unshift @{ $self->{_queue} }, $cb;
643	last;	688	last;
644	}	689	}
645	} elsif ($self->{on_read}) {	690	} elsif ($self->{on_read}) {
		691	last unless $len;
		692
646	$self->{on_read}($self);	693	$self->{on_read}($self);
647		694
648	if (	695	if (
649	$len == length $self->{rbuf} # if no data has been consumed	696	$len == length $self->{rbuf} # if no data has been consumed
650	&& !@{ $self->{_queue} } # and the queue is still empty	697	&& !@{ $self->{_queue} } # and the queue is still empty
651	&& $self->{on_read} # but we still have on_read	698	&& $self->{on_read} # but we still have on_read
652	) {	699	) {
653	# no further data will arrive	700	# no further data will arrive
654	# so no progress can be made	701	# so no progress can be made
655	return $self->_error (&Errno::EPIPE, 1)	702	$self->_error (&Errno::EPIPE, 1), last
656	if $self->{_eof};	703	if $self->{_eof};
657		704
658	last; # more data might arrive	705	last; # more data might arrive
659	}	706	}
660	} else {	707	} else {
…		…
854		901
855	sub unshift_read_line {	902	sub unshift_read_line {
856	my $self = shift;	903	my $self = shift;
857	$self->unshift_read (line => @_);	904	$self->unshift_read (line => @_);
858	}	905	}
859
860	=item netstring => $cb->($handle, $string)
861
862	A netstring (http://cr.yp.to/proto/netstrings.txt, this is not an endorsement).
863
864	Throws an error with C<$!> set to EBADMSG on format violations.
865
866	=cut
867
868	register_read_type netstring => sub {
869	my ($self, $cb) = @_;
870
871	sub {
872	unless ($_[0]{rbuf} =~ s/^(0\|[1-9][0-9]*)://) {
873	if ($_[0]{rbuf} =~ /[^0-9]/) {
874	$self->_error (&Errno::EBADMSG);
875	}
876	return;
877	}
878
879	my $len = $1;
880
881	$self->unshift_read (chunk => $len, sub {
882	my $string = $_[1];
883	$_[0]->unshift_read (chunk => 1, sub {
884	if ($_[1] eq ",") {
885	$cb->($_[0], $string);
886	} else {
887	$self->_error (&Errno::EBADMSG);
888	}
889	});
890	});
891
892	1
893	}
894	};
895		906
896	=item regex => $accept[, $reject[, $skip], $cb->($handle, $data)	907	=item regex => $accept[, $reject[, $skip], $cb->($handle, $data)
897		908
898	Makes a regex match against the regex object C<$accept> and returns	909	Makes a regex match against the regex object C<$accept> and returns
899	everything up to and including the match.	910	everything up to and including the match.
…		…
961		972
962	()	973	()
963	}	974	}
964	};	975	};
965		976
		977	=item netstring => $cb->($handle, $string)
		978
		979	A netstring (http://cr.yp.to/proto/netstrings.txt, this is not an endorsement).
		980
		981	Throws an error with C<$!> set to EBADMSG on format violations.
		982
		983	=cut
		984
		985	register_read_type netstring => sub {
		986	my ($self, $cb) = @_;
		987
		988	sub {
		989	unless ($_[0]{rbuf} =~ s/^(0\|[1-9][0-9]*)://) {
		990	if ($_[0]{rbuf} =~ /[^0-9]/) {
		991	$self->_error (&Errno::EBADMSG);
		992	}
		993	return;
		994	}
		995
		996	my $len = $1;
		997
		998	$self->unshift_read (chunk => $len, sub {
		999	my $string = $_[1];
		1000	$_[0]->unshift_read (chunk => 1, sub {
		1001	if ($_[1] eq ",") {
		1002	$cb->($_[0], $string);
		1003	} else {
		1004	$self->_error (&Errno::EBADMSG);
		1005	}
		1006	});
		1007	});
		1008
		1009	1
		1010	}
		1011	};
		1012
		1013	=item packstring => $format, $cb->($handle, $string)
		1014
		1015	An octet string prefixed with an encoded length. The encoding C<$format>
		1016	uses the same format as a Perl C<pack> format, but must specify a single
		1017	integer only (only one of C<cCsSlLqQiInNvVjJw> is allowed, plus an
		1018	optional C<!>, C<< < >> or C<< > >> modifier).
		1019
		1020	DNS over TCP uses a prefix of C<n>, EPP uses a prefix of C<N>.
		1021
		1022	Example: read a block of data prefixed by its length in BER-encoded
		1023	format (very efficient).
		1024
		1025	$handle->push_read (packstring => "w", sub {
		1026	my ($handle, $data) = @_;
		1027	});
		1028
		1029	=cut
		1030
		1031	register_read_type packstring => sub {
		1032	my ($self, $cb, $format) = @_;
		1033
		1034	sub {
		1035	# when we can use 5.10 we can use ".", but for 5.8 we use the re-pack method
		1036	defined (my $len = eval { unpack $format, $_[0]->{rbuf} })
		1037	or return;
		1038
		1039	# remove prefix
		1040	substr $_[0]->{rbuf}, 0, (length pack $format, $len), "";
		1041
		1042	# read rest
		1043	$_[0]->unshift_read (chunk => $len, $cb);
		1044
		1045	1
		1046	}
		1047	};
		1048
966	=item json => $cb->($handle, $hash_or_arrayref)	1049	=item json => $cb->($handle, $hash_or_arrayref)
967		1050
968	Reads a JSON object or array, decodes it and passes it to the callback.	1051	Reads a JSON object or array, decodes it and passes it to the callback.
969		1052
970	If a C<json> object was passed to the constructor, then that will be used	1053	If a C<json> object was passed to the constructor, then that will be used
…		…
980	the C<json> write type description, above, for an actual example.	1063	the C<json> write type description, above, for an actual example.
981		1064
982	=cut	1065	=cut
983		1066
984	register_read_type json => sub {	1067	register_read_type json => sub {
985	my ($self, $cb, $accept, $reject, $skip) = @_;	1068	my ($self, $cb) = @_;
986		1069
987	require JSON;	1070	require JSON;
988		1071
989	my $data;	1072	my $data;
990	my $rbuf = \$self->{rbuf};	1073	my $rbuf = \$self->{rbuf};
…		…
1002	1	1085	1
1003	} else {	1086	} else {
1004	$self->{rbuf} = "";	1087	$self->{rbuf} = "";
1005	()	1088	()
1006	}	1089	}
		1090	}
		1091	};
		1092
		1093	=item storable => $cb->($handle, $ref)
		1094
		1095	Deserialises a L<Storable> frozen representation as written by the
		1096	C<storable> write type (BER-encoded length prefix followed by nfreeze'd
		1097	data).
		1098
		1099	Raises C<EBADMSG> error if the data could not be decoded.
		1100
		1101	=cut
		1102
		1103	register_read_type storable => sub {
		1104	my ($self, $cb) = @_;
		1105
		1106	require Storable;
		1107
		1108	sub {
		1109	# when we can use 5.10 we can use ".", but for 5.8 we use the re-pack method
		1110	defined (my $len = eval { unpack "w", $_[0]->{rbuf} })
		1111	or return;
		1112
		1113	# remove prefix
		1114	substr $_[0]->{rbuf}, 0, (length pack "w", $len), "";
		1115
		1116	# read rest
		1117	$_[0]->unshift_read (chunk => $len, sub {
		1118	if (my $ref = eval { Storable::thaw ($_[1]) }) {
		1119	$cb->($_[0], $ref);
		1120	} else {
		1121	$self->_error (&Errno::EBADMSG);
		1122	}
		1123	});
1007	}	1124	}
1008	};	1125	};
1009		1126
1010	=back	1127	=back
1011		1128
…		…
1199		1316
1200	sub DESTROY {	1317	sub DESTROY {
1201	my $self = shift;	1318	my $self = shift;
1202		1319
1203	$self->stoptls;	1320	$self->stoptls;
		1321
		1322	my $linger = exists $self->{linger} ? $self->{linger} : 3600;
		1323
		1324	if ($linger && length $self->{wbuf}) {
		1325	my $fh = delete $self->{fh};
		1326	my $wbuf = delete $self->{wbuf};
		1327
		1328	my @linger;
		1329
		1330	push @linger, AnyEvent->io (fh => $fh, poll => "w", cb => sub {
		1331	my $len = syswrite $fh, $wbuf, length $wbuf;
		1332
		1333	if ($len > 0) {
		1334	substr $wbuf, 0, $len, "";
		1335	} else {
		1336	@linger = (); # end
		1337	}
		1338	});
		1339	push @linger, AnyEvent->timer (after => $linger, cb => sub {
		1340	@linger = ();
		1341	});
		1342	}
1204	}	1343	}
1205		1344
1206	=item AnyEvent::Handle::TLS_CTX	1345	=item AnyEvent::Handle::TLS_CTX
1207		1346
1208	This function creates and returns the Net::SSLeay::CTX object used by	1347	This function creates and returns the Net::SSLeay::CTX object used by

Diff Legend

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

Comparing AnyEvent/lib/AnyEvent/Handle.pm (file contents): Revision 1.60 by root, Thu Jun 5 18:30:08 2008 UTC vs. Revision 1.66 by root, Fri Jun 6 15:32:54 2008 UTC

Diff Legend

Comparing AnyEvent/lib/AnyEvent/Handle.pm (file contents):
Revision 1.60 by root, Thu Jun 5 18:30:08 2008 UTC vs.
Revision 1.66 by root, Fri Jun 6 15:32:54 2008 UTC