… | |
… | |
1289 | } |
1289 | } |
1290 | |
1290 | |
1291 | # default implementation for ->signal |
1291 | # default implementation for ->signal |
1292 | |
1292 | |
1293 | our $HAVE_ASYNC_INTERRUPT; |
1293 | our $HAVE_ASYNC_INTERRUPT; |
|
|
1294 | |
|
|
1295 | sub _have_async_interrupt() { |
|
|
1296 | $HAVE_ASYNC_INTERRUPT = 1*(!$ENV{PERL_ANYEVENT_AVOID_ASYNC_INTERRUPT} |
|
|
1297 | && eval "use Async::Interrupt 1.0 (); 1") |
|
|
1298 | unless defined $HAVE_ASYNC_INTERRUPT; |
|
|
1299 | |
|
|
1300 | $HAVE_ASYNC_INTERRUPT |
|
|
1301 | } |
|
|
1302 | |
1294 | our ($SIGPIPE_R, $SIGPIPE_W, %SIG_CB, %SIG_EV, $SIG_IO); |
1303 | our ($SIGPIPE_R, $SIGPIPE_W, %SIG_CB, %SIG_EV, $SIG_IO); |
1295 | our (%SIG_ASY, %SIG_ASY_W); |
1304 | our (%SIG_ASY, %SIG_ASY_W); |
1296 | our ($SIG_COUNT, $SIG_TW); |
1305 | our ($SIG_COUNT, $SIG_TW); |
1297 | |
1306 | |
1298 | sub _signal_exec { |
1307 | sub _signal_exec { |
… | |
… | |
1325 | sub _sig_del { |
1334 | sub _sig_del { |
1326 | undef $SIG_TW |
1335 | undef $SIG_TW |
1327 | unless --$SIG_COUNT; |
1336 | unless --$SIG_COUNT; |
1328 | } |
1337 | } |
1329 | |
1338 | |
|
|
1339 | our $_sig_name_init; $_sig_name_init = sub { |
|
|
1340 | undef $_sig_name_init; |
|
|
1341 | |
|
|
1342 | if (_have_async_interrupt) { |
|
|
1343 | *sig2num = \&Async::Interrupt::sig2num; |
|
|
1344 | *sig2name = \&Async::Interrupt::sig2name; |
|
|
1345 | } else { |
|
|
1346 | require Config; |
|
|
1347 | |
|
|
1348 | my %signame2num; |
|
|
1349 | @signame2num{ split ' ', $Config::Config{sig_name} } |
|
|
1350 | = split ' ', $Config::Config{sig_num}; |
|
|
1351 | |
|
|
1352 | my @signum2name; |
|
|
1353 | @signum2name[values %signame2num] = keys %signame2num; |
|
|
1354 | |
|
|
1355 | *sig2num = sub($) { |
|
|
1356 | $_[0] > 0 ? shift : $signame2num{+shift} |
|
|
1357 | }; |
|
|
1358 | *sig2name = sub ($) { |
|
|
1359 | $_[0] > 0 ? $signum2name[+shift] : shift |
|
|
1360 | }; |
|
|
1361 | } |
|
|
1362 | }; |
|
|
1363 | |
|
|
1364 | sub sig2num ($) { &$_sig_name_init; &sig2num } |
|
|
1365 | sub sig2name($) { &$_sig_name_init; &sig2name } |
|
|
1366 | |
1330 | sub _signal { |
1367 | sub _signal { |
1331 | my (undef, %arg) = @_; |
1368 | my (undef, %arg) = @_; |
1332 | |
1369 | |
1333 | my $signal = uc $arg{signal} |
1370 | my $signal = uc $arg{signal} |
1334 | or Carp::croak "required option 'signal' is missing"; |
1371 | or Carp::croak "required option 'signal' is missing"; |
1335 | |
1372 | |
1336 | if ($HAVE_ASYNC_INTERRUPT) { |
1373 | if ($HAVE_ASYNC_INTERRUPT) { |
1337 | # async::interrupt |
1374 | # async::interrupt |
1338 | |
1375 | |
1339 | $signal = Async::Interrupt::sig2num ($signal); |
1376 | $signal = sig2num $signal; |
1340 | $SIG_CB{$signal}{$arg{cb}} = $arg{cb}; |
1377 | $SIG_CB{$signal}{$arg{cb}} = $arg{cb}; |
1341 | |
1378 | |
1342 | $SIG_ASY{$signal} ||= do { |
1379 | $SIG_ASY{$signal} ||= new Async::Interrupt |
1343 | my $asy = new Async::Interrupt |
|
|
1344 | cb => sub { undef $SIG_EV{$signal} }, |
1380 | cb => sub { undef $SIG_EV{$signal} }, |
1345 | signal => $signal, |
1381 | signal => $signal, |
1346 | pipe => [$SIGPIPE_R->filenos], |
1382 | pipe => [$SIGPIPE_R->filenos], |
1347 | ; |
|
|
1348 | $asy->pipe_autodrain (0); |
1383 | pipe_autodrain => 0, |
1349 | |
|
|
1350 | $asy |
|
|
1351 | }; |
1384 | ; |
1352 | |
1385 | |
1353 | } else { |
1386 | } else { |
1354 | # pure perl |
1387 | # pure perl |
1355 | |
1388 | |
1356 | # AE::Util has been loaded in signal |
1389 | # AE::Util has been loaded in signal |
1357 | $signal = AnyEvent::Util::sig2name ($signal); |
1390 | $signal = sig2name $signal; |
1358 | $SIG_CB{$signal}{$arg{cb}} = $arg{cb}; |
1391 | $SIG_CB{$signal}{$arg{cb}} = $arg{cb}; |
1359 | |
1392 | |
1360 | $SIG{$signal} ||= sub { |
1393 | $SIG{$signal} ||= sub { |
1361 | local $!; |
1394 | local $!; |
1362 | syswrite $SIGPIPE_W, "\x00", 1 unless %SIG_EV; |
1395 | syswrite $SIGPIPE_W, "\x00", 1 unless %SIG_EV; |
… | |
… | |
1371 | bless [$signal, $arg{cb}], "AnyEvent::Base::signal" |
1404 | bless [$signal, $arg{cb}], "AnyEvent::Base::signal" |
1372 | } |
1405 | } |
1373 | |
1406 | |
1374 | sub signal { |
1407 | sub signal { |
1375 | # probe for availability of Async::Interrupt |
1408 | # probe for availability of Async::Interrupt |
1376 | if (!$ENV{PERL_ANYEVENT_AVOID_ASYNC_INTERRUPT} && eval "use Async::Interrupt 1.0 (); 1") { |
1409 | if (_have_async_interrupt) { |
1377 | warn "AnyEvent: using Async::Interrupt for race-free signal handling.\n" if $VERBOSE >= 8; |
1410 | warn "AnyEvent: using Async::Interrupt for race-free signal handling.\n" if $VERBOSE >= 8; |
1378 | |
1411 | |
1379 | $HAVE_ASYNC_INTERRUPT = 1; |
|
|
1380 | $SIGPIPE_R = new Async::Interrupt::EventPipe; |
1412 | $SIGPIPE_R = new Async::Interrupt::EventPipe; |
1381 | $SIG_IO = AnyEvent->io (fh => $SIGPIPE_R->fileno, poll => "r", cb => \&_signal_exec); |
1413 | $SIG_IO = AnyEvent->io (fh => $SIGPIPE_R->fileno, poll => "r", cb => \&_signal_exec); |
1382 | |
1414 | |
1383 | } else { |
1415 | } else { |
1384 | warn "AnyEvent: using emulated perl signal handling with latency timer.\n" if $VERBOSE >= 8; |
1416 | warn "AnyEvent: using emulated perl signal handling with latency timer.\n" if $VERBOSE >= 8; |