[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.312 by root, Mon Feb 15 18:02:35 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.23';	1161	our $VERSION = '5.24';
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	eval "sub WIN32(){ " . (($^O =~ /mswin32/i)*1) ." }";	1173	eval "sub WIN32 (){" . (($^O =~ /mswin32/i)*1) . "}";
1173	eval "sub TAINT(){ " . (${^TAINT}*1) . " }";	1174	eval "sub TAINT (){" . (${^TAINT} *1) . "}";
1174		1175
1175	delete @ENV{grep /^PERL_ANYEVENT_/, keys %ENV}	1176	delete @ENV{grep /^PERL_ANYEVENT_/, keys %ENV}
1176	if ${^TAINT};	1177	if ${^TAINT};
1177		1178
1178	$VERBOSE = $ENV{PERL_ANYEVENT_VERBOSE}*1;	1179	$VERBOSE = $ENV{PERL_ANYEVENT_VERBOSE}*1;
…		…
1239	sub AnyEvent::Util::postdetect::DESTROY {	1240	sub AnyEvent::Util::postdetect::DESTROY {
1240	@post_detect = grep $_ != ${$_[0]}, @post_detect;	1241	@post_detect = grep $_ != ${$_[0]}, @post_detect;
1241	}	1242	}
1242		1243
1243	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
1244	unless ($MODEL) {	1262	unless ($MODEL) {
1245	local $SIG{__DIE__};	1263	for (@REGISTRY, @models) {
1246		1264	my ($package, $model) = @$_;
1247	if ($ENV{PERL_ANYEVENT_MODEL} =~ /^([a-zA-Z]+)$/) {	1265	if (${"$package\::VERSION"} > 0) {
1248	my $model = "AnyEvent::Impl::$1";
1249	if (eval "require $model") {	1266	if (eval "require $model") {
1250	$MODEL = $model;	1267	$MODEL = $model;
1251	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;
1252	} else {	1269	last;
1253	warn "AnyEvent: unable to load model '$model' (from \$ENV{PERL_ANYEVENT_MODEL}):\n$@" if $VERBOSE;	1270	}
1254	}	1271	}
1255	}	1272	}
1256		1273
1257	# check for already loaded models
1258	unless ($MODEL) {	1274	unless ($MODEL) {
		1275	# try to autoload a model
1259	for (@REGISTRY, @models) {	1276	for (@REGISTRY, @models) {
1260	my ($package, $model) = @$_;	1277	my ($package, $model, $autoload) = @$_;
		1278	if (
		1279	$autoload
		1280	and eval "require $package"
1261	if (${"$package\::VERSION"} > 0) {	1281	and ${"$package\::VERSION"} > 0
1262	if (eval "require $model") {	1282	and eval "require $model"
		1283	) {
1263	$MODEL = $model;	1284	$MODEL = $model;
1264	warn "AnyEvent: autodetected model '$model', using it.\n" if $VERBOSE >= 2;	1285	warn "AnyEvent: autoloaded model '$model', using it.\n" if $VERBOSE >= 2;
1265	last;	1286	last;
1266	}
1267	}	1287	}
1268	}	1288	}
1269		1289
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	1290	$MODEL
1287	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";
1288	}
1289	}	1292	}
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	}	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;
1299		1303
1300	$MODEL	1304	$MODEL
1301	}	1305	}
1302		1306
1303	sub AUTOLOAD {	1307	sub AUTOLOAD {
1304	(my $func = $AUTOLOAD) =~ s/.*://;	1308	(my $func = $AUTOLOAD) =~ s/.*://;
1305		1309
1306	$method{$func}	1310	$method{$func}
1307	or Carp::croak "$func: not a valid method for AnyEvent objects";	1311	or Carp::croak "$func: not a valid AnyEvent class method";
1308		1312
1309	detect unless $MODEL;	1313	detect;
1310		1314
1311	my $class = shift;	1315	my $class = shift;
1312	$class->$func (@_);	1316	$class->$func (@_);
1313	}	1317	}
1314		1318
…		…
1382	package AnyEvent::Base;	1386	package AnyEvent::Base;
1383		1387
1384	# default implementations for many methods	1388	# default implementations for many methods
1385		1389
1386	sub _time() {	1390	sub _time() {
		1391	eval q{ # poor man's autoloading
1387	# probe for availability of Time::HiRes	1392	# probe for availability of Time::HiRes
1388	if (eval "use Time::HiRes (); Time::HiRes::time (); 1") {	1393	if (eval "use Time::HiRes (); Time::HiRes::time (); 1") {
1389	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;
1390	*_time = \&Time::HiRes::time;	1395	*_time = \&Time::HiRes::time;
1391	# if (eval "use POSIX (); (POSIX::times())...	1396	# if (eval "use POSIX (); (POSIX::times())...
1392	} else {	1397	} else {
1393	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;
1394	*_time = sub { time }; # epic fail	1399	*_time = sub (){ time }; # epic fail
		1400	}
1395	}	1401	};
		1402	die if $@;
1396		1403
1397	&_time	1404	&_time
1398	}	1405	}
1399		1406
1400	sub time { _time }	1407	sub time { _time }
…		…
1421		1428
1422	our ($SIGPIPE_R, $SIGPIPE_W, %SIG_CB, %SIG_EV, $SIG_IO);	1429	our ($SIGPIPE_R, $SIGPIPE_W, %SIG_CB, %SIG_EV, $SIG_IO);
1423	our (%SIG_ASY, %SIG_ASY_W);	1430	our (%SIG_ASY, %SIG_ASY_W);
1424	our ($SIG_COUNT, $SIG_TW);	1431	our ($SIG_COUNT, $SIG_TW);
1425		1432
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	1433	# install a dummy wakeup watcher to reduce signal catching latency
		1434	# used by Impls
1440	sub _sig_add() {	1435	sub _sig_add() {
1441	unless ($SIG_COUNT++) {	1436	unless ($SIG_COUNT++) {
1442	# try to align timer on a full-second boundary, if possible	1437	# try to align timer on a full-second boundary, if possible
1443	my $NOW = AE::now;	1438	my $NOW = AE::now;
1444		1439
…		…
1575	# print weird messages, or just unconditionally exit	1570	# print weird messages, or just unconditionally exit
1576	# instead of getting the default action.	1571	# instead of getting the default action.
1577	undef $SIG{$signal}	1572	undef $SIG{$signal}
1578	unless keys %{ $SIG_CB{$signal} };	1573	unless keys %{ $SIG_CB{$signal} };
1579	};	1574	};
		1575
		1576	*_signal_exec = sub {
		1577	$HAVE_ASYNC_INTERRUPT
		1578	? $SIGPIPE_R->drain
		1579	: sysread $SIGPIPE_R, (my $dummy), 9;
		1580
		1581	while (%SIG_EV) {
		1582	for (keys %SIG_EV) {
		1583	delete $SIG_EV{$_};
		1584	$_->() for values %{ $SIG_CB{$_} \|\| {} };
		1585	}
		1586	}
		1587	};
1580	};	1588	};
1581	die if $@;	1589	die if $@;
		1590
1582	&signal	1591	&signal
1583	}	1592	}
1584		1593
1585	# default implementation for ->child	1594	# default implementation for ->child
1586		1595
1587	our %PID_CB;	1596	our %PID_CB;
1588	our $CHLD_W;	1597	our $CHLD_W;
1589	our $CHLD_DELAY_W;	1598	our $CHLD_DELAY_W;
1590	our $WNOHANG;	1599	our $WNOHANG;
1591		1600
		1601	# used by many Impl's
1592	sub _emit_childstatus($$) {	1602	sub _emit_childstatus($$) {
1593	my (undef, $rpid, $rstatus) = @_;	1603	my (undef, $rpid, $rstatus) = @_;
1594		1604
1595	$_->($rpid, $rstatus)	1605	$_->($rpid, $rstatus)
1596	for values %{ $PID_CB{$rpid} \|\| {} },	1606	for values %{ $PID_CB{$rpid} \|\| {} },
1597	values %{ $PID_CB{0} \|\| {} };	1607	values %{ $PID_CB{0} \|\| {} };
1598	}	1608	}
1599		1609
1600	sub _sigchld {
1601	my $pid;
1602
1603	AnyEvent->_emit_childstatus ($pid, $?)
1604	while ($pid = waitpid -1, $WNOHANG) > 0;
1605	}
1606
1607	sub child {	1610	sub child {
		1611	eval q{ # poor man's autoloading {}
		1612	*_sigchld = sub {
		1613	my $pid;
		1614
		1615	AnyEvent->_emit_childstatus ($pid, $?)
		1616	while ($pid = waitpid -1, $WNOHANG) > 0;
		1617	};
		1618
		1619	*child = sub {
1608	my (undef, %arg) = @_;	1620	my (undef, %arg) = @_;
1609		1621
1610	defined (my $pid = $arg{pid} + 0)	1622	defined (my $pid = $arg{pid} + 0)
1611	or Carp::croak "required option 'pid' is missing";	1623	or Carp::croak "required option 'pid' is missing";
1612		1624
1613	$PID_CB{$pid}{$arg{cb}} = $arg{cb};	1625	$PID_CB{$pid}{$arg{cb}} = $arg{cb};
1614		1626
1615	# WNOHANG is almost cetrainly 1 everywhere	1627	# WNOHANG is almost cetrainly 1 everywhere
1616	$WNOHANG \|\|= $^O =~ /^(?:openbsd\|netbsd\|linux\|freebsd\|cygwin\|MSWin32)$/	1628	$WNOHANG \|\|= $^O =~ /^(?:openbsd\|netbsd\|linux\|freebsd\|cygwin\|MSWin32)$/
1617	? 1	1629	? 1
1618	: eval { local $SIG{__DIE__}; require POSIX; &POSIX::WNOHANG } \|\| 1;	1630	: eval { local $SIG{__DIE__}; require POSIX; &POSIX::WNOHANG } \|\| 1;
1619		1631
1620	unless ($CHLD_W) {	1632	unless ($CHLD_W) {
1621	$CHLD_W = AE::signal CHLD => \&_sigchld;	1633	$CHLD_W = AE::signal CHLD => \&_sigchld;
1622	# child could be a zombie already, so make at least one round	1634	# child could be a zombie already, so make at least one round
1623	&_sigchld;	1635	&_sigchld;
1624	}	1636	}
1625		1637
1626	bless [$pid, $arg{cb}], "AnyEvent::Base::child"	1638	bless [$pid, $arg{cb}], "AnyEvent::Base::child"
1627	}	1639	};
1628		1640
1629	sub AnyEvent::Base::child::DESTROY {	1641	*AnyEvent::Base::child::DESTROY = sub {
1630	my ($pid, $cb) = @{$_[0]};	1642	my ($pid, $cb) = @{$_[0]};
1631		1643
1632	delete $PID_CB{$pid}{$cb};	1644	delete $PID_CB{$pid}{$cb};
1633	delete $PID_CB{$pid} unless keys %{ $PID_CB{$pid} };	1645	delete $PID_CB{$pid} unless keys %{ $PID_CB{$pid} };
1634		1646
1635	undef $CHLD_W unless keys %PID_CB;	1647	undef $CHLD_W unless keys %PID_CB;
		1648	};
		1649	};
		1650	die if $@;
		1651
		1652	&child
1636	}	1653	}
1637		1654
1638	# idle emulation is done by simply using a timer, regardless	1655	# idle emulation is done by simply using a timer, regardless
1639	# of whether the process is idle or not, and not letting	1656	# of whether the process is idle or not, and not letting
1640	# the callback use more than 50% of the time.	1657	# the callback use more than 50% of the time.
1641	sub idle {	1658	sub idle {
		1659	eval q{ # poor man's autoloading {}
		1660	*idle = sub {
1642	my (undef, %arg) = @_;	1661	my (undef, %arg) = @_;
1643		1662
1644	my ($cb, $w, $rcb) = $arg{cb};	1663	my ($cb, $w, $rcb) = $arg{cb};
1645		1664
1646	$rcb = sub {	1665	$rcb = sub {
1647	if ($cb) {	1666	if ($cb) {
1648	$w = _time;	1667	$w = _time;
1649	&$cb;	1668	&$cb;
1650	$w = _time - $w;	1669	$w = _time - $w;
1651		1670
1652	# never use more then 50% of the time for the idle watcher,	1671	# never use more then 50% of the time for the idle watcher,
1653	# within some limits	1672	# within some limits
1654	$w = 0.0001 if $w < 0.0001;	1673	$w = 0.0001 if $w < 0.0001;
1655	$w = 5 if $w > 5;	1674	$w = 5 if $w > 5;
1656		1675
1657	$w = AE::timer $w, 0, $rcb;	1676	$w = AE::timer $w, 0, $rcb;
1658	} else {	1677	} else {
1659	# clean up...	1678	# clean up...
1660	undef $w;	1679	undef $w;
1661	undef $rcb;	1680	undef $rcb;
		1681	}
		1682	};
		1683
		1684	$w = AE::timer 0.05, 0, $rcb;
		1685
		1686	bless \\$cb, "AnyEvent::Base::idle"
1662	}	1687	};
		1688
		1689	*AnyEvent::Base::idle::DESTROY = sub {
		1690	undef $${$_[0]};
		1691	};
1663	};	1692	};
		1693	die if $@;
1664		1694
1665	$w = AE::timer 0.05, 0, $rcb;	1695	&idle
1666
1667	bless \\$cb, "AnyEvent::Base::idle"
1668	}
1669
1670	sub AnyEvent::Base::idle::DESTROY {
1671	undef $${$_[0]};
1672	}	1696	}
1673		1697
1674	package AnyEvent::CondVar;	1698	package AnyEvent::CondVar;
1675		1699
1676	our @ISA = AnyEvent::CondVar::Base::;	1700	our @ISA = AnyEvent::CondVar::Base::;

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.312 by root, Mon Feb 15 18:02:35 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.312 by root, Mon Feb 15 18:02:35 2010 UTC