| … | |
… | |
| 1053 | |
1053 | |
| 1054 | BEGIN { AnyEvent::common_sense } |
1054 | BEGIN { AnyEvent::common_sense } |
| 1055 | |
1055 | |
| 1056 | use Carp (); |
1056 | use Carp (); |
| 1057 | |
1057 | |
| 1058 | our $VERSION = 4.83; |
1058 | our $VERSION = 4.85; |
| 1059 | our $MODEL; |
1059 | our $MODEL; |
| 1060 | |
1060 | |
| 1061 | our $AUTOLOAD; |
1061 | our $AUTOLOAD; |
| 1062 | our @ISA; |
1062 | our @ISA; |
| 1063 | |
1063 | |
| … | |
… | |
| 1270 | $_->() for values %{ $SIG_CB{$_} || {} }; |
1270 | $_->() for values %{ $SIG_CB{$_} || {} }; |
| 1271 | } |
1271 | } |
| 1272 | } |
1272 | } |
| 1273 | } |
1273 | } |
| 1274 | |
1274 | |
|
|
1275 | # install a dumym wakeupw atcher to reduce signal catching latency |
|
|
1276 | sub _sig_add() { |
|
|
1277 | unless ($SIG_COUNT++) { |
|
|
1278 | # try to align timer on a full-second boundary, if possible |
|
|
1279 | my $NOW = AnyEvent->now; |
|
|
1280 | |
|
|
1281 | $SIG_TW = AnyEvent->timer ( |
|
|
1282 | after => $MAX_SIGNAL_LATENCY - ($NOW - int $NOW), |
|
|
1283 | interval => $MAX_SIGNAL_LATENCY, |
|
|
1284 | cb => sub { }, # just for the PERL_ASYNC_CHECK |
|
|
1285 | ); |
|
|
1286 | } |
|
|
1287 | } |
|
|
1288 | |
|
|
1289 | sub _sig_del { |
|
|
1290 | undef $SIG_TW |
|
|
1291 | unless --$SIG_COUNT; |
|
|
1292 | } |
|
|
1293 | |
| 1275 | sub _signal { |
1294 | sub _signal { |
| 1276 | my (undef, %arg) = @_; |
1295 | my (undef, %arg) = @_; |
| 1277 | |
1296 | |
| 1278 | my $signal = uc $arg{signal} |
1297 | my $signal = uc $arg{signal} |
| 1279 | or Carp::croak "required option 'signal' is missing"; |
1298 | or Carp::croak "required option 'signal' is missing"; |
| … | |
… | |
| 1303 | undef $SIG_EV{$signal}; |
1322 | undef $SIG_EV{$signal}; |
| 1304 | }; |
1323 | }; |
| 1305 | |
1324 | |
| 1306 | # can't do signal processing without introducing races in pure perl, |
1325 | # can't do signal processing without introducing races in pure perl, |
| 1307 | # so limit the signal latency. |
1326 | # so limit the signal latency. |
| 1308 | ++$SIG_COUNT; |
1327 | _sig_add; |
| 1309 | $SIG_TW ||= AnyEvent->timer ( |
|
|
| 1310 | after => $MAX_SIGNAL_LATENCY, |
|
|
| 1311 | interval => $MAX_SIGNAL_LATENCY, |
|
|
| 1312 | cb => sub { }, # just for the PERL_ASYNC_CHECK |
|
|
| 1313 | ); |
|
|
| 1314 | } |
1328 | } |
| 1315 | |
1329 | |
| 1316 | bless [$signal, $arg{cb}], "AnyEvent::Base::signal" |
1330 | bless [$signal, $arg{cb}], "AnyEvent::Base::signal" |
| 1317 | } |
1331 | } |
| 1318 | |
1332 | |
| … | |
… | |
| 1357 | } |
1371 | } |
| 1358 | |
1372 | |
| 1359 | sub AnyEvent::Base::signal::DESTROY { |
1373 | sub AnyEvent::Base::signal::DESTROY { |
| 1360 | my ($signal, $cb) = @{$_[0]}; |
1374 | my ($signal, $cb) = @{$_[0]}; |
| 1361 | |
1375 | |
| 1362 | undef $SIG_TW |
1376 | _sig_del; |
| 1363 | unless --$SIG_COUNT; |
|
|
| 1364 | |
1377 | |
| 1365 | delete $SIG_CB{$signal}{$cb}; |
1378 | delete $SIG_CB{$signal}{$cb}; |
| 1366 | |
1379 | |
|
|
1380 | $HAVE_ASYNC_INTERRUPT |
|
|
1381 | ? delete $SIG_ASY{$signal} |
| 1367 | # delete doesn't work with older perls - they then |
1382 | : # delete doesn't work with older perls - they then |
| 1368 | # print weird messages, or just unconditionally exit |
1383 | # print weird messages, or just unconditionally exit |
| 1369 | # instead of getting the default action. |
1384 | # instead of getting the default action. |
| 1370 | undef $SIG{$signal} |
1385 | undef $SIG{$signal} |
| 1371 | unless keys %{ $SIG_CB{$signal} }; |
1386 | unless keys %{ $SIG_CB{$signal} }; |
| 1372 | } |
1387 | } |
| 1373 | |
1388 | |
| 1374 | # default implementation for ->child |
1389 | # default implementation for ->child |
| 1375 | |
1390 | |
