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

Comparing AnyEvent/lib/AnyEvent.pm (file contents):
Revision 1.311 by root, Wed Feb 10 13:33:44 2010 UTC vs.
Revision 1.325 by root, Thu May 20 23:56:04 2010 UTC

…		…
7		7
8	=head1 SYNOPSIS	8	=head1 SYNOPSIS
9		9
10	use AnyEvent;	10	use AnyEvent;
11		11
		12	# if you prefer function calls, look at the AE manpage for
		13	# an alternative API.
		14
12	# file descriptor readable	15	# file handle or descriptor readable
13	my $w = AnyEvent->io (fh => $fh, poll => "r", cb => sub { ... });	16	my $w = AnyEvent->io (fh => $fh, poll => "r", cb => sub { ... });
14		17
15	# one-shot or repeating timers	18	# one-shot or repeating timers
16	my $w = AnyEvent->timer (after => $seconds, cb => sub { ... });	19	my $w = AnyEvent->timer (after => $seconds, cb => sub { ... });
17	my $w = AnyEvent->timer (after => $seconds, interval => $seconds, cb => ...	20	my $w = AnyEvent->timer (after => $seconds, interval => $seconds, cb => ...
…		…
606	eventually calls C<< -> send >>, and the "consumer side", which waits	609	eventually calls C<< -> send >>, and the "consumer side", which waits
607	for the send to occur.	610	for the send to occur.
608		611
609	Example: wait for a timer.	612	Example: wait for a timer.
610		613
611	# wait till the result is ready	614	# condition: "wait till the timer is fired"
612	my $result_ready = AnyEvent->condvar;	615	my $timer_fired = AnyEvent->condvar;
613		616
614	# do something such as adding a timer	617	# create the timer - we could wait for, say
615	# or socket watcher the calls $result_ready->send	618	# a handle becomign ready, or even an
616	# when the "result" is ready.	619	# AnyEvent::HTTP request to finish, but
617	# in this case, we simply use a timer:	620	# in this case, we simply use a timer:
618	my $w = AnyEvent->timer (	621	my $w = AnyEvent->timer (
619	after => 1,	622	after => 1,
620	cb => sub { $result_ready->send },	623	cb => sub { $timer_fired->send },
621	);	624	);
622		625
623	# this "blocks" (while handling events) till the callback	626	# this "blocks" (while handling events) till the callback
624	# calls ->send	627	# calls ->send
625	$result_ready->recv;	628	$timer_fired->recv;
626		629
627	Example: wait for a timer, but take advantage of the fact that condition	630	Example: wait for a timer, but take advantage of the fact that condition
628	variables are also callable directly.	631	variables are also callable directly.
629		632
630	my $done = AnyEvent->condvar;	633	my $done = AnyEvent->condvar;
…		…
1054	=head1 OTHER MODULES	1057	=head1 OTHER MODULES
1055		1058
1056	The following is a non-exhaustive list of additional modules that use	1059	The following is a non-exhaustive list of additional modules that use
1057	AnyEvent as a client and can therefore be mixed easily with other AnyEvent	1060	AnyEvent as a client and can therefore be mixed easily with other AnyEvent
1058	modules and other event loops in the same program. Some of the modules	1061	modules and other event loops in the same program. Some of the modules
1059	come with AnyEvent, most are available via CPAN.	1062	come as part of AnyEvent, the others are available via CPAN.
1060		1063
1061	=over 4	1064	=over 4
1062		1065
1063	=item L<AnyEvent::Util>	1066	=item L<AnyEvent::Util>
1064		1067
…		…
1079		1082
1080	=item L<AnyEvent::DNS>	1083	=item L<AnyEvent::DNS>
1081		1084
1082	Provides rich asynchronous DNS resolver capabilities.	1085	Provides rich asynchronous DNS resolver capabilities.
1083		1086
		1087	=item L<AnyEvent::HTTP>, L<AnyEvent::IRC>, L<AnyEvent::XMPP>, L<AnyEvent::GPSD>, L<AnyEvent::IGS>, L<AnyEvent::FCP>
		1088
		1089	Implement event-based interfaces to the protocols of the same name (for
		1090	the curious, IGS is the International Go Server and FCP is the Freenet
		1091	Client Protocol).
		1092
		1093	=item L<AnyEvent::Handle::UDP>
		1094
		1095	Here be danger!
		1096
		1097	As Pauli would put it, "Not only is it not right, it's not even wrong!" -
		1098	there are so many things wrong with AnyEvent::Handle::UDP, most notably
		1099	it's use of a stream-based API with a protocol that isn't streamable, that
		1100	the only way to improve it is to delete it.
		1101
		1102	It features data corruption (but typically only under load) and general
		1103	confusion. On top, the author is not only clueless about UDP but also
		1104	fact-resistant - some gems of his understanding: "connect doesn't work
		1105	with UDP", "UDP packets are not IP packets", "UDP only has datagrams, not
		1106	packets", "I don't need to implement proper error checking as UDP doesn't
		1107	support error checking" and so on - he doesn't even understand what's
		1108	wrong with his module when it is explained to him.
		1109
1084	=item L<AnyEvent::HTTP>	1110	=item L<AnyEvent::DBI>
1085		1111
1086	A simple-to-use HTTP library that is capable of making a lot of concurrent	1112	Executes L<DBI> requests asynchronously in a proxy process for you,
1087	HTTP requests.	1113	notifying you in an event-bnased way when the operation is finished.
		1114
		1115	=item L<AnyEvent::AIO>
		1116
		1117	Truly asynchronous (as opposed to non-blocking) I/O, should be in the
		1118	toolbox of every event programmer. AnyEvent::AIO transparently fuses
		1119	L<IO::AIO> and AnyEvent together, giving AnyEvent access to event-based
		1120	file I/O, and much more.
1088		1121
1089	=item L<AnyEvent::HTTPD>	1122	=item L<AnyEvent::HTTPD>
1090		1123
1091	Provides a simple web application server framework.	1124	A simple embedded webserver.
1092		1125
1093	=item L<AnyEvent::FastPing>	1126	=item L<AnyEvent::FastPing>
1094		1127
1095	The fastest ping in the west.	1128	The fastest ping in the west.
1096
1097	=item L<AnyEvent::DBI>
1098
1099	Executes L<DBI> requests asynchronously in a proxy process.
1100
1101	=item L<AnyEvent::AIO>
1102
1103	Truly asynchronous I/O, should be in the toolbox of every event
1104	programmer. AnyEvent::AIO transparently fuses L<IO::AIO> and AnyEvent
1105	together.
1106
1107	=item L<AnyEvent::BDB>
1108
1109	Truly asynchronous Berkeley DB access. AnyEvent::BDB transparently fuses
1110	L<BDB> and AnyEvent together.
1111
1112	=item L<AnyEvent::GPSD>
1113
1114	A non-blocking interface to gpsd, a daemon delivering GPS information.
1115
1116	=item L<AnyEvent::IRC>
1117
1118	AnyEvent based IRC client module family (replacing the older Net::IRC3).
1119
1120	=item L<AnyEvent::XMPP>
1121
1122	AnyEvent based XMPP (Jabber protocol) module family (replacing the older
1123	Net::XMPP2>.
1124
1125	=item L<AnyEvent::IGS>
1126
1127	A non-blocking interface to the Internet Go Server protocol (used by
1128	L<App::IGS>).
1129
1130	=item L<Net::FCP>
1131
1132	AnyEvent-based implementation of the Freenet Client Protocol, birthplace
1133	of AnyEvent.
1134
1135	=item L<Event::ExecFlow>
1136
1137	High level API for event-based execution flow control.
1138		1129
1139	=item L<Coro>	1130	=item L<Coro>
1140		1131
1141	Has special support for AnyEvent via L<Coro::AnyEvent>.	1132	Has special support for AnyEvent via L<Coro::AnyEvent>.
1142		1133
…		…
1156		1147
1157	BEGIN { AnyEvent::common_sense }	1148	BEGIN { AnyEvent::common_sense }
1158		1149
1159	use Carp ();	1150	use Carp ();
1160		1151
1161	our $VERSION = '5.24';	1152	our $VERSION = '5.261';
1162	our $MODEL;	1153	our $MODEL;
1163		1154
1164	our $AUTOLOAD;	1155	our $AUTOLOAD;
1165	our @ISA;	1156	our @ISA;
1166		1157
1167	our @REGISTRY;	1158	our @REGISTRY;
1168		1159
1169	our $VERBOSE;	1160	our $VERBOSE;
1170		1161
1171	BEGIN {	1162	BEGIN {
1172	eval "sub CYGWIN(){" . (($^O =~ /cygwin/i) *1) . "}";	1163	require "AnyEvent/constants.pl";
1173	eval "sub WIN32 (){" . (($^O =~ /mswin32/i)*1) . "}";	1164
1174	eval "sub TAINT (){" . (${^TAINT} *1) . "}";	1165	eval "sub TAINT (){" . (${^TAINT}*1) . "}";
1175		1166
1176	delete @ENV{grep /^PERL_ANYEVENT_/, keys %ENV}	1167	delete @ENV{grep /^PERL_ANYEVENT_/, keys %ENV}
1177	if ${^TAINT};	1168	if ${^TAINT};
1178		1169
1179	$VERBOSE = $ENV{PERL_ANYEVENT_VERBOSE}*1;	1170	$VERBOSE = $ENV{PERL_ANYEVENT_VERBOSE}*1;
…		…
1222	our @post_detect;	1213	our @post_detect;
1223		1214
1224	sub post_detect(&) {	1215	sub post_detect(&) {
1225	my ($cb) = @_;	1216	my ($cb) = @_;
1226		1217
1227	if ($MODEL) {
1228	$cb->();
1229
1230	undef
1231	} else {
1232	push @post_detect, $cb;	1218	push @post_detect, $cb;
1233		1219
1234	defined wantarray	1220	defined wantarray
1235	? bless \$cb, "AnyEvent::Util::postdetect"	1221	? bless \$cb, "AnyEvent::Util::postdetect"
1236	: ()	1222	: ()
1237	}
1238	}	1223	}
1239		1224
1240	sub AnyEvent::Util::postdetect::DESTROY {	1225	sub AnyEvent::Util::postdetect::DESTROY {
1241	@post_detect = grep $_ != ${$_[0]}, @post_detect;	1226	@post_detect = grep $_ != ${$_[0]}, @post_detect;
1242	}	1227	}
1243		1228
1244	sub detect() {	1229	sub detect() {
		1230	# free some memory
		1231	*detect = sub () { $MODEL };
		1232
		1233	local $!; # for good measure
		1234	local $SIG{__DIE__};
		1235
		1236	if ($ENV{PERL_ANYEVENT_MODEL} =~ /^([a-zA-Z]+)$/) {
		1237	my $model = "AnyEvent::Impl::$1";
		1238	if (eval "require $model") {
		1239	$MODEL = $model;
		1240	warn "AnyEvent: loaded model '$model' (forced by \$ENV{PERL_ANYEVENT_MODEL}), using it.\n" if $VERBOSE >= 2;
		1241	} else {
		1242	warn "AnyEvent: unable to load model '$model' (from \$ENV{PERL_ANYEVENT_MODEL}):\n$@" if $VERBOSE;
		1243	}
		1244	}
		1245
		1246	# check for already loaded models
1245	unless ($MODEL) {	1247	unless ($MODEL) {
1246	local $SIG{__DIE__};	1248	for (@REGISTRY, @models) {
1247		1249	my ($package, $model) = @$_;
1248	if ($ENV{PERL_ANYEVENT_MODEL} =~ /^([a-zA-Z]+)$/) {	1250	if (${"$package\::VERSION"} > 0) {
1249	my $model = "AnyEvent::Impl::$1";
1250	if (eval "require $model") {	1251	if (eval "require $model") {
1251	$MODEL = $model;	1252	$MODEL = $model;
1252	warn "AnyEvent: loaded model '$model' (forced by \$ENV{PERL_ANYEVENT_MODEL}), using it.\n" if $VERBOSE >= 2;	1253	warn "AnyEvent: autodetected model '$model', using it.\n" if $VERBOSE >= 2;
1253	} else {	1254	last;
1254	warn "AnyEvent: unable to load model '$model' (from \$ENV{PERL_ANYEVENT_MODEL}):\n$@" if $VERBOSE;	1255	}
1255	}	1256	}
1256	}	1257	}
1257		1258
1258	# check for already loaded models
1259	unless ($MODEL) {	1259	unless ($MODEL) {
		1260	# try to autoload a model
1260	for (@REGISTRY, @models) {	1261	for (@REGISTRY, @models) {
1261	my ($package, $model) = @$_;	1262	my ($package, $model, $autoload) = @$_;
		1263	if (
		1264	$autoload
		1265	and eval "require $package"
1262	if (${"$package\::VERSION"} > 0) {	1266	and ${"$package\::VERSION"} > 0
1263	if (eval "require $model") {	1267	and eval "require $model"
		1268	) {
1264	$MODEL = $model;	1269	$MODEL = $model;
1265	warn "AnyEvent: autodetected model '$model', using it.\n" if $VERBOSE >= 2;	1270	warn "AnyEvent: autoloaded model '$model', using it.\n" if $VERBOSE >= 2;
1266	last;	1271	last;
1267	}
1268	}	1272	}
1269	}	1273	}
1270		1274
1271	unless ($MODEL) {
1272	# try to autoload a model
1273	for (@REGISTRY, @models) {
1274	my ($package, $model, $autoload) = @$_;
1275	if (
1276	$autoload
1277	and eval "require $package"
1278	and ${"$package\::VERSION"} > 0
1279	and eval "require $model"
1280	) {
1281	$MODEL = $model;
1282	warn "AnyEvent: autoloaded model '$model', using it.\n" if $VERBOSE >= 2;
1283	last;
1284	}
1285	}
1286
1287	$MODEL	1275	$MODEL
1288	or die "No event module selected for AnyEvent and autodetect failed. Install any one of these modules: EV, Event or Glib.\n";	1276	or die "No event module selected for AnyEvent and autodetect failed. Install any one of these modules: EV, Event or Glib.\n";
1289	}
1290	}	1277	}
1291
1292	push @{"$MODEL\::ISA"}, "AnyEvent::Base";
1293
1294	unshift @ISA, $MODEL;
1295
1296	require AnyEvent::Strict if $ENV{PERL_ANYEVENT_STRICT};
1297
1298	(shift @post_detect)->() while @post_detect;
1299	}	1278	}
		1279
		1280	@models = (); # free probe data
		1281
		1282	push @{"$MODEL\::ISA"}, "AnyEvent::Base";
		1283	unshift @ISA, $MODEL;
		1284
		1285	# now nuke some methods that are overriden by the backend.
		1286	# SUPER is not allowed.
		1287	for (qw(time signal child idle)) {
		1288	undef &{"AnyEvent::Base::$_"}
		1289	if defined &{"$MODEL\::$_"};
		1290	}
		1291
		1292	require AnyEvent::Strict if $ENV{PERL_ANYEVENT_STRICT};
		1293
		1294	(shift @post_detect)->() while @post_detect;
		1295
		1296	*post_detect = sub(&) {
		1297	shift->();
		1298
		1299	undef
		1300	};
1300		1301
1301	$MODEL	1302	$MODEL
1302	}	1303	}
1303		1304
1304	sub AUTOLOAD {	1305	sub AUTOLOAD {
1305	(my $func = $AUTOLOAD) =~ s/.*://;	1306	(my $func = $AUTOLOAD) =~ s/.*://;
1306		1307
1307	$method{$func}	1308	$method{$func}
1308	or Carp::croak "$func: not a valid method for AnyEvent objects";	1309	or Carp::croak "$func: not a valid AnyEvent class method";
1309		1310
1310	detect unless $MODEL;	1311	detect;
1311		1312
1312	my $class = shift;	1313	my $class = shift;
1313	$class->$func (@_);	1314	$class->$func (@_);
1314	}	1315	}
1315		1316
…		…
1332		1333
1333	=head1 SIMPLIFIED AE API	1334	=head1 SIMPLIFIED AE API
1334		1335
1335	Starting with version 5.0, AnyEvent officially supports a second, much	1336	Starting with version 5.0, AnyEvent officially supports a second, much
1336	simpler, API that is designed to reduce the calling, typing and memory	1337	simpler, API that is designed to reduce the calling, typing and memory
1337	overhead.	1338	overhead by using function call syntax and a fixed number of parameters.
1338		1339
1339	See the L<AE> manpage for details.	1340	See the L<AE> manpage for details.
1340		1341
1341	=cut	1342	=cut
1342		1343
1343	package AE;	1344	package AE;
1344		1345
1345	our $VERSION = $AnyEvent::VERSION;	1346	our $VERSION = $AnyEvent::VERSION;
		1347
		1348	# fall back to the main API by default - backends and AnyEvent::Base
		1349	# implementations can overwrite these.
1346		1350
1347	sub io($$$) {	1351	sub io($$$) {
1348	AnyEvent->io (fh => $_[0], poll => $_[1] ? "w" : "r", cb => $_[2])	1352	AnyEvent->io (fh => $_[0], poll => $_[1] ? "w" : "r", cb => $_[2])
1349	}	1353	}
1350		1354
…		…
1382		1386
1383	package AnyEvent::Base;	1387	package AnyEvent::Base;
1384		1388
1385	# default implementations for many methods	1389	# default implementations for many methods
1386		1390
1387	sub _time() {	1391	sub time {
		1392	eval q{ # poor man's autoloading {}
1388	# probe for availability of Time::HiRes	1393	# probe for availability of Time::HiRes
1389	if (eval "use Time::HiRes (); Time::HiRes::time (); 1") {	1394	if (eval "use Time::HiRes (); Time::HiRes::time (); 1") {
1390	warn "AnyEvent: using Time::HiRes for sub-second timing accuracy.\n" if $VERBOSE >= 8;	1395	warn "AnyEvent: using Time::HiRes for sub-second timing accuracy.\n" if $VERBOSE >= 8;
1391	*_time = \&Time::HiRes::time;	1396	*AE::time = \&Time::HiRes::time;
1392	# if (eval "use POSIX (); (POSIX::times())...	1397	# if (eval "use POSIX (); (POSIX::times())...
1393	} else {	1398	} else {
1394	warn "AnyEvent: using built-in time(), WARNING, no sub-second resolution!\n" if $VERBOSE;	1399	warn "AnyEvent: using built-in time(), WARNING, no sub-second resolution!\n" if $VERBOSE;
1395	*_time = sub (){ time }; # epic fail	1400	*AE::time = sub (){ time }; # epic fail
		1401	}
		1402
		1403	*time = sub { AE::time }; # different prototypes
1396	}	1404	};
		1405	die if $@;
1397		1406
1398	&_time	1407	&time
1399	}	1408	}
1400		1409
1401	sub time { _time }	1410	*now = \&time;
1402	sub now { _time }	1411
1403	sub now_update { }	1412	sub now_update { }
1404		1413
1405	# default implementation for ->condvar	1414	# default implementation for ->condvar
1406		1415
1407	sub condvar {	1416	sub condvar {
		1417	eval q{ # poor man's autoloading {}
		1418	*condvar = sub {
1408	bless { @_ == 3 ? (_ae_cb => $_[2]) : () }, "AnyEvent::CondVar"	1419	bless { @_ == 3 ? (_ae_cb => $_[2]) : () }, "AnyEvent::CondVar"
		1420	};
		1421
		1422	*AE::cv = sub (;&) {
		1423	bless { @_ ? (_ae_cb => shift) : () }, "AnyEvent::CondVar"
		1424	};
		1425	};
		1426	die if $@;
		1427
		1428	&condvar
1409	}	1429	}
1410		1430
1411	# default implementation for ->signal	1431	# default implementation for ->signal
1412		1432
1413	our $HAVE_ASYNC_INTERRUPT;	1433	our $HAVE_ASYNC_INTERRUPT;
…		…
1422		1442
1423	our ($SIGPIPE_R, $SIGPIPE_W, %SIG_CB, %SIG_EV, $SIG_IO);	1443	our ($SIGPIPE_R, $SIGPIPE_W, %SIG_CB, %SIG_EV, $SIG_IO);
1424	our (%SIG_ASY, %SIG_ASY_W);	1444	our (%SIG_ASY, %SIG_ASY_W);
1425	our ($SIG_COUNT, $SIG_TW);	1445	our ($SIG_COUNT, $SIG_TW);
1426		1446
1427	sub _signal_exec {
1428	$HAVE_ASYNC_INTERRUPT
1429	? $SIGPIPE_R->drain
1430	: sysread $SIGPIPE_R, (my $dummy), 9;
1431
1432	while (%SIG_EV) {
1433	for (keys %SIG_EV) {
1434	delete $SIG_EV{$_};
1435	$_->() for values %{ $SIG_CB{$_} \|\| {} };
1436	}
1437	}
1438	}
1439
1440	# install a dummy wakeup watcher to reduce signal catching latency	1447	# install a dummy wakeup watcher to reduce signal catching latency
		1448	# used by Impls
1441	sub _sig_add() {	1449	sub _sig_add() {
1442	unless ($SIG_COUNT++) {	1450	unless ($SIG_COUNT++) {
1443	# try to align timer on a full-second boundary, if possible	1451	# try to align timer on a full-second boundary, if possible
1444	my $NOW = AE::now;	1452	my $NOW = AE::now;
1445		1453
…		…
1455	undef $SIG_TW	1463	undef $SIG_TW
1456	unless --$SIG_COUNT;	1464	unless --$SIG_COUNT;
1457	}	1465	}
1458		1466
1459	our $_sig_name_init; $_sig_name_init = sub {	1467	our $_sig_name_init; $_sig_name_init = sub {
1460	eval q{ # poor man's autoloading	1468	eval q{ # poor man's autoloading {}
1461	undef $_sig_name_init;	1469	undef $_sig_name_init;
1462		1470
1463	if (_have_async_interrupt) {	1471	if (_have_async_interrupt) {
1464	*sig2num = \&Async::Interrupt::sig2num;	1472	*sig2num = \&Async::Interrupt::sig2num;
1465	*sig2name = \&Async::Interrupt::sig2name;	1473	*sig2name = \&Async::Interrupt::sig2name;
…		…
1497	$SIG_IO = AE::io $SIGPIPE_R->fileno, 0, \&_signal_exec;	1505	$SIG_IO = AE::io $SIGPIPE_R->fileno, 0, \&_signal_exec;
1498		1506
1499	} else {	1507	} else {
1500	warn "AnyEvent: using emulated perl signal handling with latency timer.\n" if $VERBOSE >= 8;	1508	warn "AnyEvent: using emulated perl signal handling with latency timer.\n" if $VERBOSE >= 8;
1501		1509
1502	require Fcntl;
1503
1504	if (AnyEvent::WIN32) {	1510	if (AnyEvent::WIN32) {
1505	require AnyEvent::Util;	1511	require AnyEvent::Util;
1506		1512
1507	($SIGPIPE_R, $SIGPIPE_W) = AnyEvent::Util::portable_pipe ();	1513	($SIGPIPE_R, $SIGPIPE_W) = AnyEvent::Util::portable_pipe ();
1508	AnyEvent::Util::fh_nonblocking ($SIGPIPE_R, 1) if $SIGPIPE_R;	1514	AnyEvent::Util::fh_nonblocking ($SIGPIPE_R, 1) if $SIGPIPE_R;
1509	AnyEvent::Util::fh_nonblocking ($SIGPIPE_W, 1) if $SIGPIPE_W; # just in case	1515	AnyEvent::Util::fh_nonblocking ($SIGPIPE_W, 1) if $SIGPIPE_W; # just in case
1510	} else {	1516	} else {
1511	pipe $SIGPIPE_R, $SIGPIPE_W;	1517	pipe $SIGPIPE_R, $SIGPIPE_W;
1512	fcntl $SIGPIPE_R, &Fcntl::F_SETFL, &Fcntl::O_NONBLOCK if $SIGPIPE_R;	1518	fcntl $SIGPIPE_R, AnyEvent::F_SETFL, AnyEvent::O_NONBLOCK if $SIGPIPE_R;
1513	fcntl $SIGPIPE_W, &Fcntl::F_SETFL, &Fcntl::O_NONBLOCK if $SIGPIPE_W; # just in case	1519	fcntl $SIGPIPE_W, AnyEvent::F_SETFL, AnyEvent::O_NONBLOCK if $SIGPIPE_W; # just in case
1514		1520
1515	# not strictly required, as $^F is normally 2, but let's make sure...	1521	# not strictly required, as $^F is normally 2, but let's make sure...
1516	fcntl $SIGPIPE_R, &Fcntl::F_SETFD, &Fcntl::FD_CLOEXEC;	1522	fcntl $SIGPIPE_R, AnyEvent::F_SETFD, AnyEvent::FD_CLOEXEC;
1517	fcntl $SIGPIPE_W, &Fcntl::F_SETFD, &Fcntl::FD_CLOEXEC;	1523	fcntl $SIGPIPE_W, AnyEvent::F_SETFD, AnyEvent::FD_CLOEXEC;
1518	}	1524	}
1519		1525
1520	$SIGPIPE_R	1526	$SIGPIPE_R
1521	or Carp::croak "AnyEvent: unable to create a signal reporting pipe: $!\n";	1527	or Carp::croak "AnyEvent: unable to create a signal reporting pipe: $!\n";
1522		1528
1523	$SIG_IO = AE::io $SIGPIPE_R, 0, \&_signal_exec;	1529	$SIG_IO = AE::io $SIGPIPE_R, 0, \&_signal_exec;
1524	}	1530	}
1525		1531
1526	*signal = sub {	1532	*signal = $HAVE_ASYNC_INTERRUPT
		1533	? sub {
1527	my (undef, %arg) = @_;	1534	my (undef, %arg) = @_;
1528		1535
1529	my $signal = uc $arg{signal}
1530	or Carp::croak "required option 'signal' is missing";
1531
1532	if ($HAVE_ASYNC_INTERRUPT) {
1533	# async::interrupt	1536	# async::interrupt
1534
1535	$signal = sig2num $signal;	1537	my $signal = sig2num $arg{signal};
1536	$SIG_CB{$signal}{$arg{cb}} = $arg{cb};	1538	$SIG_CB{$signal}{$arg{cb}} = $arg{cb};
1537		1539
1538	$SIG_ASY{$signal} \|\|= new Async::Interrupt	1540	$SIG_ASY{$signal} \|\|= new Async::Interrupt
1539	cb => sub { undef $SIG_EV{$signal} },	1541	cb => sub { undef $SIG_EV{$signal} },
1540	signal => $signal,	1542	signal => $signal,
1541	pipe => [$SIGPIPE_R->filenos],	1543	pipe => [$SIGPIPE_R->filenos],
1542	pipe_autodrain => 0,	1544	pipe_autodrain => 0,
1543	;	1545	;
1544		1546
1545	} else {	1547	bless [$signal, $arg{cb}], "AnyEvent::Base::signal"
		1548	}
		1549	: sub {
		1550	my (undef, %arg) = @_;
		1551
1546	# pure perl	1552	# pure perl
1547
1548	# AE::Util has been loaded in signal
1549	$signal = sig2name $signal;	1553	my $signal = sig2name $arg{signal};
1550	$SIG_CB{$signal}{$arg{cb}} = $arg{cb};	1554	$SIG_CB{$signal}{$arg{cb}} = $arg{cb};
1551		1555
1552	$SIG{$signal} \|\|= sub {	1556	$SIG{$signal} \|\|= sub {
1553	local $!;	1557	local $!;
1554	syswrite $SIGPIPE_W, "\x00", 1 unless %SIG_EV;	1558	syswrite $SIGPIPE_W, "\x00", 1 unless %SIG_EV;
1555	undef $SIG_EV{$signal};	1559	undef $SIG_EV{$signal};
1556	};	1560	};
1557		1561
1558	# can't do signal processing without introducing races in pure perl,	1562	# can't do signal processing without introducing races in pure perl,
1559	# so limit the signal latency.	1563	# so limit the signal latency.
1560	_sig_add;	1564	_sig_add;
1561	}
1562		1565
1563	bless [$signal, $arg{cb}], "AnyEvent::Base::signal"	1566	bless [$signal, $arg{cb}], "AnyEvent::Base::signal"
		1567	}
1564	};	1568	;
1565		1569
1566	*AnyEvent::Base::signal::DESTROY = sub {	1570	*AnyEvent::Base::signal::DESTROY = sub {
1567	my ($signal, $cb) = @{$_[0]};	1571	my ($signal, $cb) = @{$_[0]};
1568		1572
1569	_sig_del;	1573	_sig_del;
…		…
1576	# print weird messages, or just unconditionally exit	1580	# print weird messages, or just unconditionally exit
1577	# instead of getting the default action.	1581	# instead of getting the default action.
1578	undef $SIG{$signal}	1582	undef $SIG{$signal}
1579	unless keys %{ $SIG_CB{$signal} };	1583	unless keys %{ $SIG_CB{$signal} };
1580	};	1584	};
		1585
		1586	*_signal_exec = sub {
		1587	$HAVE_ASYNC_INTERRUPT
		1588	? $SIGPIPE_R->drain
		1589	: sysread $SIGPIPE_R, (my $dummy), 9;
		1590
		1591	while (%SIG_EV) {
		1592	for (keys %SIG_EV) {
		1593	delete $SIG_EV{$_};
		1594	$_->() for values %{ $SIG_CB{$_} \|\| {} };
		1595	}
		1596	}
		1597	};
1581	};	1598	};
1582	die if $@;	1599	die if $@;
		1600
1583	&signal	1601	&signal
1584	}	1602	}
1585		1603
1586	# default implementation for ->child	1604	# default implementation for ->child
1587		1605
1588	our %PID_CB;	1606	our %PID_CB;
1589	our $CHLD_W;	1607	our $CHLD_W;
1590	our $CHLD_DELAY_W;	1608	our $CHLD_DELAY_W;
1591	our $WNOHANG;	1609	our $WNOHANG;
1592		1610
		1611	# used by many Impl's
1593	sub _emit_childstatus($$) {	1612	sub _emit_childstatus($$) {
1594	my (undef, $rpid, $rstatus) = @_;	1613	my (undef, $rpid, $rstatus) = @_;
1595		1614
1596	$_->($rpid, $rstatus)	1615	$_->($rpid, $rstatus)
1597	for values %{ $PID_CB{$rpid} \|\| {} },	1616	for values %{ $PID_CB{$rpid} \|\| {} },
1598	values %{ $PID_CB{0} \|\| {} };	1617	values %{ $PID_CB{0} \|\| {} };
1599	}	1618	}
1600		1619
1601	sub _sigchld {
1602	my $pid;
1603
1604	AnyEvent->_emit_childstatus ($pid, $?)
1605	while ($pid = waitpid -1, $WNOHANG) > 0;
1606	}
1607
1608	sub child {	1620	sub child {
		1621	eval q{ # poor man's autoloading {}
		1622	*_sigchld = sub {
		1623	my $pid;
		1624
		1625	AnyEvent->_emit_childstatus ($pid, $?)
		1626	while ($pid = waitpid -1, $WNOHANG) > 0;
		1627	};
		1628
		1629	*child = sub {
1609	my (undef, %arg) = @_;	1630	my (undef, %arg) = @_;
1610		1631
1611	defined (my $pid = $arg{pid} + 0)	1632	defined (my $pid = $arg{pid} + 0)
1612	or Carp::croak "required option 'pid' is missing";	1633	or Carp::croak "required option 'pid' is missing";
1613		1634
1614	$PID_CB{$pid}{$arg{cb}} = $arg{cb};	1635	$PID_CB{$pid}{$arg{cb}} = $arg{cb};
1615		1636
1616	# WNOHANG is almost cetrainly 1 everywhere	1637	# WNOHANG is almost cetrainly 1 everywhere
1617	$WNOHANG \|\|= $^O =~ /^(?:openbsd\|netbsd\|linux\|freebsd\|cygwin\|MSWin32)$/	1638	$WNOHANG \|\|= $^O =~ /^(?:openbsd\|netbsd\|linux\|freebsd\|cygwin\|MSWin32)$/
1618	? 1	1639	? 1
1619	: eval { local $SIG{__DIE__}; require POSIX; &POSIX::WNOHANG } \|\| 1;	1640	: eval { local $SIG{__DIE__}; require POSIX; &POSIX::WNOHANG } \|\| 1;
1620		1641
1621	unless ($CHLD_W) {	1642	unless ($CHLD_W) {
1622	$CHLD_W = AE::signal CHLD => \&_sigchld;	1643	$CHLD_W = AE::signal CHLD => \&_sigchld;
1623	# child could be a zombie already, so make at least one round	1644	# child could be a zombie already, so make at least one round
1624	&_sigchld;	1645	&_sigchld;
1625	}	1646	}
1626		1647
1627	bless [$pid, $arg{cb}], "AnyEvent::Base::child"	1648	bless [$pid, $arg{cb}], "AnyEvent::Base::child"
1628	}	1649	};
1629		1650
1630	sub AnyEvent::Base::child::DESTROY {	1651	*AnyEvent::Base::child::DESTROY = sub {
1631	my ($pid, $cb) = @{$_[0]};	1652	my ($pid, $cb) = @{$_[0]};
1632		1653
1633	delete $PID_CB{$pid}{$cb};	1654	delete $PID_CB{$pid}{$cb};
1634	delete $PID_CB{$pid} unless keys %{ $PID_CB{$pid} };	1655	delete $PID_CB{$pid} unless keys %{ $PID_CB{$pid} };
1635		1656
1636	undef $CHLD_W unless keys %PID_CB;	1657	undef $CHLD_W unless keys %PID_CB;
		1658	};
		1659	};
		1660	die if $@;
		1661
		1662	&child
1637	}	1663	}
1638		1664
1639	# idle emulation is done by simply using a timer, regardless	1665	# idle emulation is done by simply using a timer, regardless
1640	# of whether the process is idle or not, and not letting	1666	# of whether the process is idle or not, and not letting
1641	# the callback use more than 50% of the time.	1667	# the callback use more than 50% of the time.
1642	sub idle {	1668	sub idle {
		1669	eval q{ # poor man's autoloading {}
		1670	*idle = sub {
1643	my (undef, %arg) = @_;	1671	my (undef, %arg) = @_;
1644		1672
1645	my ($cb, $w, $rcb) = $arg{cb};	1673	my ($cb, $w, $rcb) = $arg{cb};
1646		1674
1647	$rcb = sub {	1675	$rcb = sub {
1648	if ($cb) {	1676	if ($cb) {
1649	$w = _time;	1677	$w = _time;
1650	&$cb;	1678	&$cb;
1651	$w = _time - $w;	1679	$w = _time - $w;
1652		1680
1653	# never use more then 50% of the time for the idle watcher,	1681	# never use more then 50% of the time for the idle watcher,
1654	# within some limits	1682	# within some limits
1655	$w = 0.0001 if $w < 0.0001;	1683	$w = 0.0001 if $w < 0.0001;
1656	$w = 5 if $w > 5;	1684	$w = 5 if $w > 5;
1657		1685
1658	$w = AE::timer $w, 0, $rcb;	1686	$w = AE::timer $w, 0, $rcb;
1659	} else {	1687	} else {
1660	# clean up...	1688	# clean up...
1661	undef $w;	1689	undef $w;
1662	undef $rcb;	1690	undef $rcb;
		1691	}
		1692	};
		1693
		1694	$w = AE::timer 0.05, 0, $rcb;
		1695
		1696	bless \\$cb, "AnyEvent::Base::idle"
1663	}	1697	};
		1698
		1699	*AnyEvent::Base::idle::DESTROY = sub {
		1700	undef $${$_[0]};
		1701	};
1664	};	1702	};
		1703	die if $@;
1665		1704
1666	$w = AE::timer 0.05, 0, $rcb;	1705	&idle
1667
1668	bless \\$cb, "AnyEvent::Base::idle"
1669	}
1670
1671	sub AnyEvent::Base::idle::DESTROY {
1672	undef $${$_[0]};
1673	}	1706	}
1674		1707
1675	package AnyEvent::CondVar;	1708	package AnyEvent::CondVar;
1676		1709
1677	our @ISA = AnyEvent::CondVar::Base::;	1710	our @ISA = AnyEvent::CondVar::Base::;
…		…
2036		2069
2037	The actual code goes further and collects all errors (C<die>s, exceptions)	2070	The actual code goes further and collects all errors (C<die>s, exceptions)
2038	that occurred during request processing. The C<result> method detects	2071	that occurred during request processing. The C<result> method detects
2039	whether an exception as thrown (it is stored inside the $txn object)	2072	whether an exception as thrown (it is stored inside the $txn object)
2040	and just throws the exception, which means connection errors and other	2073	and just throws the exception, which means connection errors and other
2041	problems get reported tot he code that tries to use the result, not in a	2074	problems get reported to the code that tries to use the result, not in a
2042	random callback.	2075	random callback.
2043		2076
2044	All of this enables the following usage styles:	2077	All of this enables the following usage styles:
2045		2078
2046	1. Blocking:	2079	1. Blocking:
…		…
2503	automatic timer adjustments even when no monotonic clock is available,	2536	automatic timer adjustments even when no monotonic clock is available,
2504	can take avdantage of advanced kernel interfaces such as C<epoll> and	2537	can take avdantage of advanced kernel interfaces such as C<epoll> and
2505	C<kqueue>, and is the fastest backend I<by far>. You can even embed	2538	C<kqueue>, and is the fastest backend I<by far>. You can even embed
2506	L<Glib>/L<Gtk2> in it (or vice versa, see L<EV::Glib> and L<Glib::EV>).	2539	L<Glib>/L<Gtk2> in it (or vice versa, see L<EV::Glib> and L<Glib::EV>).
2507		2540
		2541	If you only use backends that rely on another event loop (e.g. C<Tk>),
		2542	then this module will do nothing for you.
		2543
2508	=item L<Guard>	2544	=item L<Guard>
2509		2545
2510	The guard module, when used, will be used to implement	2546	The guard module, when used, will be used to implement
2511	C<AnyEvent::Util::guard>. This speeds up guards considerably (and uses a	2547	C<AnyEvent::Util::guard>. This speeds up guards considerably (and uses a
2512	lot less memory), but otherwise doesn't affect guard operation much. It is	2548	lot less memory), but otherwise doesn't affect guard operation much. It is
2513	purely used for performance.	2549	purely used for performance.
2514		2550
2515	=item L<JSON> and L<JSON::XS>	2551	=item L<JSON> and L<JSON::XS>
2516		2552
2517	One of these modules is required when you want to read or write JSON data	2553	One of these modules is required when you want to read or write JSON data
2518	via L<AnyEvent::Handle>. It is also written in pure-perl, but can take	2554	via L<AnyEvent::Handle>. L<JSON> is also written in pure-perl, but can take
2519	advantage of the ultra-high-speed L<JSON::XS> module when it is installed.	2555	advantage of the ultra-high-speed L<JSON::XS> module when it is installed.
2520
2521	In fact, L<AnyEvent::Handle> will use L<JSON::XS> by default if it is
2522	installed.
2523		2556
2524	=item L<Net::SSLeay>	2557	=item L<Net::SSLeay>
2525		2558
2526	Implementing TLS/SSL in Perl is certainly interesting, but not very	2559	Implementing TLS/SSL in Perl is certainly interesting, but not very
2527	worthwhile: If this module is installed, then L<AnyEvent::Handle> (with	2560	worthwhile: If this module is installed, then L<AnyEvent::Handle> (with

Diff Legend

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

Comparing AnyEvent/lib/AnyEvent.pm (file contents): Revision 1.311 by root, Wed Feb 10 13:33:44 2010 UTC vs. Revision 1.325 by root, Thu May 20 23:56:04 2010 UTC

Diff Legend

Comparing AnyEvent/lib/AnyEvent.pm (file contents):
Revision 1.311 by root, Wed Feb 10 13:33:44 2010 UTC vs.
Revision 1.325 by root, Thu May 20 23:56:04 2010 UTC