ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/AnyEvent/lib/AnyEvent.pm
(Generate patch)

Comparing AnyEvent/lib/AnyEvent.pm (file contents):
Revision 1.380 by root, Thu Sep 1 04:07:18 2011 UTC vs.
Revision 1.397 by root, Thu Mar 22 18:00:35 2012 UTC

415not restart syscalls (that includes L<Async::Interrupt> and AnyEvent's 415not restart syscalls (that includes L<Async::Interrupt> and AnyEvent's
416pure perl implementation). 416pure perl implementation).
417 417
418=head3 Safe/Unsafe Signals 418=head3 Safe/Unsafe Signals
419 419
420Perl signals can be either "safe" (synchronous to opcode handling) or 420Perl signals can be either "safe" (synchronous to opcode handling)
421"unsafe" (asynchronous) - the former might get delayed indefinitely, the 421or "unsafe" (asynchronous) - the former might delay signal delivery
422latter might corrupt your memory. 422indefinitely, the latter might corrupt your memory.
423 423
424AnyEvent signal handlers are, in addition, synchronous to the event loop, 424AnyEvent signal handlers are, in addition, synchronous to the event loop,
425i.e. they will not interrupt your running perl program but will only be 425i.e. they will not interrupt your running perl program but will only be
426called as part of the normal event handling (just like timer, I/O etc. 426called as part of the normal event handling (just like timer, I/O etc.
427callbacks, too). 427callbacks, too).
428 428
429=head3 Signal Races, Delays and Workarounds 429=head3 Signal Races, Delays and Workarounds
430 430
431Many event loops (e.g. Glib, Tk, Qt, IO::Async) do not support attaching 431Many event loops (e.g. Glib, Tk, Qt, IO::Async) do not support
432callbacks to signals in a generic way, which is a pity, as you cannot 432attaching callbacks to signals in a generic way, which is a pity,
433do race-free signal handling in perl, requiring C libraries for 433as you cannot do race-free signal handling in perl, requiring
434this. AnyEvent will try to do its best, which means in some cases, 434C libraries for this. AnyEvent will try to do its best, which
435signals will be delayed. The maximum time a signal might be delayed is 435means in some cases, signals will be delayed. The maximum time
436specified in C<$AnyEvent::MAX_SIGNAL_LATENCY> (default: 10 seconds). This 436a signal might be delayed is 10 seconds by default, but can
437variable can be changed only before the first signal watcher is created, 437be overriden via C<$ENV{PERL_ANYEVENT_MAX_SIGNAL_LATENCY}> or
438and should be left alone otherwise. This variable determines how often 438C<$AnyEvent::MAX_SIGNAL_LATENCY> - see the L<ENVIRONMENT VARIABLES>
439AnyEvent polls for signals (in case a wake-up was missed). Higher values 439section for details.
440will cause fewer spurious wake-ups, which is better for power and CPU
441saving.
442 440
443All these problems can be avoided by installing the optional 441All these problems can be avoided by installing the optional
444L<Async::Interrupt> module, which works with most event loops. It will not 442L<Async::Interrupt> module, which works with most event loops. It will not
445work with inherently broken event loops such as L<Event> or L<Event::Lib> 443work with inherently broken event loops such as L<Event> or L<Event::Lib>
446(and not with L<POE> currently, as POE does its own workaround with 444(and not with L<POE> currently). For those, you just have to suffer the
447one-second latency). For those, you just have to suffer the delays. 445delays.
448 446
449=head2 CHILD PROCESS WATCHERS 447=head2 CHILD PROCESS WATCHERS
450 448
451 $w = AnyEvent->child (pid => <process id>, cb => <callback>); 449 $w = AnyEvent->child (pid => <process id>, cb => <callback>);
452 450
1235 1233
1236BEGIN { AnyEvent::common_sense } 1234BEGIN { AnyEvent::common_sense }
1237 1235
1238use Carp (); 1236use Carp ();
1239 1237
1240our $VERSION = '6.02'; 1238our $VERSION = '6.14';
1241our $MODEL; 1239our $MODEL;
1242
1243our @ISA; 1240our @ISA;
1244
1245our @REGISTRY; 1241our @REGISTRY;
1246
1247our $VERBOSE; 1242our $VERBOSE;
1243our %PROTOCOL; # (ipv4|ipv6) => (1|2), higher numbers are preferred
1244our $MAX_SIGNAL_LATENCY = $ENV{PERL_ANYEVENT_MAX_SIGNAL_LATENCY} || 10; # executes after the BEGIN block below (tainting!)
1248 1245
1249BEGIN { 1246BEGIN {
1250 require "AnyEvent/constants.pl"; 1247 require "AnyEvent/constants.pl";
1251 1248
1252 eval "sub TAINT (){" . (${^TAINT}*1) . "}"; 1249 eval "sub TAINT (){" . (${^TAINT}*1) . "}";
1258 for grep s/^AE_// && !exists $ENV{"PERL_ANYEVENT_$_"}, keys %ENV; 1255 for grep s/^AE_// && !exists $ENV{"PERL_ANYEVENT_$_"}, keys %ENV;
1259 1256
1260 @ENV{grep /^PERL_ANYEVENT_/, keys %ENV} = () 1257 @ENV{grep /^PERL_ANYEVENT_/, keys %ENV} = ()
1261 if ${^TAINT}; 1258 if ${^TAINT};
1262 1259
1260 # $ENV{PERL_ANYEVENT_xxx} now valid
1261
1263 $VERBOSE = length $ENV{PERL_ANYEVENT_VERBOSE} ? $ENV{PERL_ANYEVENT_VERBOSE}*1 : 3; 1262 $VERBOSE = length $ENV{PERL_ANYEVENT_VERBOSE} ? $ENV{PERL_ANYEVENT_VERBOSE}*1 : 4;
1264}
1265 1263
1266our $MAX_SIGNAL_LATENCY = 10;
1267
1268our %PROTOCOL; # (ipv4|ipv6) => (1|2), higher numbers are preferred
1269
1270{
1271 my $idx; 1264 my $idx;
1272 $PROTOCOL{$_} = ++$idx 1265 $PROTOCOL{$_} = ++$idx
1273 for reverse split /\s*,\s*/, 1266 for reverse split /\s*,\s*/,
1274 $ENV{PERL_ANYEVENT_PROTOCOLS} || "ipv4,ipv6"; 1267 $ENV{PERL_ANYEVENT_PROTOCOLS} || "ipv4,ipv6";
1275} 1268}
1308 () 1301 ()
1309} 1302}
1310 1303
1311sub log($$;@) { 1304sub log($$;@) {
1312 # only load the big bloated module when we actually are about to log something 1305 # only load the big bloated module when we actually are about to log something
1313 if ($_[0] <= $VERBOSE) { # also catches non-numeric levels(!) 1306 if ($_[0] <= ($VERBOSE || 1)) { # also catches non-numeric levels(!) and fatal
1314 require AnyEvent::Log; 1307 local ($!, $@);
1308 require AnyEvent::Log; # among other things, sets $VERBOSE to 9
1315 # AnyEvent::Log overwrites this function 1309 # AnyEvent::Log overwrites this function
1316 goto &log; 1310 goto &log;
1317 } 1311 }
1318 1312
1319 0 # not logged 1313 0 # not logged
1320} 1314}
1321 1315
1316sub _logger($;$) {
1317 my ($level, $renabled) = @_;
1318
1319 $$renabled = $level <= $VERBOSE;
1320
1321 my $logger = [(caller)[0], $level, $renabled];
1322
1323 $AnyEvent::Log::LOGGER{$logger+0} = $logger;
1324
1325# return unless defined wantarray;
1326#
1327# require AnyEvent::Util;
1328# my $guard = AnyEvent::Util::guard (sub {
1329# # "clean up"
1330# delete $LOGGER{$logger+0};
1331# });
1332#
1333# sub {
1334# return 0 unless $$renabled;
1335#
1336# $guard if 0; # keep guard alive, but don't cause runtime overhead
1337# require AnyEvent::Log unless $AnyEvent::Log::VERSION;
1338# package AnyEvent::Log;
1339# _log ($logger->[0], $level, @_) # logger->[0] has been converted at load time
1340# }
1341}
1342
1322if (length $ENV{PERL_ANYEVENT_LOG}) { 1343if (length $ENV{PERL_ANYEVENT_LOG}) {
1323 require AnyEvent::Log; # AnyEvent::Log does the thing for us 1344 require AnyEvent::Log; # AnyEvent::Log does the thing for us
1324} 1345}
1325 1346
1326our @models = ( 1347our @models = (
1327 [EV:: => AnyEvent::Impl::EV:: , 1], 1348 [EV:: => AnyEvent::Impl::EV::],
1328 [AnyEvent::Loop:: => AnyEvent::Impl::Perl:: , 1], 1349 [AnyEvent::Loop:: => AnyEvent::Impl::Perl::],
1329 # everything below here will not (normally) be autoprobed 1350 # everything below here will not (normally) be autoprobed
1330 # as the pure perl backend should work everywhere 1351 # as the pure perl backend should work everywhere
1331 # and is usually faster 1352 # and is usually faster
1353 [Irssi:: => AnyEvent::Impl::Irssi::], # Irssi has a bogus "Event" package, so msut be near the top
1332 [Event:: => AnyEvent::Impl::Event::, 1], 1354 [Event:: => AnyEvent::Impl::Event::], # slow, stable
1333 [Glib:: => AnyEvent::Impl::Glib:: , 1], # becomes extremely slow with many watchers 1355 [Glib:: => AnyEvent::Impl::Glib::], # becomes extremely slow with many watchers
1356 # everything below here should not be autoloaded
1334 [Event::Lib:: => AnyEvent::Impl::EventLib::], # too buggy 1357 [Event::Lib:: => AnyEvent::Impl::EventLib::], # too buggy
1335 [Irssi:: => AnyEvent::Impl::Irssi::], # Irssi has a bogus "Event" package
1336 [Tk:: => AnyEvent::Impl::Tk::], # crashes with many handles 1358 [Tk:: => AnyEvent::Impl::Tk::], # crashes with many handles
1337 [Qt:: => AnyEvent::Impl::Qt::], # requires special main program 1359 [Qt:: => AnyEvent::Impl::Qt::], # requires special main program
1338 [POE::Kernel:: => AnyEvent::Impl::POE::], # lasciate ogni speranza 1360 [POE::Kernel:: => AnyEvent::Impl::POE::], # lasciate ogni speranza
1339 [Wx:: => AnyEvent::Impl::POE::], 1361 [Wx:: => AnyEvent::Impl::POE::],
1340 [Prima:: => AnyEvent::Impl::POE::], 1362 [Prima:: => AnyEvent::Impl::POE::],
1369our @methods = qw(io timer time now now_update signal child idle condvar); 1391our @methods = qw(io timer time now now_update signal child idle condvar);
1370 1392
1371sub detect() { 1393sub detect() {
1372 return $MODEL if $MODEL; # some programs keep references to detect 1394 return $MODEL if $MODEL; # some programs keep references to detect
1373 1395
1396 # IO::Async::Loop::AnyEvent is extremely evil, refuse to work with it
1397 # the author knows about the problems and what it does to AnyEvent as a whole
1398 # (and the ability of others to use AnyEvent), but simply wants to abuse AnyEvent
1399 # anyway.
1400 AnyEvent::log fatal => "AnyEvent: IO::Async::Loop::AnyEvent detected - that module is broken by\n"
1401 . "design, abuses internals and breaks AnyEvent - will not continue."
1402 if exists $INC{"IO/Async/Loop/AnyEvent.pm"};
1403
1374 local $!; # for good measure 1404 local $!; # for good measure
1375 local $SIG{__DIE__}; # we use eval 1405 local $SIG{__DIE__}; # we use eval
1376 1406
1377 # free some memory 1407 # free some memory
1378 *detect = sub () { $MODEL }; 1408 *detect = sub () { $MODEL };
1389 $model = "AnyEvent::Impl::$model" unless $model =~ s/::$//; 1419 $model = "AnyEvent::Impl::$model" unless $model =~ s/::$//;
1390 if (eval "require $model") { 1420 if (eval "require $model") {
1391 AnyEvent::log 7 => "loaded model '$model' (forced by \$ENV{PERL_ANYEVENT_MODEL}), using it."; 1421 AnyEvent::log 7 => "loaded model '$model' (forced by \$ENV{PERL_ANYEVENT_MODEL}), using it.";
1392 $MODEL = $model; 1422 $MODEL = $model;
1393 } else { 1423 } else {
1394 AnyEvent::log 5 => "unable to load model '$model' (from \$ENV{PERL_ANYEVENT_MODEL}):\n$@"; 1424 AnyEvent::log 4 => "unable to load model '$model' (from \$ENV{PERL_ANYEVENT_MODEL}):\n$@";
1395 } 1425 }
1396 } 1426 }
1397 1427
1398 # check for already loaded models 1428 # check for already loaded models
1399 unless ($MODEL) { 1429 unless ($MODEL) {
1402 if (${"$package\::VERSION"} > 0) { 1432 if (${"$package\::VERSION"} > 0) {
1403 if (eval "require $model") { 1433 if (eval "require $model") {
1404 AnyEvent::log 7 => "autodetected model '$model', using it."; 1434 AnyEvent::log 7 => "autodetected model '$model', using it.";
1405 $MODEL = $model; 1435 $MODEL = $model;
1406 last; 1436 last;
1437 } else {
1438 AnyEvent::log 8 => "detected event loop $package, but cannot load '$model', skipping: $@";
1407 } 1439 }
1408 } 1440 }
1409 } 1441 }
1410 1442
1411 unless ($MODEL) { 1443 unless ($MODEL) {
1412 # try to autoload a model 1444 # try to autoload a model
1413 for (@REGISTRY, @models) { 1445 for (@REGISTRY, @models) {
1414 my ($package, $model, $autoload) = @$_; 1446 my ($package, $model) = @$_;
1415 if ( 1447 if (
1416 $autoload
1417 and eval "require $package" 1448 eval "require $package"
1418 and ${"$package\::VERSION"} > 0 1449 and ${"$package\::VERSION"} > 0
1419 and eval "require $model" 1450 and eval "require $model"
1420 ) { 1451 ) {
1421 AnyEvent::log 7 => "autoloaded model '$model', using it."; 1452 AnyEvent::log 7 => "autoloaded model '$model', using it.";
1422 $MODEL = $model; 1453 $MODEL = $model;
1423 last; 1454 last;
1424 } 1455 }
1425 } 1456 }
1426 1457
1427 $MODEL 1458 $MODEL
1428 or die "AnyEvent: backend autodetection failed - did you properly install AnyEvent?"; 1459 or AnyEvent::log fatal => "AnyEvent: backend autodetection failed - did you properly install AnyEvent?";
1429 } 1460 }
1430 } 1461 }
1431 1462
1432 # free memory only needed for probing 1463 # free memory only needed for probing
1433 undef @models; 1464 undef @models;
2042 2073
2043=over 4 2074=over 4
2044 2075
2045=item C<PERL_ANYEVENT_VERBOSE> 2076=item C<PERL_ANYEVENT_VERBOSE>
2046 2077
2047By default, AnyEvent will only log messages with loglevel C<3> 2078By default, AnyEvent will log messages with loglevel C<4> (C<error>) or
2048(C<critical>) or higher (see L<AnyEvent::Log>). You can set this 2079higher (see L<AnyEvent::Log>). You can set this environment variable to a
2049environment variable to a numerical loglevel to make AnyEvent more (or 2080numerical loglevel to make AnyEvent more (or less) talkative.
2050less) talkative.
2051 2081
2052If you want to do more than just set the global logging level 2082If you want to do more than just set the global logging level
2053you should have a look at C<PERL_ANYEVENT_LOG>, which allows much more 2083you should have a look at C<PERL_ANYEVENT_LOG>, which allows much more
2054complex specifications. 2084complex specifications.
2055 2085
2056When set to C<0> (C<off>), then no messages whatsoever will be logged with 2086When set to C<0> (C<off>), then no messages whatsoever will be logged with
2057the default logging settings. 2087everything else at defaults.
2058 2088
2059When set to C<5> or higher (C<warn>), causes AnyEvent to warn about 2089When set to C<5> or higher (C<warn>), AnyEvent warns about unexpected
2060unexpected conditions, such as not being able to load the event model 2090conditions, such as not being able to load the event model specified by
2061specified by C<PERL_ANYEVENT_MODEL>, or a guard callback throwing an 2091C<PERL_ANYEVENT_MODEL>, or a guard callback throwing an exception - this
2062exception - this is the minimum recommended level. 2092is the minimum recommended level for use during development.
2063 2093
2064When set to C<7> or higher (info), cause AnyEvent to report which event model it 2094When set to C<7> or higher (info), AnyEvent reports which event model it
2065chooses. 2095chooses.
2066 2096
2067When set to C<8> or higher (debug), then AnyEvent will report extra information on 2097When set to C<8> or higher (debug), then AnyEvent will report extra
2068which optional modules it loads and how it implements certain features. 2098information on which optional modules it loads and how it implements
2099certain features.
2069 2100
2070=item C<PERL_ANYEVENT_LOG> 2101=item C<PERL_ANYEVENT_LOG>
2071 2102
2072Accepts rather complex logging specifications. For example, you could log 2103Accepts rather complex logging specifications. For example, you could log
2073all C<debug> messages of some module to stderr, warnings and above to 2104all C<debug> messages of some module to stderr, warnings and above to
2080This variable is evaluated when AnyEvent (or L<AnyEvent::Log>) is loaded, 2111This variable is evaluated when AnyEvent (or L<AnyEvent::Log>) is loaded,
2081so will take effect even before AnyEvent has initialised itself. 2112so will take effect even before AnyEvent has initialised itself.
2082 2113
2083Note that specifying this environment variable causes the L<AnyEvent::Log> 2114Note that specifying this environment variable causes the L<AnyEvent::Log>
2084module to be loaded, while C<PERL_ANYEVENT_VERBOSE> does not, so only 2115module to be loaded, while C<PERL_ANYEVENT_VERBOSE> does not, so only
2085using the latter saves a few hundred kB of memory until the first message 2116using the latter saves a few hundred kB of memory unless a module
2086is being logged. 2117explicitly needs the extra features of AnyEvent::Log.
2087 2118
2088=item C<PERL_ANYEVENT_STRICT> 2119=item C<PERL_ANYEVENT_STRICT>
2089 2120
2090AnyEvent does not do much argument checking by default, as thorough 2121AnyEvent does not do much argument checking by default, as thorough
2091argument checking is very costly. Setting this variable to a true value 2122argument checking is very costly. Setting this variable to a true value
2100C<PERL_ANYEVENT_STRICT=1> in your environment while developing programs 2131C<PERL_ANYEVENT_STRICT=1> in your environment while developing programs
2101can be very useful, however. 2132can be very useful, however.
2102 2133
2103=item C<PERL_ANYEVENT_DEBUG_SHELL> 2134=item C<PERL_ANYEVENT_DEBUG_SHELL>
2104 2135
2105If this env variable is set, then its contents will be interpreted by 2136If this env variable is nonempty, then its contents will be interpreted by
2106C<AnyEvent::Socket::parse_hostport> (after replacing every occurance of 2137C<AnyEvent::Socket::parse_hostport> and C<AnyEvent::Debug::shell> (after
2107C<$$> by the process pid) and an C<AnyEvent::Debug::shell> is bound on 2138replacing every occurance of C<$$> by the process pid). The shell object
2108that port. The shell object is saved in C<$AnyEvent::Debug::SHELL>. 2139is saved in C<$AnyEvent::Debug::SHELL>.
2109 2140
2110This happens when the first watcher is created. 2141This happens when the first watcher is created.
2111 2142
2112For example, to bind a debug shell on a unix domain socket in 2143For example, to bind a debug shell on a unix domain socket in
2113F<< /tmp/debug<pid>.sock >>, you could use this: 2144F<< /tmp/debug<pid>.sock >>, you could use this:
2114 2145
2115 PERL_ANYEVENT_DEBUG_SHELL=/tmp/debug\$\$.sock perlprog 2146 PERL_ANYEVENT_DEBUG_SHELL=/tmp/debug\$\$.sock perlprog
2147 # connect with e.g.: socat readline /tmp/debug123.sock
2116 2148
2149Or to bind to tcp port 4545 on localhost:
2150
2151 PERL_ANYEVENT_DEBUG_SHELL=127.0.0.1:4545 perlprog
2152 # connect with e.g.: telnet localhost 4545
2153
2117Note that creating sockets in F</tmp> is very unsafe on multiuser 2154Note that creating sockets in F</tmp> or on localhost is very unsafe on
2118systems. 2155multiuser systems.
2119 2156
2120=item C<PERL_ANYEVENT_DEBUG_WRAP> 2157=item C<PERL_ANYEVENT_DEBUG_WRAP>
2121 2158
2122Can be set to C<0>, C<1> or C<2> and enables wrapping of all watchers for 2159Can be set to C<0>, C<1> or C<2> and enables wrapping of all watchers for
2123debugging purposes. See C<AnyEvent::Debug::wrap> for details. 2160debugging purposes. See C<AnyEvent::Debug::wrap> for details.
2187=item C<PERL_ANYEVENT_MAX_OUTSTANDING_DNS> 2224=item C<PERL_ANYEVENT_MAX_OUTSTANDING_DNS>
2188 2225
2189The default value for the C<max_outstanding> parameter for the default DNS 2226The default value for the C<max_outstanding> parameter for the default DNS
2190resolver - this is the maximum number of parallel DNS requests that are 2227resolver - this is the maximum number of parallel DNS requests that are
2191sent to the DNS server. 2228sent to the DNS server.
2229
2230=item C<PERL_ANYEVENT_MAX_SIGNAL_LATENCY>
2231
2232Perl has inherently racy signal handling (you can basically choose between
2233losing signals and memory corruption) - pure perl event loops (including
2234C<AnyEvent::Loop>, when C<Async::Interrupt> isn't available) therefore
2235have to poll regularly to avoid losing signals.
2236
2237Some event loops are racy, but don't poll regularly, and some event loops
2238are written in C but are still racy. For those event loops, AnyEvent
2239installs a timer that regularly wakes up the event loop.
2240
2241By default, the interval for this timer is C<10> seconds, but you can
2242override this delay with this environment variable (or by setting
2243the C<$AnyEvent::MAX_SIGNAL_LATENCY> variable before creating signal
2244watchers).
2245
2246Lower values increase CPU (and energy) usage, higher values can introduce
2247long delays when reaping children or waiting for signals.
2248
2249The L<AnyEvent::Async> module, if available, will be used to avoid this
2250polling (with most event loops).
2192 2251
2193=item C<PERL_ANYEVENT_RESOLV_CONF> 2252=item C<PERL_ANYEVENT_RESOLV_CONF>
2194 2253
2195The absolute path to a F<resolv.conf>-style file to use instead of 2254The absolute path to a F<resolv.conf>-style file to use instead of
2196F</etc/resolv.conf> (or the OS-specific configuration) in the default 2255F</etc/resolv.conf> (or the OS-specific configuration) in the default

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines