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.254 by root, Fri Jul 24 08:40:35 2009 UTC vs.
Revision 1.265 by root, Wed Jul 29 13:10:58 2009 UTC

1=head1 NAME 1=head1 NAME
2 2
3AnyEvent - events independent of event loop implementation 3AnyEvent - the DBI of event loop programming
4 4
5EV, Event, Glib, Tk, Perl, Event::Lib, Qt and POE are various supported 5EV, Event, Glib, Tk, Perl, Event::Lib, Irssi, rxvt-unicode, IO::Async, Qt
6event loops. 6and POE are various supported event loops/environments.
7 7
8=head1 SYNOPSIS 8=head1 SYNOPSIS
9 9
10 use AnyEvent; 10 use AnyEvent;
11 11
… …
47 47
48There is a mailinglist for discussing all things AnyEvent, and an IRC 48There is a mailinglist for discussing all things AnyEvent, and an IRC
49channel, too. 49channel, too.
50 50
51See the AnyEvent project page at the B<Schmorpforge Ta-Sa Software 51See the AnyEvent project page at the B<Schmorpforge Ta-Sa Software
52Respository>, at L<http://anyevent.schmorp.de>, for more info. 52Repository>, at L<http://anyevent.schmorp.de>, for more info.
53 53
54=head1 WHY YOU SHOULD USE THIS MODULE (OR NOT) 54=head1 WHY YOU SHOULD USE THIS MODULE (OR NOT)
55 55
56Glib, POE, IO::Async, Event... CPAN offers event models by the dozen 56Glib, POE, IO::Async, Event... CPAN offers event models by the dozen
57nowadays. So what is different about AnyEvent? 57nowadays. So what is different about AnyEvent?
… …
1086 1086
1087BEGIN { AnyEvent::common_sense } 1087BEGIN { AnyEvent::common_sense }
1088 1088
1089use Carp (); 1089use Carp ();
1090 1090
1091our $VERSION = 4.86; 1091our $VERSION = 4.881;
1092our $MODEL; 1092our $MODEL;
1093 1093
1094our $AUTOLOAD; 1094our $AUTOLOAD;
1095our @ISA; 1095our @ISA;
1096 1096
… …
1289} 1289}
1290 1290
1291# default implementation for ->signal 1291# default implementation for ->signal
1292 1292
1293our $HAVE_ASYNC_INTERRUPT; 1293our $HAVE_ASYNC_INTERRUPT;
1294
1295sub _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
1294our ($SIGPIPE_R, $SIGPIPE_W, %SIG_CB, %SIG_EV, $SIG_IO); 1303our ($SIGPIPE_R, $SIGPIPE_W, %SIG_CB, %SIG_EV, $SIG_IO);
1295our (%SIG_ASY, %SIG_ASY_W); 1304our (%SIG_ASY, %SIG_ASY_W);
1296our ($SIG_COUNT, $SIG_TW); 1305our ($SIG_COUNT, $SIG_TW);
1297 1306
1298sub _signal_exec { 1307sub _signal_exec {
… …
1306 $_->() for values %{ $SIG_CB{$_} || {} }; 1315 $_->() for values %{ $SIG_CB{$_} || {} };
1307 } 1316 }
1308 } 1317 }
1309} 1318}
1310 1319
1311# install a dumym wakeupw atcher to reduce signal catching latency 1320# install a dummy wakeup watcher to reduce signal catching latency
1312sub _sig_add() { 1321sub _sig_add() {
1313 unless ($SIG_COUNT++) { 1322 unless ($SIG_COUNT++) {
1314 # try to align timer on a full-second boundary, if possible 1323 # try to align timer on a full-second boundary, if possible
1315 my $NOW = AnyEvent->now; 1324 my $NOW = AnyEvent->now;
1316 1325
… …
1325sub _sig_del { 1334sub _sig_del {
1326 undef $SIG_TW 1335 undef $SIG_TW
1327 unless --$SIG_COUNT; 1336 unless --$SIG_COUNT;
1328} 1337}
1329 1338
1339our $_sig_name_init; $_sig_name_init = sub {
1340 eval q{ # poor man's autoloading
1341 undef $_sig_name_init;
1342
1343 if (_have_async_interrupt) {
1344 *sig2num = \&Async::Interrupt::sig2num;
1345 *sig2name = \&Async::Interrupt::sig2name;
1346 } else {
1347 require Config;
1348
1349 my %signame2num;
1350 @signame2num{ split ' ', $Config::Config{sig_name} }
1351 = split ' ', $Config::Config{sig_num};
1352
1353 my @signum2name;
1354 @signum2name[values %signame2num] = keys %signame2num;
1355
1356 *sig2num = sub($) {
1357 $_[0] > 0 ? shift : $signame2num{+shift}
1358 };
1359 *sig2name = sub ($) {
1360 $_[0] > 0 ? $signum2name[+shift] : shift
1361 };
1362 }
1363 };
1364 die if $@;
1365};
1366
1367sub sig2num ($) { &$_sig_name_init; &sig2num }
1368sub sig2name($) { &$_sig_name_init; &sig2name }
1369
1330sub _signal { 1370sub signal {
1371 eval q{ # poor man's autoloading {}
1372 # probe for availability of Async::Interrupt
1373 if (_have_async_interrupt) {
1374 warn "AnyEvent: using Async::Interrupt for race-free signal handling.\n" if $VERBOSE >= 8;
1375
1376 $SIGPIPE_R = new Async::Interrupt::EventPipe;
1377 $SIG_IO = AnyEvent->io (fh => $SIGPIPE_R->fileno, poll => "r", cb => \&_signal_exec);
1378
1379 } else {
1380 warn "AnyEvent: using emulated perl signal handling with latency timer.\n" if $VERBOSE >= 8;
1381
1382 require Fcntl;
1383
1384 if (AnyEvent::WIN32) {
1385 require AnyEvent::Util;
1386
1387 ($SIGPIPE_R, $SIGPIPE_W) = AnyEvent::Util::portable_pipe ();
1388 AnyEvent::Util::fh_nonblocking ($SIGPIPE_R, 1) if $SIGPIPE_R;
1389 AnyEvent::Util::fh_nonblocking ($SIGPIPE_W, 1) if $SIGPIPE_W; # just in case
1390 } else {
1391 pipe $SIGPIPE_R, $SIGPIPE_W;
1392 fcntl $SIGPIPE_R, &Fcntl::F_SETFL, &Fcntl::O_NONBLOCK if $SIGPIPE_R;
1393 fcntl $SIGPIPE_W, &Fcntl::F_SETFL, &Fcntl::O_NONBLOCK if $SIGPIPE_W; # just in case
1394
1395 # not strictly required, as $^F is normally 2, but let's make sure...
1396 fcntl $SIGPIPE_R, &Fcntl::F_SETFD, &Fcntl::FD_CLOEXEC;
1397 fcntl $SIGPIPE_W, &Fcntl::F_SETFD, &Fcntl::FD_CLOEXEC;
1398 }
1399
1400 $SIGPIPE_R
1401 or Carp::croak "AnyEvent: unable to create a signal reporting pipe: $!\n";
1402
1403 $SIG_IO = AnyEvent->io (fh => $SIGPIPE_R, poll => "r", cb => \&_signal_exec);
1404 }
1405
1406 *signal = sub {
1331 my (undef, %arg) = @_; 1407 my (undef, %arg) = @_;
1332 1408
1333 my $signal = uc $arg{signal} 1409 my $signal = uc $arg{signal}
1334 or Carp::croak "required option 'signal' is missing"; 1410 or Carp::croak "required option 'signal' is missing";
1335 1411
1336 $SIG_CB{$signal}{$arg{cb}} = $arg{cb};
1337
1338 if ($HAVE_ASYNC_INTERRUPT) { 1412 if ($HAVE_ASYNC_INTERRUPT) {
1339 # async::interrupt 1413 # async::interrupt
1340 1414
1341 $SIG_ASY{$signal} ||= do { 1415 $signal = sig2num $signal;
1342 my $asy = new Async::Interrupt 1416 $SIG_CB{$signal}{$arg{cb}} = $arg{cb};
1417
1418 $SIG_ASY{$signal} ||= new Async::Interrupt
1343 cb => sub { undef $SIG_EV{$signal} }, 1419 cb => sub { undef $SIG_EV{$signal} },
1344 signal => $signal, 1420 signal => $signal,
1345 pipe => [$SIGPIPE_R->filenos], 1421 pipe => [$SIGPIPE_R->filenos],
1422 pipe_autodrain => 0,
1423 ;
1424
1425 } else {
1426 # pure perl
1427
1428 # AE::Util has been loaded in signal
1429 $signal = sig2name $signal;
1430 $SIG_CB{$signal}{$arg{cb}} = $arg{cb};
1431
1432 $SIG{$signal} ||= sub {
1433 local $!;
1434 syswrite $SIGPIPE_W, "\x00", 1 unless %SIG_EV;
1435 undef $SIG_EV{$signal};
1436 };
1437
1438 # can't do signal processing without introducing races in pure perl,
1439 # so limit the signal latency.
1440 _sig_add;
1346 ; 1441 }
1347 $asy->pipe_autodrain (0);
1348 1442
1349 $asy 1443 bless [$signal, $arg{cb}], "AnyEvent::Base::signal"
1350 }; 1444 };
1351 1445
1352 } else { 1446 *AnyEvent::Base::signal::DESTROY = sub {
1353 # pure perl 1447 my ($signal, $cb) = @{$_[0]};
1354 1448
1355 $SIG{$signal} ||= sub { 1449 _sig_del;
1356 local $!; 1450
1357 syswrite $SIGPIPE_W, "\x00", 1 unless %SIG_EV; 1451 delete $SIG_CB{$signal}{$cb};
1452
1453 $HAVE_ASYNC_INTERRUPT
1454 ? delete $SIG_ASY{$signal}
1455 : # delete doesn't work with older perls - they then
1456 # print weird messages, or just unconditionally exit
1457 # instead of getting the default action.
1358 undef $SIG_EV{$signal}; 1458 undef $SIG{$signal}
1459 unless keys %{ $SIG_CB{$signal} };
1359 }; 1460 };
1360
1361 # can't do signal processing without introducing races in pure perl,
1362 # so limit the signal latency.
1363 _sig_add;
1364 } 1461 };
1365 1462 die if $@;
1366 bless [$signal, $arg{cb}], "AnyEvent::Base::signal"
1367}
1368
1369sub signal {
1370 # probe for availability of Async::Interrupt
1371 if (!$ENV{PERL_ANYEVENT_AVOID_ASYNC_INTERRUPT} && eval "use Async::Interrupt 0.6 (); 1") {
1372 warn "AnyEvent: using Async::Interrupt for race-free signal handling.\n" if $VERBOSE >= 8;
1373
1374 $HAVE_ASYNC_INTERRUPT = 1;
1375 $SIGPIPE_R = new Async::Interrupt::EventPipe;
1376 $SIG_IO = AnyEvent->io (fh => $SIGPIPE_R->fileno, poll => "r", cb => \&_signal_exec);
1377
1378 } else {
1379 warn "AnyEvent: using emulated perl signal handling with latency timer.\n" if $VERBOSE >= 8;
1380
1381 require Fcntl;
1382
1383 if (AnyEvent::WIN32) {
1384 require AnyEvent::Util;
1385
1386 ($SIGPIPE_R, $SIGPIPE_W) = AnyEvent::Util::portable_pipe ();
1387 AnyEvent::Util::fh_nonblocking ($SIGPIPE_R) if $SIGPIPE_R;
1388 AnyEvent::Util::fh_nonblocking ($SIGPIPE_W) if $SIGPIPE_W; # just in case
1389 } else {
1390 pipe $SIGPIPE_R, $SIGPIPE_W;
1391 fcntl $SIGPIPE_R, &Fcntl::F_SETFL, &Fcntl::O_NONBLOCK if $SIGPIPE_R;
1392 fcntl $SIGPIPE_W, &Fcntl::F_SETFL, &Fcntl::O_NONBLOCK if $SIGPIPE_W; # just in case
1393
1394 # not strictly required, as $^F is normally 2, but let's make sure...
1395 fcntl $SIGPIPE_R, &Fcntl::F_SETFD, &Fcntl::FD_CLOEXEC;
1396 fcntl $SIGPIPE_W, &Fcntl::F_SETFD, &Fcntl::FD_CLOEXEC;
1397 }
1398
1399 $SIGPIPE_R
1400 or Carp::croak "AnyEvent: unable to create a signal reporting pipe: $!\n";
1401
1402 $SIG_IO = AnyEvent->io (fh => $SIGPIPE_R, poll => "r", cb => \&_signal_exec);
1403 }
1404
1405 *signal = \&_signal;
1406 &signal 1463 &signal
1407}
1408
1409sub AnyEvent::Base::signal::DESTROY {
1410 my ($signal, $cb) = @{$_[0]};
1411
1412 _sig_del;
1413
1414 delete $SIG_CB{$signal}{$cb};
1415
1416 $HAVE_ASYNC_INTERRUPT
1417 ? delete $SIG_ASY{$signal}
1418 : # delete doesn't work with older perls - they then
1419 # print weird messages, or just unconditionally exit
1420 # instead of getting the default action.
1421 undef $SIG{$signal}
1422 unless keys %{ $SIG_CB{$signal} };
1423} 1464}
1424 1465
1425# default implementation for ->child 1466# default implementation for ->child
1426 1467
1427our %PID_CB; 1468our %PID_CB;

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines