[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.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.23';	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 WIN32(){ " . (($^O =~ /mswin32/i)*1) ." }";	1172	require "AnyEvent/constants.pl";
		1173
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
…		…
1496	$SIG_IO = AE::io $SIGPIPE_R->fileno, 0, \&_signal_exec;	1491	$SIG_IO = AE::io $SIGPIPE_R->fileno, 0, \&_signal_exec;
1497		1492
1498	} else {	1493	} else {
1499	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;
1500		1495
1501	require Fcntl;
1502
1503	if (AnyEvent::WIN32) {	1496	if (AnyEvent::WIN32) {
1504	require AnyEvent::Util;	1497	require AnyEvent::Util;
1505		1498
1506	($SIGPIPE_R, $SIGPIPE_W) = AnyEvent::Util::portable_pipe ();	1499	($SIGPIPE_R, $SIGPIPE_W) = AnyEvent::Util::portable_pipe ();
1507	AnyEvent::Util::fh_nonblocking ($SIGPIPE_R, 1) if $SIGPIPE_R;	1500	AnyEvent::Util::fh_nonblocking ($SIGPIPE_R, 1) if $SIGPIPE_R;
1508	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
1509	} else {	1502	} else {
1510	pipe $SIGPIPE_R, $SIGPIPE_W;	1503	pipe $SIGPIPE_R, $SIGPIPE_W;
1511	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;
1512	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
1513		1506
1514	# 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...
1515	fcntl $SIGPIPE_R, &Fcntl::F_SETFD, &Fcntl::FD_CLOEXEC;	1508	fcntl $SIGPIPE_R, AnyEvent::F_SETFD, AnyEvent::FD_CLOEXEC;
1516	fcntl $SIGPIPE_W, &Fcntl::F_SETFD, &Fcntl::FD_CLOEXEC;	1509	fcntl $SIGPIPE_W, AnyEvent::F_SETFD, AnyEvent::FD_CLOEXEC;
1517	}	1510	}
1518		1511
1519	$SIGPIPE_R	1512	$SIGPIPE_R
1520	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";
1521		1514
…		…
1575	# print weird messages, or just unconditionally exit	1568	# print weird messages, or just unconditionally exit
1576	# instead of getting the default action.	1569	# instead of getting the default action.
1577	undef $SIG{$signal}	1570	undef $SIG{$signal}
1578	unless keys %{ $SIG_CB{$signal} };	1571	unless keys %{ $SIG_CB{$signal} };
1579	};	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	};
1580	};	1586	};
1581	die if $@;	1587	die if $@;
		1588
1582	&signal	1589	&signal
1583	}	1590	}
1584		1591
1585	# default implementation for ->child	1592	# default implementation for ->child
1586		1593
1587	our %PID_CB;	1594	our %PID_CB;
1588	our $CHLD_W;	1595	our $CHLD_W;
1589	our $CHLD_DELAY_W;	1596	our $CHLD_DELAY_W;
1590	our $WNOHANG;	1597	our $WNOHANG;
1591		1598
		1599	# used by many Impl's
1592	sub _emit_childstatus($$) {	1600	sub _emit_childstatus($$) {
1593	my (undef, $rpid, $rstatus) = @_;	1601	my (undef, $rpid, $rstatus) = @_;
1594		1602
1595	$_->($rpid, $rstatus)	1603	$_->($rpid, $rstatus)
1596	for values %{ $PID_CB{$rpid} \|\| {} },	1604	for values %{ $PID_CB{$rpid} \|\| {} },
1597	values %{ $PID_CB{0} \|\| {} };	1605	values %{ $PID_CB{0} \|\| {} };
1598	}	1606	}
1599		1607
1600	sub _sigchld {
1601	my $pid;
1602
1603	AnyEvent->_emit_childstatus ($pid, $?)
1604	while ($pid = waitpid -1, $WNOHANG) > 0;
1605	}
1606
1607	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 {
1608	my (undef, %arg) = @_;	1618	my (undef, %arg) = @_;
1609		1619
1610	defined (my $pid = $arg{pid} + 0)	1620	defined (my $pid = $arg{pid} + 0)
1611	or Carp::croak "required option 'pid' is missing";	1621	or Carp::croak "required option 'pid' is missing";
1612		1622
1613	$PID_CB{$pid}{$arg{cb}} = $arg{cb};	1623	$PID_CB{$pid}{$arg{cb}} = $arg{cb};
1614		1624
1615	# WNOHANG is almost cetrainly 1 everywhere	1625	# WNOHANG is almost cetrainly 1 everywhere
1616	$WNOHANG \|\|= $^O =~ /^(?:openbsd\|netbsd\|linux\|freebsd\|cygwin\|MSWin32)$/	1626	$WNOHANG \|\|= $^O =~ /^(?:openbsd\|netbsd\|linux\|freebsd\|cygwin\|MSWin32)$/
1617	? 1	1627	? 1
1618	: eval { local $SIG{__DIE__}; require POSIX; &POSIX::WNOHANG } \|\| 1;	1628	: eval { local $SIG{__DIE__}; require POSIX; &POSIX::WNOHANG } \|\| 1;
1619		1629
1620	unless ($CHLD_W) {	1630	unless ($CHLD_W) {
1621	$CHLD_W = AE::signal CHLD => \&_sigchld;	1631	$CHLD_W = AE::signal CHLD => \&_sigchld;
1622	# 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
1623	&_sigchld;	1633	&_sigchld;
1624	}	1634	}
1625		1635
1626	bless [$pid, $arg{cb}], "AnyEvent::Base::child"	1636	bless [$pid, $arg{cb}], "AnyEvent::Base::child"
1627	}	1637	};
1628		1638
1629	sub AnyEvent::Base::child::DESTROY {	1639	*AnyEvent::Base::child::DESTROY = sub {
1630	my ($pid, $cb) = @{$_[0]};	1640	my ($pid, $cb) = @{$_[0]};
1631		1641
1632	delete $PID_CB{$pid}{$cb};	1642	delete $PID_CB{$pid}{$cb};
1633	delete $PID_CB{$pid} unless keys %{ $PID_CB{$pid} };	1643	delete $PID_CB{$pid} unless keys %{ $PID_CB{$pid} };
1634		1644
1635	undef $CHLD_W unless keys %PID_CB;	1645	undef $CHLD_W unless keys %PID_CB;
		1646	};
		1647	};
		1648	die if $@;
		1649
		1650	&child
1636	}	1651	}
1637		1652
1638	# idle emulation is done by simply using a timer, regardless	1653	# idle emulation is done by simply using a timer, regardless
1639	# of whether the process is idle or not, and not letting	1654	# of whether the process is idle or not, and not letting
1640	# the callback use more than 50% of the time.	1655	# the callback use more than 50% of the time.
1641	sub idle {	1656	sub idle {
		1657	eval q{ # poor man's autoloading {}
		1658	*idle = sub {
1642	my (undef, %arg) = @_;	1659	my (undef, %arg) = @_;
1643		1660
1644	my ($cb, $w, $rcb) = $arg{cb};	1661	my ($cb, $w, $rcb) = $arg{cb};
1645		1662
1646	$rcb = sub {	1663	$rcb = sub {
1647	if ($cb) {	1664	if ($cb) {
1648	$w = _time;	1665	$w = _time;
1649	&$cb;	1666	&$cb;
1650	$w = _time - $w;	1667	$w = _time - $w;
1651		1668
1652	# 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,
1653	# within some limits	1670	# within some limits
1654	$w = 0.0001 if $w < 0.0001;	1671	$w = 0.0001 if $w < 0.0001;
1655	$w = 5 if $w > 5;	1672	$w = 5 if $w > 5;
1656		1673
1657	$w = AE::timer $w, 0, $rcb;	1674	$w = AE::timer $w, 0, $rcb;
1658	} else {	1675	} else {
1659	# clean up...	1676	# clean up...
1660	undef $w;	1677	undef $w;
1661	undef $rcb;	1678	undef $rcb;
		1679	}
		1680	};
		1681
		1682	$w = AE::timer 0.05, 0, $rcb;
		1683
		1684	bless \\$cb, "AnyEvent::Base::idle"
1662	}	1685	};
		1686
		1687	*AnyEvent::Base::idle::DESTROY = sub {
		1688	undef $${$_[0]};
		1689	};
1663	};	1690	};
		1691	die if $@;
1664		1692
1665	$w = AE::timer 0.05, 0, $rcb;	1693	&idle
1666
1667	bless \\$cb, "AnyEvent::Base::idle"
1668	}
1669
1670	sub AnyEvent::Base::idle::DESTROY {
1671	undef $${$_[0]};
1672	}	1694	}
1673		1695
1674	package AnyEvent::CondVar;	1696	package AnyEvent::CondVar;
1675		1697
1676	our @ISA = AnyEvent::CondVar::Base::;	1698	our @ISA = AnyEvent::CondVar::Base::;
…		…
2502	automatic timer adjustments even when no monotonic clock is available,	2524	automatic timer adjustments even when no monotonic clock is available,
2503	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
2504	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
2505	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>).
2506		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
2507	=item L<Guard>	2532	=item L<Guard>
2508		2533
2509	The guard module, when used, will be used to implement	2534	The guard module, when used, will be used to implement
2510	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
2511	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
2512	purely used for performance.	2537	purely used for performance.
2513		2538
2514	=item L<JSON> and L<JSON::XS>	2539	=item L<JSON> and L<JSON::XS>
2515		2540
2516	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
2517	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
2518	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.
2519
2520	In fact, L<AnyEvent::Handle> will use L<JSON::XS> by default if it is
2521	installed.
2522		2544
2523	=item L<Net::SSLeay>	2545	=item L<Net::SSLeay>
2524		2546
2525	Implementing TLS/SSL in Perl is certainly interesting, but not very	2547	Implementing TLS/SSL in Perl is certainly interesting, but not very
2526	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.309 by root, Sat Dec 26 08:59:35 2009 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.309 by root, Sat Dec 26 08:59:35 2009 UTC vs.
Revision 1.316 by root, Mon Mar 15 18:51:30 2010 UTC