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

Comparing AnyEvent/lib/AnyEvent.pm (file contents):
Revision 1.309 by root, Sat Dec 26 08:59:35 2009 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.23';	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 WIN32(){ " . (($^O =~ /mswin32/i)*1) ." }";	1163	require "AnyEvent/constants.pl";
		1164
1173	eval "sub TAINT(){ " . (${^TAINT}*1) . " }";	1165	eval "sub TAINT (){" . (${^TAINT}*1) . "}";
1174		1166
1175	delete @ENV{grep /^PERL_ANYEVENT_/, keys %ENV}	1167	delete @ENV{grep /^PERL_ANYEVENT_/, keys %ENV}
1176	if ${^TAINT};	1168	if ${^TAINT};
1177		1169
1178	$VERBOSE = $ENV{PERL_ANYEVENT_VERBOSE}*1;	1170	$VERBOSE = $ENV{PERL_ANYEVENT_VERBOSE}*1;
…		…
1221	our @post_detect;	1213	our @post_detect;
1222		1214
1223	sub post_detect(&) {	1215	sub post_detect(&) {
1224	my ($cb) = @_;	1216	my ($cb) = @_;
1225		1217
1226	if ($MODEL) {
1227	$cb->();
1228
1229	undef
1230	} else {
1231	push @post_detect, $cb;	1218	push @post_detect, $cb;
1232		1219
1233	defined wantarray	1220	defined wantarray
1234	? bless \$cb, "AnyEvent::Util::postdetect"	1221	? bless \$cb, "AnyEvent::Util::postdetect"
1235	: ()	1222	: ()
1236	}
1237	}	1223	}
1238		1224
1239	sub AnyEvent::Util::postdetect::DESTROY {	1225	sub AnyEvent::Util::postdetect::DESTROY {
1240	@post_detect = grep $_ != ${$_[0]}, @post_detect;	1226	@post_detect = grep $_ != ${$_[0]}, @post_detect;
1241	}	1227	}
1242		1228
1243	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
1244	unless ($MODEL) {	1247	unless ($MODEL) {
1245	local $SIG{__DIE__};	1248	for (@REGISTRY, @models) {
1246		1249	my ($package, $model) = @$_;
1247	if ($ENV{PERL_ANYEVENT_MODEL} =~ /^([a-zA-Z]+)$/) {	1250	if (${"$package\::VERSION"} > 0) {
1248	my $model = "AnyEvent::Impl::$1";
1249	if (eval "require $model") {	1251	if (eval "require $model") {
1250	$MODEL = $model;	1252	$MODEL = $model;
1251	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;
1252	} else {	1254	last;
1253	warn "AnyEvent: unable to load model '$model' (from \$ENV{PERL_ANYEVENT_MODEL}):\n$@" if $VERBOSE;	1255	}
1254	}	1256	}
1255	}	1257	}
1256		1258
1257	# check for already loaded models
1258	unless ($MODEL) {	1259	unless ($MODEL) {
		1260	# try to autoload a model
1259	for (@REGISTRY, @models) {	1261	for (@REGISTRY, @models) {
1260	my ($package, $model) = @$_;	1262	my ($package, $model, $autoload) = @$_;
		1263	if (
		1264	$autoload
		1265	and eval "require $package"
1261	if (${"$package\::VERSION"} > 0) {	1266	and ${"$package\::VERSION"} > 0
1262	if (eval "require $model") {	1267	and eval "require $model"
		1268	) {
1263	$MODEL = $model;	1269	$MODEL = $model;
1264	warn "AnyEvent: autodetected model '$model', using it.\n" if $VERBOSE >= 2;	1270	warn "AnyEvent: autoloaded model '$model', using it.\n" if $VERBOSE >= 2;
1265	last;	1271	last;
1266	}
1267	}	1272	}
1268	}	1273	}
1269		1274
1270	unless ($MODEL) {
1271	# try to autoload a model
1272	for (@REGISTRY, @models) {
1273	my ($package, $model, $autoload) = @$_;
1274	if (
1275	$autoload
1276	and eval "require $package"
1277	and ${"$package\::VERSION"} > 0
1278	and eval "require $model"
1279	) {
1280	$MODEL = $model;
1281	warn "AnyEvent: autoloaded model '$model', using it.\n" if $VERBOSE >= 2;
1282	last;
1283	}
1284	}
1285
1286	$MODEL	1275	$MODEL
1287	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";
1288	}
1289	}	1277	}
1290
1291	push @{"$MODEL\::ISA"}, "AnyEvent::Base";
1292
1293	unshift @ISA, $MODEL;
1294
1295	require AnyEvent::Strict if $ENV{PERL_ANYEVENT_STRICT};
1296
1297	(shift @post_detect)->() while @post_detect;
1298	}	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	};
1299		1301
1300	$MODEL	1302	$MODEL
1301	}	1303	}
1302		1304
1303	sub AUTOLOAD {	1305	sub AUTOLOAD {
1304	(my $func = $AUTOLOAD) =~ s/.*://;	1306	(my $func = $AUTOLOAD) =~ s/.*://;
1305		1307
1306	$method{$func}	1308	$method{$func}
1307	or Carp::croak "$func: not a valid method for AnyEvent objects";	1309	or Carp::croak "$func: not a valid AnyEvent class method";
1308		1310
1309	detect unless $MODEL;	1311	detect;
1310		1312
1311	my $class = shift;	1313	my $class = shift;
1312	$class->$func (@_);	1314	$class->$func (@_);
1313	}	1315	}
1314		1316
…		…
1331		1333
1332	=head1 SIMPLIFIED AE API	1334	=head1 SIMPLIFIED AE API
1333		1335
1334	Starting with version 5.0, AnyEvent officially supports a second, much	1336	Starting with version 5.0, AnyEvent officially supports a second, much
1335	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
1336	overhead.	1338	overhead by using function call syntax and a fixed number of parameters.
1337		1339
1338	See the L<AE> manpage for details.	1340	See the L<AE> manpage for details.
1339		1341
1340	=cut	1342	=cut
1341		1343
1342	package AE;	1344	package AE;
1343		1345
1344	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.
1345		1350
1346	sub io($$$) {	1351	sub io($$$) {
1347	AnyEvent->io (fh => $_[0], poll => $_[1] ? "w" : "r", cb => $_[2])	1352	AnyEvent->io (fh => $_[0], poll => $_[1] ? "w" : "r", cb => $_[2])
1348	}	1353	}
1349		1354
…		…
1381		1386
1382	package AnyEvent::Base;	1387	package AnyEvent::Base;
1383		1388
1384	# default implementations for many methods	1389	# default implementations for many methods
1385		1390
1386	sub _time() {	1391	sub time {
		1392	eval q{ # poor man's autoloading {}
1387	# probe for availability of Time::HiRes	1393	# probe for availability of Time::HiRes
1388	if (eval "use Time::HiRes (); Time::HiRes::time (); 1") {	1394	if (eval "use Time::HiRes (); Time::HiRes::time (); 1") {
1389	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;
1390	*_time = \&Time::HiRes::time;	1396	*AE::time = \&Time::HiRes::time;
1391	# if (eval "use POSIX (); (POSIX::times())...	1397	# if (eval "use POSIX (); (POSIX::times())...
1392	} else {	1398	} else {
1393	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;
1394	*_time = sub { time }; # epic fail	1400	*AE::time = sub (){ time }; # epic fail
		1401	}
		1402
		1403	*time = sub { AE::time }; # different prototypes
1395	}	1404	};
		1405	die if $@;
1396		1406
1397	&_time	1407	&time
1398	}	1408	}
1399		1409
1400	sub time { _time }	1410	*now = \&time;
1401	sub now { _time }	1411
1402	sub now_update { }	1412	sub now_update { }
1403		1413
1404	# default implementation for ->condvar	1414	# default implementation for ->condvar
1405		1415
1406	sub condvar {	1416	sub condvar {
		1417	eval q{ # poor man's autoloading {}
		1418	*condvar = sub {
1407	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
1408	}	1429	}
1409		1430
1410	# default implementation for ->signal	1431	# default implementation for ->signal
1411		1432
1412	our $HAVE_ASYNC_INTERRUPT;	1433	our $HAVE_ASYNC_INTERRUPT;
…		…
1421		1442
1422	our ($SIGPIPE_R, $SIGPIPE_W, %SIG_CB, %SIG_EV, $SIG_IO);	1443	our ($SIGPIPE_R, $SIGPIPE_W, %SIG_CB, %SIG_EV, $SIG_IO);
1423	our (%SIG_ASY, %SIG_ASY_W);	1444	our (%SIG_ASY, %SIG_ASY_W);
1424	our ($SIG_COUNT, $SIG_TW);	1445	our ($SIG_COUNT, $SIG_TW);
1425		1446
1426	sub _signal_exec {
1427	$HAVE_ASYNC_INTERRUPT
1428	? $SIGPIPE_R->drain
1429	: sysread $SIGPIPE_R, (my $dummy), 9;
1430
1431	while (%SIG_EV) {
1432	for (keys %SIG_EV) {
1433	delete $SIG_EV{$_};
1434	$_->() for values %{ $SIG_CB{$_} \|\| {} };
1435	}
1436	}
1437	}
1438
1439	# 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
1440	sub _sig_add() {	1449	sub _sig_add() {
1441	unless ($SIG_COUNT++) {	1450	unless ($SIG_COUNT++) {
1442	# try to align timer on a full-second boundary, if possible	1451	# try to align timer on a full-second boundary, if possible
1443	my $NOW = AE::now;	1452	my $NOW = AE::now;
1444		1453
…		…
1454	undef $SIG_TW	1463	undef $SIG_TW
1455	unless --$SIG_COUNT;	1464	unless --$SIG_COUNT;
1456	}	1465	}
1457		1466
1458	our $_sig_name_init; $_sig_name_init = sub {	1467	our $_sig_name_init; $_sig_name_init = sub {
1459	eval q{ # poor man's autoloading	1468	eval q{ # poor man's autoloading {}
1460	undef $_sig_name_init;	1469	undef $_sig_name_init;
1461		1470
1462	if (_have_async_interrupt) {	1471	if (_have_async_interrupt) {
1463	*sig2num = \&Async::Interrupt::sig2num;	1472	*sig2num = \&Async::Interrupt::sig2num;
1464	*sig2name = \&Async::Interrupt::sig2name;	1473	*sig2name = \&Async::Interrupt::sig2name;
…		…
1496	$SIG_IO = AE::io $SIGPIPE_R->fileno, 0, \&_signal_exec;	1505	$SIG_IO = AE::io $SIGPIPE_R->fileno, 0, \&_signal_exec;
1497		1506
1498	} else {	1507	} else {
1499	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;
1500		1509
1501	require Fcntl;
1502
1503	if (AnyEvent::WIN32) {	1510	if (AnyEvent::WIN32) {
1504	require AnyEvent::Util;	1511	require AnyEvent::Util;
1505		1512
1506	($SIGPIPE_R, $SIGPIPE_W) = AnyEvent::Util::portable_pipe ();	1513	($SIGPIPE_R, $SIGPIPE_W) = AnyEvent::Util::portable_pipe ();
1507	AnyEvent::Util::fh_nonblocking ($SIGPIPE_R, 1) if $SIGPIPE_R;	1514	AnyEvent::Util::fh_nonblocking ($SIGPIPE_R, 1) if $SIGPIPE_R;
1508	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
1509	} else {	1516	} else {
1510	pipe $SIGPIPE_R, $SIGPIPE_W;	1517	pipe $SIGPIPE_R, $SIGPIPE_W;
1511	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;
1512	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
1513		1520
1514	# 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...
1515	fcntl $SIGPIPE_R, &Fcntl::F_SETFD, &Fcntl::FD_CLOEXEC;	1522	fcntl $SIGPIPE_R, AnyEvent::F_SETFD, AnyEvent::FD_CLOEXEC;
1516	fcntl $SIGPIPE_W, &Fcntl::F_SETFD, &Fcntl::FD_CLOEXEC;	1523	fcntl $SIGPIPE_W, AnyEvent::F_SETFD, AnyEvent::FD_CLOEXEC;
1517	}	1524	}
1518		1525
1519	$SIGPIPE_R	1526	$SIGPIPE_R
1520	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";
1521		1528
1522	$SIG_IO = AE::io $SIGPIPE_R, 0, \&_signal_exec;	1529	$SIG_IO = AE::io $SIGPIPE_R, 0, \&_signal_exec;
1523	}	1530	}
1524		1531
1525	*signal = sub {	1532	*signal = $HAVE_ASYNC_INTERRUPT
		1533	? sub {
1526	my (undef, %arg) = @_;	1534	my (undef, %arg) = @_;
1527		1535
1528	my $signal = uc $arg{signal}
1529	or Carp::croak "required option 'signal' is missing";
1530
1531	if ($HAVE_ASYNC_INTERRUPT) {
1532	# async::interrupt	1536	# async::interrupt
1533
1534	$signal = sig2num $signal;	1537	my $signal = sig2num $arg{signal};
1535	$SIG_CB{$signal}{$arg{cb}} = $arg{cb};	1538	$SIG_CB{$signal}{$arg{cb}} = $arg{cb};
1536		1539
1537	$SIG_ASY{$signal} \|\|= new Async::Interrupt	1540	$SIG_ASY{$signal} \|\|= new Async::Interrupt
1538	cb => sub { undef $SIG_EV{$signal} },	1541	cb => sub { undef $SIG_EV{$signal} },
1539	signal => $signal,	1542	signal => $signal,
1540	pipe => [$SIGPIPE_R->filenos],	1543	pipe => [$SIGPIPE_R->filenos],
1541	pipe_autodrain => 0,	1544	pipe_autodrain => 0,
1542	;	1545	;
1543		1546
1544	} else {	1547	bless [$signal, $arg{cb}], "AnyEvent::Base::signal"
		1548	}
		1549	: sub {
		1550	my (undef, %arg) = @_;
		1551
1545	# pure perl	1552	# pure perl
1546
1547	# AE::Util has been loaded in signal
1548	$signal = sig2name $signal;	1553	my $signal = sig2name $arg{signal};
1549	$SIG_CB{$signal}{$arg{cb}} = $arg{cb};	1554	$SIG_CB{$signal}{$arg{cb}} = $arg{cb};
1550		1555
1551	$SIG{$signal} \|\|= sub {	1556	$SIG{$signal} \|\|= sub {
1552	local $!;	1557	local $!;
1553	syswrite $SIGPIPE_W, "\x00", 1 unless %SIG_EV;	1558	syswrite $SIGPIPE_W, "\x00", 1 unless %SIG_EV;
1554	undef $SIG_EV{$signal};	1559	undef $SIG_EV{$signal};
1555	};	1560	};
1556		1561
1557	# can't do signal processing without introducing races in pure perl,	1562	# can't do signal processing without introducing races in pure perl,
1558	# so limit the signal latency.	1563	# so limit the signal latency.
1559	_sig_add;	1564	_sig_add;
1560	}
1561		1565
1562	bless [$signal, $arg{cb}], "AnyEvent::Base::signal"	1566	bless [$signal, $arg{cb}], "AnyEvent::Base::signal"
		1567	}
1563	};	1568	;
1564		1569
1565	*AnyEvent::Base::signal::DESTROY = sub {	1570	*AnyEvent::Base::signal::DESTROY = sub {
1566	my ($signal, $cb) = @{$_[0]};	1571	my ($signal, $cb) = @{$_[0]};
1567		1572
1568	_sig_del;	1573	_sig_del;
…		…
1575	# print weird messages, or just unconditionally exit	1580	# print weird messages, or just unconditionally exit
1576	# instead of getting the default action.	1581	# instead of getting the default action.
1577	undef $SIG{$signal}	1582	undef $SIG{$signal}
1578	unless keys %{ $SIG_CB{$signal} };	1583	unless keys %{ $SIG_CB{$signal} };
1579	};	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	};
1580	};	1598	};
1581	die if $@;	1599	die if $@;
		1600
1582	&signal	1601	&signal
1583	}	1602	}
1584		1603
1585	# default implementation for ->child	1604	# default implementation for ->child
1586		1605
1587	our %PID_CB;	1606	our %PID_CB;
1588	our $CHLD_W;	1607	our $CHLD_W;
1589	our $CHLD_DELAY_W;	1608	our $CHLD_DELAY_W;
1590	our $WNOHANG;	1609	our $WNOHANG;
1591		1610
		1611	# used by many Impl's
1592	sub _emit_childstatus($$) {	1612	sub _emit_childstatus($$) {
1593	my (undef, $rpid, $rstatus) = @_;	1613	my (undef, $rpid, $rstatus) = @_;
1594		1614
1595	$_->($rpid, $rstatus)	1615	$_->($rpid, $rstatus)
1596	for values %{ $PID_CB{$rpid} \|\| {} },	1616	for values %{ $PID_CB{$rpid} \|\| {} },
1597	values %{ $PID_CB{0} \|\| {} };	1617	values %{ $PID_CB{0} \|\| {} };
1598	}	1618	}
1599		1619
1600	sub _sigchld {
1601	my $pid;
1602
1603	AnyEvent->_emit_childstatus ($pid, $?)
1604	while ($pid = waitpid -1, $WNOHANG) > 0;
1605	}
1606
1607	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 {
1608	my (undef, %arg) = @_;	1630	my (undef, %arg) = @_;
1609		1631
1610	defined (my $pid = $arg{pid} + 0)	1632	defined (my $pid = $arg{pid} + 0)
1611	or Carp::croak "required option 'pid' is missing";	1633	or Carp::croak "required option 'pid' is missing";
1612		1634
1613	$PID_CB{$pid}{$arg{cb}} = $arg{cb};	1635	$PID_CB{$pid}{$arg{cb}} = $arg{cb};
1614		1636
1615	# WNOHANG is almost cetrainly 1 everywhere	1637	# WNOHANG is almost cetrainly 1 everywhere
1616	$WNOHANG \|\|= $^O =~ /^(?:openbsd\|netbsd\|linux\|freebsd\|cygwin\|MSWin32)$/	1638	$WNOHANG \|\|= $^O =~ /^(?:openbsd\|netbsd\|linux\|freebsd\|cygwin\|MSWin32)$/
1617	? 1	1639	? 1
1618	: eval { local $SIG{__DIE__}; require POSIX; &POSIX::WNOHANG } \|\| 1;	1640	: eval { local $SIG{__DIE__}; require POSIX; &POSIX::WNOHANG } \|\| 1;
1619		1641
1620	unless ($CHLD_W) {	1642	unless ($CHLD_W) {
1621	$CHLD_W = AE::signal CHLD => \&_sigchld;	1643	$CHLD_W = AE::signal CHLD => \&_sigchld;
1622	# 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
1623	&_sigchld;	1645	&_sigchld;
1624	}	1646	}
1625		1647
1626	bless [$pid, $arg{cb}], "AnyEvent::Base::child"	1648	bless [$pid, $arg{cb}], "AnyEvent::Base::child"
1627	}	1649	};
1628		1650
1629	sub AnyEvent::Base::child::DESTROY {	1651	*AnyEvent::Base::child::DESTROY = sub {
1630	my ($pid, $cb) = @{$_[0]};	1652	my ($pid, $cb) = @{$_[0]};
1631		1653
1632	delete $PID_CB{$pid}{$cb};	1654	delete $PID_CB{$pid}{$cb};
1633	delete $PID_CB{$pid} unless keys %{ $PID_CB{$pid} };	1655	delete $PID_CB{$pid} unless keys %{ $PID_CB{$pid} };
1634		1656
1635	undef $CHLD_W unless keys %PID_CB;	1657	undef $CHLD_W unless keys %PID_CB;
		1658	};
		1659	};
		1660	die if $@;
		1661
		1662	&child
1636	}	1663	}
1637		1664
1638	# idle emulation is done by simply using a timer, regardless	1665	# idle emulation is done by simply using a timer, regardless
1639	# of whether the process is idle or not, and not letting	1666	# of whether the process is idle or not, and not letting
1640	# the callback use more than 50% of the time.	1667	# the callback use more than 50% of the time.
1641	sub idle {	1668	sub idle {
		1669	eval q{ # poor man's autoloading {}
		1670	*idle = sub {
1642	my (undef, %arg) = @_;	1671	my (undef, %arg) = @_;
1643		1672
1644	my ($cb, $w, $rcb) = $arg{cb};	1673	my ($cb, $w, $rcb) = $arg{cb};
1645		1674
1646	$rcb = sub {	1675	$rcb = sub {
1647	if ($cb) {	1676	if ($cb) {
1648	$w = _time;	1677	$w = _time;
1649	&$cb;	1678	&$cb;
1650	$w = _time - $w;	1679	$w = _time - $w;
1651		1680
1652	# 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,
1653	# within some limits	1682	# within some limits
1654	$w = 0.0001 if $w < 0.0001;	1683	$w = 0.0001 if $w < 0.0001;
1655	$w = 5 if $w > 5;	1684	$w = 5 if $w > 5;
1656		1685
1657	$w = AE::timer $w, 0, $rcb;	1686	$w = AE::timer $w, 0, $rcb;
1658	} else {	1687	} else {
1659	# clean up...	1688	# clean up...
1660	undef $w;	1689	undef $w;
1661	undef $rcb;	1690	undef $rcb;
		1691	}
		1692	};
		1693
		1694	$w = AE::timer 0.05, 0, $rcb;
		1695
		1696	bless \\$cb, "AnyEvent::Base::idle"
1662	}	1697	};
		1698
		1699	*AnyEvent::Base::idle::DESTROY = sub {
		1700	undef $${$_[0]};
		1701	};
1663	};	1702	};
		1703	die if $@;
1664		1704
1665	$w = AE::timer 0.05, 0, $rcb;	1705	&idle
1666
1667	bless \\$cb, "AnyEvent::Base::idle"
1668	}
1669
1670	sub AnyEvent::Base::idle::DESTROY {
1671	undef $${$_[0]};
1672	}	1706	}
1673		1707
1674	package AnyEvent::CondVar;	1708	package AnyEvent::CondVar;
1675		1709
1676	our @ISA = AnyEvent::CondVar::Base::;	1710	our @ISA = AnyEvent::CondVar::Base::;
…		…
2035		2069
2036	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)
2037	that occurred during request processing. The C<result> method detects	2071	that occurred during request processing. The C<result> method detects
2038	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)
2039	and just throws the exception, which means connection errors and other	2073	and just throws the exception, which means connection errors and other
2040	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
2041	random callback.	2075	random callback.
2042		2076
2043	All of this enables the following usage styles:	2077	All of this enables the following usage styles:
2044		2078
2045	1. Blocking:	2079	1. Blocking:
…		…
2502	automatic timer adjustments even when no monotonic clock is available,	2536	automatic timer adjustments even when no monotonic clock is available,
2503	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
2504	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
2505	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>).
2506		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
2507	=item L<Guard>	2544	=item L<Guard>
2508		2545
2509	The guard module, when used, will be used to implement	2546	The guard module, when used, will be used to implement
2510	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
2511	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
2512	purely used for performance.	2549	purely used for performance.
2513		2550
2514	=item L<JSON> and L<JSON::XS>	2551	=item L<JSON> and L<JSON::XS>
2515		2552
2516	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
2517	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
2518	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.
2519
2520	In fact, L<AnyEvent::Handle> will use L<JSON::XS> by default if it is
2521	installed.
2522		2556
2523	=item L<Net::SSLeay>	2557	=item L<Net::SSLeay>
2524		2558
2525	Implementing TLS/SSL in Perl is certainly interesting, but not very	2559	Implementing TLS/SSL in Perl is certainly interesting, but not very
2526	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.309 by root, Sat Dec 26 08:59:35 2009 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.309 by root, Sat Dec 26 08:59:35 2009 UTC vs.
Revision 1.325 by root, Thu May 20 23:56:04 2010 UTC