| … | |
… | |
| 1233 | |
1233 | |
| 1234 | BEGIN { AnyEvent::common_sense } |
1234 | BEGIN { AnyEvent::common_sense } |
| 1235 | |
1235 | |
| 1236 | use Carp (); |
1236 | use Carp (); |
| 1237 | |
1237 | |
| 1238 | our $VERSION = '6.02'; |
1238 | our $VERSION = '6.12'; |
| 1239 | our $MODEL; |
1239 | our $MODEL; |
| 1240 | our @ISA; |
1240 | our @ISA; |
| 1241 | our @REGISTRY; |
1241 | our @REGISTRY; |
| 1242 | our $VERBOSE; |
1242 | our $VERBOSE; |
| 1243 | our %PROTOCOL; # (ipv4|ipv6) => (1|2), higher numbers are preferred |
1243 | our %PROTOCOL; # (ipv4|ipv6) => (1|2), higher numbers are preferred |
| … | |
… | |
| 1302 | } |
1302 | } |
| 1303 | |
1303 | |
| 1304 | sub log($$;@) { |
1304 | sub log($$;@) { |
| 1305 | # 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 |
| 1306 | if ($_[0] <= ($VERBOSE || 1)) { # also catches non-numeric levels(!) and fatal |
1306 | if ($_[0] <= ($VERBOSE || 1)) { # also catches non-numeric levels(!) and fatal |
|
|
1307 | local ($!, $@); |
| 1307 | require AnyEvent::Log; # among other things, sets $VERBOSE to 9 |
1308 | require AnyEvent::Log; # among other things, sets $VERBOSE to 9 |
| 1308 | # AnyEvent::Log overwrites this function |
1309 | # AnyEvent::Log overwrites this function |
| 1309 | goto &log; |
1310 | goto &log; |
| 1310 | } |
1311 | } |
| 1311 | |
1312 | |
| 1312 | 0 # not logged |
1313 | 0 # not logged |
| 1313 | } |
1314 | } |
| 1314 | |
1315 | |
| 1315 | sub logger($;$) { |
1316 | sub _logger($;$) { |
| 1316 | package AnyEvent::Log; |
|
|
| 1317 | |
|
|
| 1318 | my ($level, $renabled) = @_; |
1317 | my ($level, $renabled) = @_; |
| 1319 | |
1318 | |
| 1320 | $$renabled = $level <= $VERBOSE; |
1319 | $$renabled = $level <= $VERBOSE; |
| 1321 | |
1320 | |
| 1322 | my $pkg = (caller)[0]; |
|
|
| 1323 | |
|
|
| 1324 | my $logger = [$pkg, $level, $renabled]; |
1321 | my $logger = [(caller)[0], $level, $renabled]; |
| 1325 | |
1322 | |
| 1326 | our %LOGGER; |
|
|
| 1327 | $LOGGER{$logger+0} = $logger; |
1323 | $AnyEvent::Log::LOGGER{$logger+0} = $logger; |
| 1328 | |
1324 | |
|
|
1325 | # return unless defined wantarray; |
|
|
1326 | # |
| 1329 | require AnyEvent::Util; |
1327 | # require AnyEvent::Util; |
| 1330 | my $guard = AnyEvent::Util::guard (sub { |
1328 | # my $guard = AnyEvent::Util::guard (sub { |
| 1331 | # "clean up" |
1329 | # # "clean up" |
| 1332 | delete $LOGGER{$logger+0}; |
1330 | # delete $LOGGER{$logger+0}; |
| 1333 | }); |
1331 | # }); |
| 1334 | |
1332 | # |
| 1335 | sub { |
1333 | # sub { |
| 1336 | return 0 unless $$renabled; |
1334 | # return 0 unless $$renabled; |
| 1337 | |
1335 | # |
| 1338 | $guard if 0; # keep guard alive, but don't cause runtime overhead |
1336 | # $guard if 0; # keep guard alive, but don't cause runtime overhead |
| 1339 | require AnyEvent::Log unless $AnyEvent::Log::VERSION; |
1337 | # require AnyEvent::Log unless $AnyEvent::Log::VERSION; |
| 1340 | package AnyEvent::Log; |
1338 | # package AnyEvent::Log; |
| 1341 | _log ($logger->[0], $level, @_) # logger->[0] has been converted at load time |
1339 | # _log ($logger->[0], $level, @_) # logger->[0] has been converted at load time |
| 1342 | } |
1340 | # } |
| 1343 | } |
1341 | } |
| 1344 | |
1342 | |
| 1345 | if (length $ENV{PERL_ANYEVENT_LOG}) { |
1343 | if (length $ENV{PERL_ANYEVENT_LOG}) { |
| 1346 | require AnyEvent::Log; # AnyEvent::Log does the thing for us |
1344 | require AnyEvent::Log; # AnyEvent::Log does the thing for us |
| 1347 | } |
1345 | } |
| … | |
… | |
| 1397 | |
1395 | |
| 1398 | # IO::Async::Loop::AnyEvent is extremely evil, refuse to work with it |
1396 | # 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 |
1397 | # 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 |
1398 | # (and the ability of others to use AnyEvent), but simply wants to abuse AnyEvent |
| 1401 | # anyway. |
1399 | # anyway. |
| 1402 | AnyEvent::log fatal => "AnyEvent: IO::Async::Loop::AnyEvent detected - this module is broken by design,\n" |
1400 | AnyEvent::log fatal => "AnyEvent: IO::Async::Loop::AnyEvent detected - that module is broken by\n" |
| 1403 | . "abuses internals and breaks AnyEvent, will not continue." |
1401 | . "design, abuses internals and breaks AnyEvent - will not continue." |
| 1404 | if exists $INC{"IO/Async/Loop/AnyEvent.pm"}; |
1402 | if exists $INC{"IO/Async/Loop/AnyEvent.pm"}; |
| 1405 | |
1403 | |
| 1406 | local $!; # for good measure |
1404 | local $!; # for good measure |
| 1407 | local $SIG{__DIE__}; # we use eval |
1405 | local $SIG{__DIE__}; # we use eval |
| 1408 | |
1406 | |
| … | |
… | |
| 1434 | if (${"$package\::VERSION"} > 0) { |
1432 | if (${"$package\::VERSION"} > 0) { |
| 1435 | if (eval "require $model") { |
1433 | if (eval "require $model") { |
| 1436 | AnyEvent::log 7 => "autodetected model '$model', using it."; |
1434 | AnyEvent::log 7 => "autodetected model '$model', using it."; |
| 1437 | $MODEL = $model; |
1435 | $MODEL = $model; |
| 1438 | last; |
1436 | last; |
|
|
1437 | } else { |
|
|
1438 | AnyEvent::log 8 => "detected event loop $package, but cannot load '$model', skipping: $@"; |
| 1439 | } |
1439 | } |
| 1440 | } |
1440 | } |
| 1441 | } |
1441 | } |
| 1442 | |
1442 | |
| 1443 | unless ($MODEL) { |
1443 | unless ($MODEL) { |
