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.388 by root, Sun Oct 2 01:22:01 2011 UTC vs.
Revision 1.402 by root, Mon Apr 9 02:25:48 2012 UTC

433as you cannot do race-free signal handling in perl, requiring 433as you cannot do race-free signal handling in perl, requiring
434C libraries for this. AnyEvent will try to do its best, which 434C libraries for this. AnyEvent will try to do its best, which
435means in some cases, signals will be delayed. The maximum time 435means in some cases, signals will be delayed. The maximum time
436a signal might be delayed is 10 seconds by default, but can 436a signal might be delayed is 10 seconds by default, but can
437be overriden via C<$ENV{PERL_ANYEVENT_MAX_SIGNAL_LATENCY}> or 437be overriden via C<$ENV{PERL_ANYEVENT_MAX_SIGNAL_LATENCY}> or
438C<$AnyEvent::MAX_SIGNAL_LATENCY> - see the Ö<ENVIRONMENT VARIABLES> 438C<$AnyEvent::MAX_SIGNAL_LATENCY> - see the L<ENVIRONMENT VARIABLES>
439section for details. 439section for details.
440 440
441All these problems can be avoided by installing the optional 441All these problems can be avoided by installing the optional
442L<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
443work 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>
1223 1223
1224package AnyEvent; 1224package AnyEvent;
1225 1225
1226# basically a tuned-down version of common::sense 1226# basically a tuned-down version of common::sense
1227sub common_sense { 1227sub common_sense {
1228 # from common:.sense 3.4 1228 # from common:.sense 3.5
1229 local $^W;
1229 ${^WARNING_BITS} ^= ${^WARNING_BITS} ^ "\x3c\x3f\x33\x00\x0f\xf0\x0f\xc0\xf0\xfc\x33\x00"; 1230 ${^WARNING_BITS} ^= ${^WARNING_BITS} ^ "\x3c\x3f\x33\x00\x0f\xf0\x0f\xc0\xf0\xfc\x33\x00";
1230 # use strict vars subs - NO UTF-8, as Util.pm doesn't like this atm. (uts46data.pl) 1231 # use strict vars subs - NO UTF-8, as Util.pm doesn't like this atm. (uts46data.pl)
1231 $^H |= 0x00000600; 1232 $^H |= 0x00000600;
1232} 1233}
1233 1234
1234BEGIN { AnyEvent::common_sense } 1235BEGIN { AnyEvent::common_sense }
1235 1236
1236use Carp (); 1237use Carp ();
1237 1238
1238our $VERSION = '6.02'; 1239our $VERSION = '6.14';
1239our $MODEL; 1240our $MODEL;
1240our @ISA; 1241our @ISA;
1241our @REGISTRY; 1242our @REGISTRY;
1242our $VERBOSE; 1243our $VERBOSE;
1243our %PROTOCOL; # (ipv4|ipv6) => (1|2), higher numbers are preferred 1244our %PROTOCOL; # (ipv4|ipv6) => (1|2), higher numbers are preferred
1311 } 1312 }
1312 1313
1313 0 # not logged 1314 0 # not logged
1314} 1315}
1315 1316
1316sub logger($;$) { 1317sub _logger($;$) {
1317 package AnyEvent::Log;
1318
1319 my ($level, $renabled) = @_; 1318 my ($level, $renabled) = @_;
1320 1319
1321 $$renabled = $level <= $VERBOSE; 1320 $$renabled = $level <= $VERBOSE;
1322 1321
1323 my $pkg = (caller)[0];
1324
1325 my $logger = [$pkg, $level, $renabled]; 1322 my $logger = [(caller)[0], $level, $renabled];
1326 1323
1327 our %LOGGER;
1328 $LOGGER{$logger+0} = $logger; 1324 $AnyEvent::Log::LOGGER{$logger+0} = $logger;
1329 1325
1330 return unless defined wantarray; 1326# return unless defined wantarray;
1331 1327#
1332 require AnyEvent::Util; 1328# require AnyEvent::Util;
1333 my $guard = AnyEvent::Util::guard (sub { 1329# my $guard = AnyEvent::Util::guard (sub {
1334 # "clean up" 1330# # "clean up"
1335 delete $LOGGER{$logger+0}; 1331# delete $LOGGER{$logger+0};
1336 }); 1332# });
1337 1333#
1338 sub { 1334# sub {
1339 return 0 unless $$renabled; 1335# return 0 unless $$renabled;
1340 1336#
1341 $guard if 0; # keep guard alive, but don't cause runtime overhead 1337# $guard if 0; # keep guard alive, but don't cause runtime overhead
1342 require AnyEvent::Log unless $AnyEvent::Log::VERSION; 1338# require AnyEvent::Log unless $AnyEvent::Log::VERSION;
1343 package AnyEvent::Log; 1339# package AnyEvent::Log;
1344 _log ($logger->[0], $level, @_) # logger->[0] has been converted at load time 1340# _log ($logger->[0], $level, @_) # logger->[0] has been converted at load time
1345 } 1341# }
1346} 1342}
1347 1343
1348if (length $ENV{PERL_ANYEVENT_LOG}) { 1344if (length $ENV{PERL_ANYEVENT_LOG}) {
1349 require AnyEvent::Log; # AnyEvent::Log does the thing for us 1345 require AnyEvent::Log; # AnyEvent::Log does the thing for us
1350} 1346}
1400 1396
1401 # IO::Async::Loop::AnyEvent is extremely evil, refuse to work with it 1397 # IO::Async::Loop::AnyEvent is extremely evil, refuse to work with it
1402 # the author knows about the problems and what it does to AnyEvent as a whole 1398 # the author knows about the problems and what it does to AnyEvent as a whole
1403 # (and the ability of others to use AnyEvent), but simply wants to abuse AnyEvent 1399 # (and the ability of others to use AnyEvent), but simply wants to abuse AnyEvent
1404 # anyway. 1400 # anyway.
1405 AnyEvent::log fatal => "AnyEvent: IO::Async::Loop::AnyEvent detected - this module is broken by design,\n" 1401 AnyEvent::log fatal => "IO::Async::Loop::AnyEvent detected - that module is broken by\n"
1406 . "abuses internals and breaks AnyEvent, will not continue." 1402 . "design, abuses internals and breaks AnyEvent - will not continue."
1407 if exists $INC{"IO/Async/Loop/AnyEvent.pm"}; 1403 if exists $INC{"IO/Async/Loop/AnyEvent.pm"};
1408 1404
1409 local $!; # for good measure 1405 local $!; # for good measure
1410 local $SIG{__DIE__}; # we use eval 1406 local $SIG{__DIE__}; # we use eval
1411 1407
1421 1417
1422 if ($ENV{PERL_ANYEVENT_MODEL} =~ /^([a-zA-Z0-9:]+)$/) { 1418 if ($ENV{PERL_ANYEVENT_MODEL} =~ /^([a-zA-Z0-9:]+)$/) {
1423 my $model = $1; 1419 my $model = $1;
1424 $model = "AnyEvent::Impl::$model" unless $model =~ s/::$//; 1420 $model = "AnyEvent::Impl::$model" unless $model =~ s/::$//;
1425 if (eval "require $model") { 1421 if (eval "require $model") {
1426 AnyEvent::log 7 => "loaded model '$model' (forced by \$ENV{PERL_ANYEVENT_MODEL}), using it."; 1422 AnyEvent::log 7 => "Loaded model '$model' (forced by \$ENV{PERL_ANYEVENT_MODEL}), using it.";
1427 $MODEL = $model; 1423 $MODEL = $model;
1428 } else { 1424 } else {
1429 AnyEvent::log 4 => "unable to load model '$model' (from \$ENV{PERL_ANYEVENT_MODEL}):\n$@"; 1425 AnyEvent::log 4 => "Unable to load model '$model' (from \$ENV{PERL_ANYEVENT_MODEL}):\n$@";
1430 } 1426 }
1431 } 1427 }
1432 1428
1433 # check for already loaded models 1429 # check for already loaded models
1434 unless ($MODEL) { 1430 unless ($MODEL) {
1435 for (@REGISTRY, @models) { 1431 for (@REGISTRY, @models) {
1436 my ($package, $model) = @$_; 1432 my ($package, $model) = @$_;
1437 if (${"$package\::VERSION"} > 0) { 1433 if (${"$package\::VERSION"} > 0) {
1438 if (eval "require $model") { 1434 if (eval "require $model") {
1439 AnyEvent::log 7 => "autodetected model '$model', using it."; 1435 AnyEvent::log 7 => "Autodetected model '$model', using it.";
1440 $MODEL = $model; 1436 $MODEL = $model;
1441 last; 1437 last;
1438 } else {
1439 AnyEvent::log 8 => "Detected event loop $package, but cannot load '$model', skipping: $@";
1442 } 1440 }
1443 } 1441 }
1444 } 1442 }
1445 1443
1446 unless ($MODEL) { 1444 unless ($MODEL) {
1450 if ( 1448 if (
1451 eval "require $package" 1449 eval "require $package"
1452 and ${"$package\::VERSION"} > 0 1450 and ${"$package\::VERSION"} > 0
1453 and eval "require $model" 1451 and eval "require $model"
1454 ) { 1452 ) {
1455 AnyEvent::log 7 => "autoloaded model '$model', using it."; 1453 AnyEvent::log 7 => "Autoloaded model '$model', using it.";
1456 $MODEL = $model; 1454 $MODEL = $model;
1457 last; 1455 last;
1458 } 1456 }
1459 } 1457 }
1460 1458
1461 $MODEL 1459 $MODEL
1462 or AnyEvent::log fatal => "AnyEvent: backend autodetection failed - did you properly install AnyEvent?"; 1460 or AnyEvent::log fatal => "Backend autodetection failed - did you properly install AnyEvent?";
1463 } 1461 }
1464 } 1462 }
1465 1463
1466 # free memory only needed for probing 1464 # free memory only needed for probing
1467 undef @models; 1465 undef @models;
1614 # probe for availability of Time::HiRes 1612 # probe for availability of Time::HiRes
1615 if (eval "use Time::HiRes (); Time::HiRes::time (); 1") { 1613 if (eval "use Time::HiRes (); Time::HiRes::time (); 1") {
1616 *time = sub { Time::HiRes::time () }; 1614 *time = sub { Time::HiRes::time () };
1617 *AE::time = \& Time::HiRes::time ; 1615 *AE::time = \& Time::HiRes::time ;
1618 *now = \&time; 1616 *now = \&time;
1619 AnyEvent::log 8 => "AnyEvent: using Time::HiRes for sub-second timing accuracy."; 1617 AnyEvent::log 8 => "using Time::HiRes for sub-second timing accuracy.";
1620 # if (eval "use POSIX (); (POSIX::times())... 1618 # if (eval "use POSIX (); (POSIX::times())...
1621 } else { 1619 } else {
1622 *time = sub { CORE::time }; 1620 *time = sub { CORE::time };
1623 *AE::time = sub (){ CORE::time }; 1621 *AE::time = sub (){ CORE::time };
1624 *now = \&time; 1622 *now = \&time;
1625 AnyEvent::log 3 => "using built-in time(), WARNING, no sub-second resolution!"; 1623 AnyEvent::log 3 => "Using built-in time(), no sub-second resolution!";
1626 } 1624 }
1627 }; 1625 };
1628 die if $@; 1626 die if $@;
1629 1627
1630 &time 1628 &time
1724 1722
1725sub signal { 1723sub signal {
1726 eval q{ # poor man's autoloading {} 1724 eval q{ # poor man's autoloading {}
1727 # probe for availability of Async::Interrupt 1725 # probe for availability of Async::Interrupt
1728 if (_have_async_interrupt) { 1726 if (_have_async_interrupt) {
1729 AnyEvent::log 8 => "using Async::Interrupt for race-free signal handling."; 1727 AnyEvent::log 8 => "Using Async::Interrupt for race-free signal handling.";
1730 1728
1731 $SIGPIPE_R = new Async::Interrupt::EventPipe; 1729 $SIGPIPE_R = new Async::Interrupt::EventPipe;
1732 $SIG_IO = AE::io $SIGPIPE_R->fileno, 0, \&_signal_exec; 1730 $SIG_IO = AE::io $SIGPIPE_R->fileno, 0, \&_signal_exec;
1733 1731
1734 } else { 1732 } else {
1735 AnyEvent::log 8 => "using emulated perl signal handling with latency timer."; 1733 AnyEvent::log 8 => "Using emulated perl signal handling with latency timer.";
1736 1734
1737 if (AnyEvent::WIN32) { 1735 if (AnyEvent::WIN32) {
1738 require AnyEvent::Util; 1736 require AnyEvent::Util;
1739 1737
1740 ($SIGPIPE_R, $SIGPIPE_W) = AnyEvent::Util::portable_pipe (); 1738 ($SIGPIPE_R, $SIGPIPE_W) = AnyEvent::Util::portable_pipe ();
2076 2074
2077=over 4 2075=over 4
2078 2076
2079=item C<PERL_ANYEVENT_VERBOSE> 2077=item C<PERL_ANYEVENT_VERBOSE>
2080 2078
2081By default, AnyEvent will only log messages with loglevel C<3> 2079By default, AnyEvent will log messages with loglevel C<4> (C<error>) or
2082(C<critical>) or higher (see L<AnyEvent::Log>). You can set this 2080higher (see L<AnyEvent::Log>). You can set this environment variable to a
2083environment variable to a numerical loglevel to make AnyEvent more (or 2081numerical loglevel to make AnyEvent more (or less) talkative.
2084less) talkative.
2085 2082
2086If you want to do more than just set the global logging level 2083If you want to do more than just set the global logging level
2087you should have a look at C<PERL_ANYEVENT_LOG>, which allows much more 2084you should have a look at C<PERL_ANYEVENT_LOG>, which allows much more
2088complex specifications. 2085complex specifications.
2089 2086
2090When set to C<0> (C<off>), then no messages whatsoever will be logged with 2087When set to C<0> (C<off>), then no messages whatsoever will be logged with
2091the default logging settings. 2088everything else at defaults.
2092 2089
2093When set to C<5> or higher (C<warn>), causes AnyEvent to warn about 2090When set to C<5> or higher (C<warn>), AnyEvent warns about unexpected
2094unexpected conditions, such as not being able to load the event model 2091conditions, such as not being able to load the event model specified by
2095specified by C<PERL_ANYEVENT_MODEL>, or a guard callback throwing an 2092C<PERL_ANYEVENT_MODEL>, or a guard callback throwing an exception - this
2096exception - this is the minimum recommended level. 2093is the minimum recommended level for use during development.
2097 2094
2098When set to C<7> or higher (info), cause AnyEvent to report which event model it 2095When set to C<7> or higher (info), AnyEvent reports which event model it
2099chooses. 2096chooses.
2100 2097
2101When set to C<8> or higher (debug), then AnyEvent will report extra information on 2098When set to C<8> or higher (debug), then AnyEvent will report extra
2102which optional modules it loads and how it implements certain features. 2099information on which optional modules it loads and how it implements
2100certain features.
2103 2101
2104=item C<PERL_ANYEVENT_LOG> 2102=item C<PERL_ANYEVENT_LOG>
2105 2103
2106Accepts rather complex logging specifications. For example, you could log 2104Accepts rather complex logging specifications. For example, you could log
2107all C<debug> messages of some module to stderr, warnings and above to 2105all C<debug> messages of some module to stderr, warnings and above to
2114This variable is evaluated when AnyEvent (or L<AnyEvent::Log>) is loaded, 2112This variable is evaluated when AnyEvent (or L<AnyEvent::Log>) is loaded,
2115so will take effect even before AnyEvent has initialised itself. 2113so will take effect even before AnyEvent has initialised itself.
2116 2114
2117Note that specifying this environment variable causes the L<AnyEvent::Log> 2115Note that specifying this environment variable causes the L<AnyEvent::Log>
2118module to be loaded, while C<PERL_ANYEVENT_VERBOSE> does not, so only 2116module to be loaded, while C<PERL_ANYEVENT_VERBOSE> does not, so only
2119using the latter saves a few hundred kB of memory until the first message 2117using the latter saves a few hundred kB of memory unless a module
2120is being logged. 2118explicitly needs the extra features of AnyEvent::Log.
2121 2119
2122=item C<PERL_ANYEVENT_STRICT> 2120=item C<PERL_ANYEVENT_STRICT>
2123 2121
2124AnyEvent does not do much argument checking by default, as thorough 2122AnyEvent does not do much argument checking by default, as thorough
2125argument checking is very costly. Setting this variable to a true value 2123argument checking is very costly. Setting this variable to a true value
2179 2177
2180For example, to force the pure perl model (L<AnyEvent::Loop::Perl>) you 2178For example, to force the pure perl model (L<AnyEvent::Loop::Perl>) you
2181could start your program like this: 2179could start your program like this:
2182 2180
2183 PERL_ANYEVENT_MODEL=Perl perl ... 2181 PERL_ANYEVENT_MODEL=Perl perl ...
2182
2183=item C<PERL_ANYEVENT_IO_MODEL>
2184
2185The current file I/O model - see L<AnyEvent::IO> for more info.
2186
2187At the moment, only C<Perl> (small, pure-perl, synchronous) and
2188C<IOAIO> (truly asynchronous) are supported. The default is C<IOAIO> if
2189L<AnyEvent::AIO> can be loaded, otherwise it is C<Perl>.
2184 2190
2185=item C<PERL_ANYEVENT_PROTOCOLS> 2191=item C<PERL_ANYEVENT_PROTOCOLS>
2186 2192
2187Used by both L<AnyEvent::DNS> and L<AnyEvent::Socket> to determine preferences 2193Used by both L<AnyEvent::DNS> and L<AnyEvent::Socket> to determine preferences
2188for IPv4 or IPv6. The default is unspecified (and might change, or be the result 2194for IPv4 or IPv6. The default is unspecified (and might change, or be the result
3007L<AnyEvent::Impl::FLTK>. 3013L<AnyEvent::Impl::FLTK>.
3008 3014
3009Non-blocking handles, pipes, stream sockets, TCP clients and 3015Non-blocking handles, pipes, stream sockets, TCP clients and
3010servers: L<AnyEvent::Handle>, L<AnyEvent::Socket>, L<AnyEvent::TLS>. 3016servers: L<AnyEvent::Handle>, L<AnyEvent::Socket>, L<AnyEvent::TLS>.
3011 3017
3018Asynchronous File I/O: L<AnyEvent::IO>.
3019
3012Asynchronous DNS: L<AnyEvent::DNS>. 3020Asynchronous DNS: L<AnyEvent::DNS>.
3013 3021
3014Thread support: L<Coro>, L<Coro::AnyEvent>, L<Coro::EV>, L<Coro::Event>. 3022Thread support: L<Coro>, L<Coro::AnyEvent>, L<Coro::EV>, L<Coro::Event>.
3015 3023
3016Nontrivial usage examples: L<AnyEvent::GPSD>, L<AnyEvent::IRC>, 3024Nontrivial usage examples: L<AnyEvent::GPSD>, L<AnyEvent::IRC>,
3018 3026
3019 3027
3020=head1 AUTHOR 3028=head1 AUTHOR
3021 3029
3022 Marc Lehmann <schmorp@schmorp.de> 3030 Marc Lehmann <schmorp@schmorp.de>
3023 http://home.schmorp.de/ 3031 http://anyevent.schmorp.de
3024 3032
3025=cut 3033=cut
3026 3034
30271 30351
3028 3036

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines