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

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines