[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.316 by root, Mon Mar 15 18:51:30 2010 UTC

…		…
1156		1156
1157	BEGIN { AnyEvent::common_sense }	1157	BEGIN { AnyEvent::common_sense }
1158		1158
1159	use Carp ();	1159	use Carp ();
1160		1160
1161	our $VERSION = '5.24';	1161	our $VERSION = '5.251';
1162	our $MODEL;	1162	our $MODEL;
1163		1163
1164	our $AUTOLOAD;	1164	our $AUTOLOAD;
1165	our @ISA;	1165	our @ISA;
1166		1166
1167	our @REGISTRY;	1167	our @REGISTRY;
1168		1168
1169	our $VERBOSE;	1169	our $VERBOSE;
1170		1170
1171	BEGIN {	1171	BEGIN {
1172	eval "sub CYGWIN(){" . (($^O =~ /cygwin/i) *1) . "}";	1172	require "AnyEvent/constants.pl";
1173	eval "sub WIN32 (){" . (($^O =~ /mswin32/i)*1) . "}";	1173
1174	eval "sub TAINT (){" . (${^TAINT} *1) . "}";	1174	eval "sub TAINT (){" . (${^TAINT} *1) . "}";
1175		1175
1176	delete @ENV{grep /^PERL_ANYEVENT_/, keys %ENV}	1176	delete @ENV{grep /^PERL_ANYEVENT_/, keys %ENV}
1177	if ${^TAINT};	1177	if ${^TAINT};
1178		1178
…		…
1240	sub AnyEvent::Util::postdetect::DESTROY {	1240	sub AnyEvent::Util::postdetect::DESTROY {
1241	@post_detect = grep $_ != ${$_[0]}, @post_detect;	1241	@post_detect = grep $_ != ${$_[0]}, @post_detect;
1242	}	1242	}
1243		1243
1244	sub detect() {	1244	sub detect() {
		1245	# free some memory
		1246	*detect = sub () { $MODEL };
		1247
		1248	local $!; # for good measure
		1249	local $SIG{__DIE__};
		1250
		1251	if ($ENV{PERL_ANYEVENT_MODEL} =~ /^([a-zA-Z]+)$/) {
		1252	my $model = "AnyEvent::Impl::$1";
		1253	if (eval "require $model") {
		1254	$MODEL = $model;
		1255	warn "AnyEvent: loaded model '$model' (forced by \$ENV{PERL_ANYEVENT_MODEL}), using it.\n" if $VERBOSE >= 2;
		1256	} else {
		1257	warn "AnyEvent: unable to load model '$model' (from \$ENV{PERL_ANYEVENT_MODEL}):\n$@" if $VERBOSE;
		1258	}
		1259	}
		1260
		1261	# check for already loaded models
1245	unless ($MODEL) {	1262	unless ($MODEL) {
1246	local $SIG{__DIE__};	1263	for (@REGISTRY, @models) {
1247		1264	my ($package, $model) = @$_;
1248	if ($ENV{PERL_ANYEVENT_MODEL} =~ /^([a-zA-Z]+)$/) {	1265	if (${"$package\::VERSION"} > 0) {
1249	my $model = "AnyEvent::Impl::$1";
1250	if (eval "require $model") {	1266	if (eval "require $model") {
1251	$MODEL = $model;	1267	$MODEL = $model;
1252	warn "AnyEvent: loaded model '$model' (forced by \$ENV{PERL_ANYEVENT_MODEL}), using it.\n" if $VERBOSE >= 2;	1268	warn "AnyEvent: autodetected model '$model', using it.\n" if $VERBOSE >= 2;
1253	} else {	1269	last;
1254	warn "AnyEvent: unable to load model '$model' (from \$ENV{PERL_ANYEVENT_MODEL}):\n$@" if $VERBOSE;	1270	}
1255	}	1271	}
1256	}	1272	}
1257		1273
1258	# check for already loaded models
1259	unless ($MODEL) {	1274	unless ($MODEL) {
		1275	# try to autoload a model
1260	for (@REGISTRY, @models) {	1276	for (@REGISTRY, @models) {
1261	my ($package, $model) = @$_;	1277	my ($package, $model, $autoload) = @$_;
		1278	if (
		1279	$autoload
		1280	and eval "require $package"
1262	if (${"$package\::VERSION"} > 0) {	1281	and ${"$package\::VERSION"} > 0
1263	if (eval "require $model") {	1282	and eval "require $model"
		1283	) {
1264	$MODEL = $model;	1284	$MODEL = $model;
1265	warn "AnyEvent: autodetected model '$model', using it.\n" if $VERBOSE >= 2;	1285	warn "AnyEvent: autoloaded model '$model', using it.\n" if $VERBOSE >= 2;
1266	last;	1286	last;
1267	}
1268	}	1287	}
1269	}	1288	}
1270		1289
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	1290	$MODEL
1288	or die "No event module selected for AnyEvent and autodetect failed. Install any one of these modules: EV, Event or Glib.\n";	1291	or die "No event module selected for AnyEvent and autodetect failed. Install any one of these modules: EV, Event or Glib.\n";
1289	}
1290	}	1292	}
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	}	1293	}
		1294
		1295	@models = (); # free probe data
		1296
		1297	push @{"$MODEL\::ISA"}, "AnyEvent::Base";
		1298	unshift @ISA, $MODEL;
		1299
		1300	require AnyEvent::Strict if $ENV{PERL_ANYEVENT_STRICT};
		1301
		1302	(shift @post_detect)->() while @post_detect;
1300		1303
1301	$MODEL	1304	$MODEL
1302	}	1305	}
1303		1306
1304	sub AUTOLOAD {	1307	sub AUTOLOAD {
1305	(my $func = $AUTOLOAD) =~ s/.*://;	1308	(my $func = $AUTOLOAD) =~ s/.*://;
1306		1309
1307	$method{$func}	1310	$method{$func}
1308	or Carp::croak "$func: not a valid method for AnyEvent objects";	1311	or Carp::croak "$func: not a valid AnyEvent class method";
1309		1312
1310	detect unless $MODEL;	1313	detect;
1311		1314
1312	my $class = shift;	1315	my $class = shift;
1313	$class->$func (@_);	1316	$class->$func (@_);
1314	}	1317	}
1315		1318
…		…
1383	package AnyEvent::Base;	1386	package AnyEvent::Base;
1384		1387
1385	# default implementations for many methods	1388	# default implementations for many methods
1386		1389
1387	sub _time() {	1390	sub _time() {
		1391	eval q{ # poor man's autoloading
1388	# probe for availability of Time::HiRes	1392	# probe for availability of Time::HiRes
1389	if (eval "use Time::HiRes (); Time::HiRes::time (); 1") {	1393	if (eval "use Time::HiRes (); Time::HiRes::time (); 1") {
1390	warn "AnyEvent: using Time::HiRes for sub-second timing accuracy.\n" if $VERBOSE >= 8;	1394	warn "AnyEvent: using Time::HiRes for sub-second timing accuracy.\n" if $VERBOSE >= 8;
1391	*_time = \&Time::HiRes::time;	1395	*_time = \&Time::HiRes::time;
1392	# if (eval "use POSIX (); (POSIX::times())...	1396	# if (eval "use POSIX (); (POSIX::times())...
1393	} else {	1397	} else {
1394	warn "AnyEvent: using built-in time(), WARNING, no sub-second resolution!\n" if $VERBOSE;	1398	warn "AnyEvent: using built-in time(), WARNING, no sub-second resolution!\n" if $VERBOSE;
1395	*_time = sub (){ time }; # epic fail	1399	*_time = sub (){ time }; # epic fail
		1400	}
1396	}	1401	};
		1402	die if $@;
1397		1403
1398	&_time	1404	&_time
1399	}	1405	}
1400		1406
1401	sub time { _time }	1407	sub time { _time }
…		…
1422		1428
1423	our ($SIGPIPE_R, $SIGPIPE_W, %SIG_CB, %SIG_EV, $SIG_IO);	1429	our ($SIGPIPE_R, $SIGPIPE_W, %SIG_CB, %SIG_EV, $SIG_IO);
1424	our (%SIG_ASY, %SIG_ASY_W);	1430	our (%SIG_ASY, %SIG_ASY_W);
1425	our ($SIG_COUNT, $SIG_TW);	1431	our ($SIG_COUNT, $SIG_TW);
1426		1432
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	1433	# install a dummy wakeup watcher to reduce signal catching latency
		1434	# used by Impls
1441	sub _sig_add() {	1435	sub _sig_add() {
1442	unless ($SIG_COUNT++) {	1436	unless ($SIG_COUNT++) {
1443	# try to align timer on a full-second boundary, if possible	1437	# try to align timer on a full-second boundary, if possible
1444	my $NOW = AE::now;	1438	my $NOW = AE::now;
1445		1439
…		…
1497	$SIG_IO = AE::io $SIGPIPE_R->fileno, 0, \&_signal_exec;	1491	$SIG_IO = AE::io $SIGPIPE_R->fileno, 0, \&_signal_exec;
1498		1492
1499	} else {	1493	} else {
1500	warn "AnyEvent: using emulated perl signal handling with latency timer.\n" if $VERBOSE >= 8;	1494	warn "AnyEvent: using emulated perl signal handling with latency timer.\n" if $VERBOSE >= 8;
1501		1495
1502	require Fcntl;
1503
1504	if (AnyEvent::WIN32) {	1496	if (AnyEvent::WIN32) {
1505	require AnyEvent::Util;	1497	require AnyEvent::Util;
1506		1498
1507	($SIGPIPE_R, $SIGPIPE_W) = AnyEvent::Util::portable_pipe ();	1499	($SIGPIPE_R, $SIGPIPE_W) = AnyEvent::Util::portable_pipe ();
1508	AnyEvent::Util::fh_nonblocking ($SIGPIPE_R, 1) if $SIGPIPE_R;	1500	AnyEvent::Util::fh_nonblocking ($SIGPIPE_R, 1) if $SIGPIPE_R;
1509	AnyEvent::Util::fh_nonblocking ($SIGPIPE_W, 1) if $SIGPIPE_W; # just in case	1501	AnyEvent::Util::fh_nonblocking ($SIGPIPE_W, 1) if $SIGPIPE_W; # just in case
1510	} else {	1502	} else {
1511	pipe $SIGPIPE_R, $SIGPIPE_W;	1503	pipe $SIGPIPE_R, $SIGPIPE_W;
1512	fcntl $SIGPIPE_R, &Fcntl::F_SETFL, &Fcntl::O_NONBLOCK if $SIGPIPE_R;	1504	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	1505	fcntl $SIGPIPE_W, AnyEvent::F_SETFL, AnyEvent::O_NONBLOCK if $SIGPIPE_W; # just in case
1514		1506
1515	# not strictly required, as $^F is normally 2, but let's make sure...	1507	# not strictly required, as $^F is normally 2, but let's make sure...
1516	fcntl $SIGPIPE_R, &Fcntl::F_SETFD, &Fcntl::FD_CLOEXEC;	1508	fcntl $SIGPIPE_R, AnyEvent::F_SETFD, AnyEvent::FD_CLOEXEC;
1517	fcntl $SIGPIPE_W, &Fcntl::F_SETFD, &Fcntl::FD_CLOEXEC;	1509	fcntl $SIGPIPE_W, AnyEvent::F_SETFD, AnyEvent::FD_CLOEXEC;
1518	}	1510	}
1519		1511
1520	$SIGPIPE_R	1512	$SIGPIPE_R
1521	or Carp::croak "AnyEvent: unable to create a signal reporting pipe: $!\n";	1513	or Carp::croak "AnyEvent: unable to create a signal reporting pipe: $!\n";
1522		1514
…		…
1576	# print weird messages, or just unconditionally exit	1568	# print weird messages, or just unconditionally exit
1577	# instead of getting the default action.	1569	# instead of getting the default action.
1578	undef $SIG{$signal}	1570	undef $SIG{$signal}
1579	unless keys %{ $SIG_CB{$signal} };	1571	unless keys %{ $SIG_CB{$signal} };
1580	};	1572	};
		1573
		1574	*_signal_exec = sub {
		1575	$HAVE_ASYNC_INTERRUPT
		1576	? $SIGPIPE_R->drain
		1577	: sysread $SIGPIPE_R, (my $dummy), 9;
		1578
		1579	while (%SIG_EV) {
		1580	for (keys %SIG_EV) {
		1581	delete $SIG_EV{$_};
		1582	$_->() for values %{ $SIG_CB{$_} \|\| {} };
		1583	}
		1584	}
		1585	};
1581	};	1586	};
1582	die if $@;	1587	die if $@;
		1588
1583	&signal	1589	&signal
1584	}	1590	}
1585		1591
1586	# default implementation for ->child	1592	# default implementation for ->child
1587		1593
1588	our %PID_CB;	1594	our %PID_CB;
1589	our $CHLD_W;	1595	our $CHLD_W;
1590	our $CHLD_DELAY_W;	1596	our $CHLD_DELAY_W;
1591	our $WNOHANG;	1597	our $WNOHANG;
1592		1598
		1599	# used by many Impl's
1593	sub _emit_childstatus($$) {	1600	sub _emit_childstatus($$) {
1594	my (undef, $rpid, $rstatus) = @_;	1601	my (undef, $rpid, $rstatus) = @_;
1595		1602
1596	$_->($rpid, $rstatus)	1603	$_->($rpid, $rstatus)
1597	for values %{ $PID_CB{$rpid} \|\| {} },	1604	for values %{ $PID_CB{$rpid} \|\| {} },
1598	values %{ $PID_CB{0} \|\| {} };	1605	values %{ $PID_CB{0} \|\| {} };
1599	}	1606	}
1600		1607
1601	sub _sigchld {
1602	my $pid;
1603
1604	AnyEvent->_emit_childstatus ($pid, $?)
1605	while ($pid = waitpid -1, $WNOHANG) > 0;
1606	}
1607
1608	sub child {	1608	sub child {
		1609	eval q{ # poor man's autoloading {}
		1610	*_sigchld = sub {
		1611	my $pid;
		1612
		1613	AnyEvent->_emit_childstatus ($pid, $?)
		1614	while ($pid = waitpid -1, $WNOHANG) > 0;
		1615	};
		1616
		1617	*child = sub {
1609	my (undef, %arg) = @_;	1618	my (undef, %arg) = @_;
1610		1619
1611	defined (my $pid = $arg{pid} + 0)	1620	defined (my $pid = $arg{pid} + 0)
1612	or Carp::croak "required option 'pid' is missing";	1621	or Carp::croak "required option 'pid' is missing";
1613		1622
1614	$PID_CB{$pid}{$arg{cb}} = $arg{cb};	1623	$PID_CB{$pid}{$arg{cb}} = $arg{cb};
1615		1624
1616	# WNOHANG is almost cetrainly 1 everywhere	1625	# WNOHANG is almost cetrainly 1 everywhere
1617	$WNOHANG \|\|= $^O =~ /^(?:openbsd\|netbsd\|linux\|freebsd\|cygwin\|MSWin32)$/	1626	$WNOHANG \|\|= $^O =~ /^(?:openbsd\|netbsd\|linux\|freebsd\|cygwin\|MSWin32)$/
1618	? 1	1627	? 1
1619	: eval { local $SIG{__DIE__}; require POSIX; &POSIX::WNOHANG } \|\| 1;	1628	: eval { local $SIG{__DIE__}; require POSIX; &POSIX::WNOHANG } \|\| 1;
1620		1629
1621	unless ($CHLD_W) {	1630	unless ($CHLD_W) {
1622	$CHLD_W = AE::signal CHLD => \&_sigchld;	1631	$CHLD_W = AE::signal CHLD => \&_sigchld;
1623	# child could be a zombie already, so make at least one round	1632	# child could be a zombie already, so make at least one round
1624	&_sigchld;	1633	&_sigchld;
1625	}	1634	}
1626		1635
1627	bless [$pid, $arg{cb}], "AnyEvent::Base::child"	1636	bless [$pid, $arg{cb}], "AnyEvent::Base::child"
1628	}	1637	};
1629		1638
1630	sub AnyEvent::Base::child::DESTROY {	1639	*AnyEvent::Base::child::DESTROY = sub {
1631	my ($pid, $cb) = @{$_[0]};	1640	my ($pid, $cb) = @{$_[0]};
1632		1641
1633	delete $PID_CB{$pid}{$cb};	1642	delete $PID_CB{$pid}{$cb};
1634	delete $PID_CB{$pid} unless keys %{ $PID_CB{$pid} };	1643	delete $PID_CB{$pid} unless keys %{ $PID_CB{$pid} };
1635		1644
1636	undef $CHLD_W unless keys %PID_CB;	1645	undef $CHLD_W unless keys %PID_CB;
		1646	};
		1647	};
		1648	die if $@;
		1649
		1650	&child
1637	}	1651	}
1638		1652
1639	# idle emulation is done by simply using a timer, regardless	1653	# idle emulation is done by simply using a timer, regardless
1640	# of whether the process is idle or not, and not letting	1654	# of whether the process is idle or not, and not letting
1641	# the callback use more than 50% of the time.	1655	# the callback use more than 50% of the time.
1642	sub idle {	1656	sub idle {
		1657	eval q{ # poor man's autoloading {}
		1658	*idle = sub {
1643	my (undef, %arg) = @_;	1659	my (undef, %arg) = @_;
1644		1660
1645	my ($cb, $w, $rcb) = $arg{cb};	1661	my ($cb, $w, $rcb) = $arg{cb};
1646		1662
1647	$rcb = sub {	1663	$rcb = sub {
1648	if ($cb) {	1664	if ($cb) {
1649	$w = _time;	1665	$w = _time;
1650	&$cb;	1666	&$cb;
1651	$w = _time - $w;	1667	$w = _time - $w;
1652		1668
1653	# never use more then 50% of the time for the idle watcher,	1669	# never use more then 50% of the time for the idle watcher,
1654	# within some limits	1670	# within some limits
1655	$w = 0.0001 if $w < 0.0001;	1671	$w = 0.0001 if $w < 0.0001;
1656	$w = 5 if $w > 5;	1672	$w = 5 if $w > 5;
1657		1673
1658	$w = AE::timer $w, 0, $rcb;	1674	$w = AE::timer $w, 0, $rcb;
1659	} else {	1675	} else {
1660	# clean up...	1676	# clean up...
1661	undef $w;	1677	undef $w;
1662	undef $rcb;	1678	undef $rcb;
		1679	}
		1680	};
		1681
		1682	$w = AE::timer 0.05, 0, $rcb;
		1683
		1684	bless \\$cb, "AnyEvent::Base::idle"
1663	}	1685	};
		1686
		1687	*AnyEvent::Base::idle::DESTROY = sub {
		1688	undef $${$_[0]};
		1689	};
1664	};	1690	};
		1691	die if $@;
1665		1692
1666	$w = AE::timer 0.05, 0, $rcb;	1693	&idle
1667
1668	bless \\$cb, "AnyEvent::Base::idle"
1669	}
1670
1671	sub AnyEvent::Base::idle::DESTROY {
1672	undef $${$_[0]};
1673	}	1694	}
1674		1695
1675	package AnyEvent::CondVar;	1696	package AnyEvent::CondVar;
1676		1697
1677	our @ISA = AnyEvent::CondVar::Base::;	1698	our @ISA = AnyEvent::CondVar::Base::;
…		…
2503	automatic timer adjustments even when no monotonic clock is available,	2524	automatic timer adjustments even when no monotonic clock is available,
2504	can take avdantage of advanced kernel interfaces such as C<epoll> and	2525	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	2526	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>).	2527	L<Glib>/L<Gtk2> in it (or vice versa, see L<EV::Glib> and L<Glib::EV>).
2507		2528
		2529	If you only use backends that rely on another event loop (e.g. C<Tk>),
		2530	then this module will do nothing for you.
		2531
2508	=item L<Guard>	2532	=item L<Guard>
2509		2533
2510	The guard module, when used, will be used to implement	2534	The guard module, when used, will be used to implement
2511	C<AnyEvent::Util::guard>. This speeds up guards considerably (and uses a	2535	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	2536	lot less memory), but otherwise doesn't affect guard operation much. It is
2513	purely used for performance.	2537	purely used for performance.
2514		2538
2515	=item L<JSON> and L<JSON::XS>	2539	=item L<JSON> and L<JSON::XS>
2516		2540
2517	One of these modules is required when you want to read or write JSON data	2541	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	2542	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.	2543	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		2544
2524	=item L<Net::SSLeay>	2545	=item L<Net::SSLeay>
2525		2546
2526	Implementing TLS/SSL in Perl is certainly interesting, but not very	2547	Implementing TLS/SSL in Perl is certainly interesting, but not very
2527	worthwhile: If this module is installed, then L<AnyEvent::Handle> (with	2548	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.316 by root, Mon Mar 15 18:51:30 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.316 by root, Mon Mar 15 18:51:30 2010 UTC