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.306 by root, Tue Dec 15 05:49:13 2009 UTC vs.
Revision 1.320 by root, Mon Apr 12 02:50:31 2010 UTC

7 7
8=head1 SYNOPSIS 8=head1 SYNOPSIS
9 9
10 use AnyEvent; 10 use AnyEvent;
11 11
12 # if you prefer function calls, look at the L<AE> manpage for
13 # an alternative API.
14
12 # file descriptor readable 15 # file handle or descriptor readable
13 my $w = AnyEvent->io (fh => $fh, poll => "r", cb => sub { ... }); 16 my $w = AnyEvent->io (fh => $fh, poll => "r", cb => sub { ... });
14 17
15 # one-shot or repeating timers 18 # one-shot or repeating timers
16 my $w = AnyEvent->timer (after => $seconds, cb => sub { ... }); 19 my $w = AnyEvent->timer (after => $seconds, cb => sub { ... });
17 my $w = AnyEvent->timer (after => $seconds, interval => $seconds, cb => ... 20 my $w = AnyEvent->timer (after => $seconds, interval => $seconds, cb => ...
503 506
504=head2 IDLE WATCHERS 507=head2 IDLE WATCHERS
505 508
506 $w = AnyEvent->idle (cb => <callback>); 509 $w = AnyEvent->idle (cb => <callback>);
507 510
508Sometimes there is a need to do something, but it is not so important 511Repeatedly invoke the callback after the process becomes idle, until
509to do it instantly, but only when there is nothing better to do. This 512either the watcher is destroyed or new events have been detected.
510"nothing better to do" is usually defined to be "no other events need
511attention by the event loop".
512 513
513Idle watchers ideally get invoked when the event loop has nothing 514Idle watchers are useful when there is a need to do something, but it
514better to do, just before it would block the process to wait for new 515is not so important (or wise) to do it instantly. The callback will be
515events. Instead of blocking, the idle watcher is invoked. 516invoked only when there is "nothing better to do", which is usually
517defined as "all outstanding events have been handled and no new events
518have been detected". That means that idle watchers ideally get invoked
519when the event loop has just polled for new events but none have been
520detected. Instead of blocking to wait for more events, the idle watchers
521will be invoked.
516 522
517Most event loops unfortunately do not really support idle watchers (only 523Unfortunately, most event loops do not really support idle watchers (only
518EV, Event and Glib do it in a usable fashion) - for the rest, AnyEvent 524EV, Event and Glib do it in a usable fashion) - for the rest, AnyEvent
519will simply call the callback "from time to time". 525will simply call the callback "from time to time".
520 526
521Example: read lines from STDIN, but only process them when the 527Example: read lines from STDIN, but only process them when the
522program is otherwise idle: 528program is otherwise idle:
603eventually calls C<< -> send >>, and the "consumer side", which waits 609eventually calls C<< -> send >>, and the "consumer side", which waits
604for the send to occur. 610for the send to occur.
605 611
606Example: wait for a timer. 612Example: wait for a timer.
607 613
608 # wait till the result is ready 614 # condition: "wait till the timer is fired"
609 my $result_ready = AnyEvent->condvar; 615 my $timer_fired = AnyEvent->condvar;
610 616
611 # do something such as adding a timer 617 # create the timer - we could wait for, say
612 # or socket watcher the calls $result_ready->send 618 # a handle becomign ready, or even an
613 # when the "result" is ready. 619 # AnyEvent::HTTP request to finish, but
614 # in this case, we simply use a timer: 620 # in this case, we simply use a timer:
615 my $w = AnyEvent->timer ( 621 my $w = AnyEvent->timer (
616 after => 1, 622 after => 1,
617 cb => sub { $result_ready->send }, 623 cb => sub { $timer_fired->send },
618 ); 624 );
619 625
620 # this "blocks" (while handling events) till the callback 626 # this "blocks" (while handling events) till the callback
621 # calls ->send 627 # calls ->send
622 $result_ready->recv; 628 $timer_fired->recv;
623 629
624Example: wait for a timer, but take advantage of the fact that condition 630Example: wait for a timer, but take advantage of the fact that condition
625variables are also callable directly. 631variables are also callable directly.
626 632
627 my $done = AnyEvent->condvar; 633 my $done = AnyEvent->condvar;
1153 1159
1154BEGIN { AnyEvent::common_sense } 1160BEGIN { AnyEvent::common_sense }
1155 1161
1156use Carp (); 1162use Carp ();
1157 1163
1158our $VERSION = '5.22'; 1164our $VERSION = '5.26';
1159our $MODEL; 1165our $MODEL;
1160 1166
1161our $AUTOLOAD; 1167our $AUTOLOAD;
1162our @ISA; 1168our @ISA;
1163 1169
1164our @REGISTRY; 1170our @REGISTRY;
1165 1171
1166our $VERBOSE; 1172our $VERBOSE;
1167 1173
1168BEGIN { 1174BEGIN {
1169 eval "sub WIN32(){ " . (($^O =~ /mswin32/i)*1) ." }"; 1175 require "AnyEvent/constants.pl";
1176
1170 eval "sub TAINT(){ " . (${^TAINT}*1) . " }"; 1177 eval "sub TAINT (){" . (${^TAINT}*1) . "}";
1171 1178
1172 delete @ENV{grep /^PERL_ANYEVENT_/, keys %ENV} 1179 delete @ENV{grep /^PERL_ANYEVENT_/, keys %ENV}
1173 if ${^TAINT}; 1180 if ${^TAINT};
1174 1181
1175 $VERBOSE = $ENV{PERL_ANYEVENT_VERBOSE}*1; 1182 $VERBOSE = $ENV{PERL_ANYEVENT_VERBOSE}*1;
1218our @post_detect; 1225our @post_detect;
1219 1226
1220sub post_detect(&) { 1227sub post_detect(&) {
1221 my ($cb) = @_; 1228 my ($cb) = @_;
1222 1229
1223 if ($MODEL) {
1224 $cb->();
1225
1226 undef
1227 } else {
1228 push @post_detect, $cb; 1230 push @post_detect, $cb;
1229 1231
1230 defined wantarray 1232 defined wantarray
1231 ? bless \$cb, "AnyEvent::Util::postdetect" 1233 ? bless \$cb, "AnyEvent::Util::postdetect"
1232 : () 1234 : ()
1233 }
1234} 1235}
1235 1236
1236sub AnyEvent::Util::postdetect::DESTROY { 1237sub AnyEvent::Util::postdetect::DESTROY {
1237 @post_detect = grep $_ != ${$_[0]}, @post_detect; 1238 @post_detect = grep $_ != ${$_[0]}, @post_detect;
1238} 1239}
1239 1240
1240sub detect() { 1241sub detect() {
1242 # free some memory
1243 *detect = sub () { $MODEL };
1244
1245 local $!; # for good measure
1246 local $SIG{__DIE__};
1247
1248 if ($ENV{PERL_ANYEVENT_MODEL} =~ /^([a-zA-Z]+)$/) {
1249 my $model = "AnyEvent::Impl::$1";
1250 if (eval "require $model") {
1251 $MODEL = $model;
1252 warn "AnyEvent: loaded model '$model' (forced by \$ENV{PERL_ANYEVENT_MODEL}), using it.\n" if $VERBOSE >= 2;
1253 } else {
1254 warn "AnyEvent: unable to load model '$model' (from \$ENV{PERL_ANYEVENT_MODEL}):\n$@" if $VERBOSE;
1255 }
1256 }
1257
1258 # check for already loaded models
1241 unless ($MODEL) { 1259 unless ($MODEL) {
1242 local $SIG{__DIE__}; 1260 for (@REGISTRY, @models) {
1243 1261 my ($package, $model) = @$_;
1244 if ($ENV{PERL_ANYEVENT_MODEL} =~ /^([a-zA-Z]+)$/) { 1262 if (${"$package\::VERSION"} > 0) {
1245 my $model = "AnyEvent::Impl::$1";
1246 if (eval "require $model") { 1263 if (eval "require $model") {
1247 $MODEL = $model; 1264 $MODEL = $model;
1248 warn "AnyEvent: loaded model '$model' (forced by \$ENV{PERL_ANYEVENT_MODEL}), using it.\n" if $VERBOSE >= 2; 1265 warn "AnyEvent: autodetected model '$model', using it.\n" if $VERBOSE >= 2;
1249 } else { 1266 last;
1250 warn "AnyEvent: unable to load model '$model' (from \$ENV{PERL_ANYEVENT_MODEL}):\n$@" if $VERBOSE; 1267 }
1251 } 1268 }
1252 } 1269 }
1253 1270
1254 # check for already loaded models
1255 unless ($MODEL) { 1271 unless ($MODEL) {
1272 # try to autoload a model
1256 for (@REGISTRY, @models) { 1273 for (@REGISTRY, @models) {
1257 my ($package, $model) = @$_; 1274 my ($package, $model, $autoload) = @$_;
1275 if (
1276 $autoload
1277 and eval "require $package"
1258 if (${"$package\::VERSION"} > 0) { 1278 and ${"$package\::VERSION"} > 0
1259 if (eval "require $model") { 1279 and eval "require $model"
1280 ) {
1260 $MODEL = $model; 1281 $MODEL = $model;
1261 warn "AnyEvent: autodetected model '$model', using it.\n" if $VERBOSE >= 2; 1282 warn "AnyEvent: autoloaded model '$model', using it.\n" if $VERBOSE >= 2;
1262 last; 1283 last;
1263 }
1264 } 1284 }
1265 } 1285 }
1266 1286
1267 unless ($MODEL) {
1268 # try to autoload a model
1269 for (@REGISTRY, @models) {
1270 my ($package, $model, $autoload) = @$_;
1271 if (
1272 $autoload
1273 and eval "require $package"
1274 and ${"$package\::VERSION"} > 0
1275 and eval "require $model"
1276 ) {
1277 $MODEL = $model;
1278 warn "AnyEvent: autoloaded model '$model', using it.\n" if $VERBOSE >= 2;
1279 last;
1280 }
1281 }
1282
1283 $MODEL 1287 $MODEL
1284 or die "No event module selected for AnyEvent and autodetect failed. Install any one of these modules: EV, Event or Glib.\n"; 1288 or die "No event module selected for AnyEvent and autodetect failed. Install any one of these modules: EV, Event or Glib.\n";
1285 }
1286 } 1289 }
1287
1288 push @{"$MODEL\::ISA"}, "AnyEvent::Base";
1289
1290 unshift @ISA, $MODEL;
1291
1292 require AnyEvent::Strict if $ENV{PERL_ANYEVENT_STRICT};
1293
1294 (shift @post_detect)->() while @post_detect;
1295 } 1290 }
1291
1292 @models = (); # free probe data
1293
1294 push @{"$MODEL\::ISA"}, "AnyEvent::Base";
1295 unshift @ISA, $MODEL;
1296
1297 # now nuke some methods that are overriden by the backend.
1298 # SUPER is not allowed.
1299 for (qw(time signal child idle)) {
1300 undef &{"AnyEvent::Base::$_"}
1301 if defined &{"$MODEL\::$_"};
1302 }
1303
1304 require AnyEvent::Strict if $ENV{PERL_ANYEVENT_STRICT};
1305
1306 (shift @post_detect)->() while @post_detect;
1307
1308 *post_detect = sub(&) {
1309 shift->();
1310
1311 undef
1312 };
1296 1313
1297 $MODEL 1314 $MODEL
1298} 1315}
1299 1316
1300sub AUTOLOAD { 1317sub AUTOLOAD {
1301 (my $func = $AUTOLOAD) =~ s/.*://; 1318 (my $func = $AUTOLOAD) =~ s/.*://;
1302 1319
1303 $method{$func} 1320 $method{$func}
1304 or Carp::croak "$func: not a valid method for AnyEvent objects"; 1321 or Carp::croak "$func: not a valid AnyEvent class method";
1305 1322
1306 detect unless $MODEL; 1323 detect;
1307 1324
1308 my $class = shift; 1325 my $class = shift;
1309 $class->$func (@_); 1326 $class->$func (@_);
1310} 1327}
1311 1328
1328 1345
1329=head1 SIMPLIFIED AE API 1346=head1 SIMPLIFIED AE API
1330 1347
1331Starting with version 5.0, AnyEvent officially supports a second, much 1348Starting with version 5.0, AnyEvent officially supports a second, much
1332simpler, API that is designed to reduce the calling, typing and memory 1349simpler, API that is designed to reduce the calling, typing and memory
1333overhead. 1350overhead by using function call syntax and a fixed number of parameters.
1334 1351
1335See the L<AE> manpage for details. 1352See the L<AE> manpage for details.
1336 1353
1337=cut 1354=cut
1338 1355
1339package AE; 1356package AE;
1340 1357
1341our $VERSION = $AnyEvent::VERSION; 1358our $VERSION = $AnyEvent::VERSION;
1359
1360# fall back to the main API by default - backends and AnyEvent::Base
1361# implementations can overwrite these.
1342 1362
1343sub io($$$) { 1363sub io($$$) {
1344 AnyEvent->io (fh => $_[0], poll => $_[1] ? "w" : "r", cb => $_[2]) 1364 AnyEvent->io (fh => $_[0], poll => $_[1] ? "w" : "r", cb => $_[2])
1345} 1365}
1346 1366
1378 1398
1379package AnyEvent::Base; 1399package AnyEvent::Base;
1380 1400
1381# default implementations for many methods 1401# default implementations for many methods
1382 1402
1383sub _time() { 1403sub time {
1404 eval q{ # poor man's autoloading {}
1384 # probe for availability of Time::HiRes 1405 # probe for availability of Time::HiRes
1385 if (eval "use Time::HiRes (); Time::HiRes::time (); 1") { 1406 if (eval "use Time::HiRes (); Time::HiRes::time (); 1") {
1386 warn "AnyEvent: using Time::HiRes for sub-second timing accuracy.\n" if $VERBOSE >= 8; 1407 warn "AnyEvent: using Time::HiRes for sub-second timing accuracy.\n" if $VERBOSE >= 8;
1387 *_time = \&Time::HiRes::time; 1408 *AE::time = \&Time::HiRes::time;
1388 # if (eval "use POSIX (); (POSIX::times())... 1409 # if (eval "use POSIX (); (POSIX::times())...
1389 } else { 1410 } else {
1390 warn "AnyEvent: using built-in time(), WARNING, no sub-second resolution!\n" if $VERBOSE; 1411 warn "AnyEvent: using built-in time(), WARNING, no sub-second resolution!\n" if $VERBOSE;
1391 *_time = sub { time }; # epic fail 1412 *AE::time = sub (){ time }; # epic fail
1413 }
1414
1415 *time = sub { AE::time }; # different prototypes
1392 } 1416 };
1417 die if $@;
1393 1418
1394 &_time 1419 &time
1395} 1420}
1396 1421
1397sub time { _time } 1422*now = \&time;
1398sub now { _time } 1423
1399sub now_update { } 1424sub now_update { }
1400 1425
1401# default implementation for ->condvar 1426# default implementation for ->condvar
1402 1427
1403sub condvar { 1428sub condvar {
1429 eval q{ # poor man's autoloading {}
1430 *condvar = sub {
1404 bless { @_ == 3 ? (_ae_cb => $_[2]) : () }, "AnyEvent::CondVar" 1431 bless { @_ == 3 ? (_ae_cb => $_[2]) : () }, "AnyEvent::CondVar"
1432 };
1433
1434 *AE::cv = sub (;&) {
1435 bless { @_ ? (_ae_cb => shift) : () }, "AnyEvent::CondVar"
1436 };
1437 };
1438 die if $@;
1439
1440 &condvar
1405} 1441}
1406 1442
1407# default implementation for ->signal 1443# default implementation for ->signal
1408 1444
1409our $HAVE_ASYNC_INTERRUPT; 1445our $HAVE_ASYNC_INTERRUPT;
1418 1454
1419our ($SIGPIPE_R, $SIGPIPE_W, %SIG_CB, %SIG_EV, $SIG_IO); 1455our ($SIGPIPE_R, $SIGPIPE_W, %SIG_CB, %SIG_EV, $SIG_IO);
1420our (%SIG_ASY, %SIG_ASY_W); 1456our (%SIG_ASY, %SIG_ASY_W);
1421our ($SIG_COUNT, $SIG_TW); 1457our ($SIG_COUNT, $SIG_TW);
1422 1458
1423sub _signal_exec {
1424 $HAVE_ASYNC_INTERRUPT
1425 ? $SIGPIPE_R->drain
1426 : sysread $SIGPIPE_R, (my $dummy), 9;
1427
1428 while (%SIG_EV) {
1429 for (keys %SIG_EV) {
1430 delete $SIG_EV{$_};
1431 $_->() for values %{ $SIG_CB{$_} || {} };
1432 }
1433 }
1434}
1435
1436# install a dummy wakeup watcher to reduce signal catching latency 1459# install a dummy wakeup watcher to reduce signal catching latency
1460# used by Impls
1437sub _sig_add() { 1461sub _sig_add() {
1438 unless ($SIG_COUNT++) { 1462 unless ($SIG_COUNT++) {
1439 # try to align timer on a full-second boundary, if possible 1463 # try to align timer on a full-second boundary, if possible
1440 my $NOW = AE::now; 1464 my $NOW = AE::now;
1441 1465
1451 undef $SIG_TW 1475 undef $SIG_TW
1452 unless --$SIG_COUNT; 1476 unless --$SIG_COUNT;
1453} 1477}
1454 1478
1455our $_sig_name_init; $_sig_name_init = sub { 1479our $_sig_name_init; $_sig_name_init = sub {
1456 eval q{ # poor man's autoloading 1480 eval q{ # poor man's autoloading {}
1457 undef $_sig_name_init; 1481 undef $_sig_name_init;
1458 1482
1459 if (_have_async_interrupt) { 1483 if (_have_async_interrupt) {
1460 *sig2num = \&Async::Interrupt::sig2num; 1484 *sig2num = \&Async::Interrupt::sig2num;
1461 *sig2name = \&Async::Interrupt::sig2name; 1485 *sig2name = \&Async::Interrupt::sig2name;
1493 $SIG_IO = AE::io $SIGPIPE_R->fileno, 0, \&_signal_exec; 1517 $SIG_IO = AE::io $SIGPIPE_R->fileno, 0, \&_signal_exec;
1494 1518
1495 } else { 1519 } else {
1496 warn "AnyEvent: using emulated perl signal handling with latency timer.\n" if $VERBOSE >= 8; 1520 warn "AnyEvent: using emulated perl signal handling with latency timer.\n" if $VERBOSE >= 8;
1497 1521
1498 require Fcntl;
1499
1500 if (AnyEvent::WIN32) { 1522 if (AnyEvent::WIN32) {
1501 require AnyEvent::Util; 1523 require AnyEvent::Util;
1502 1524
1503 ($SIGPIPE_R, $SIGPIPE_W) = AnyEvent::Util::portable_pipe (); 1525 ($SIGPIPE_R, $SIGPIPE_W) = AnyEvent::Util::portable_pipe ();
1504 AnyEvent::Util::fh_nonblocking ($SIGPIPE_R, 1) if $SIGPIPE_R; 1526 AnyEvent::Util::fh_nonblocking ($SIGPIPE_R, 1) if $SIGPIPE_R;
1505 AnyEvent::Util::fh_nonblocking ($SIGPIPE_W, 1) if $SIGPIPE_W; # just in case 1527 AnyEvent::Util::fh_nonblocking ($SIGPIPE_W, 1) if $SIGPIPE_W; # just in case
1506 } else { 1528 } else {
1507 pipe $SIGPIPE_R, $SIGPIPE_W; 1529 pipe $SIGPIPE_R, $SIGPIPE_W;
1508 fcntl $SIGPIPE_R, &Fcntl::F_SETFL, &Fcntl::O_NONBLOCK if $SIGPIPE_R; 1530 fcntl $SIGPIPE_R, AnyEvent::F_SETFL, AnyEvent::O_NONBLOCK if $SIGPIPE_R;
1509 fcntl $SIGPIPE_W, &Fcntl::F_SETFL, &Fcntl::O_NONBLOCK if $SIGPIPE_W; # just in case 1531 fcntl $SIGPIPE_W, AnyEvent::F_SETFL, AnyEvent::O_NONBLOCK if $SIGPIPE_W; # just in case
1510 1532
1511 # not strictly required, as $^F is normally 2, but let's make sure... 1533 # not strictly required, as $^F is normally 2, but let's make sure...
1512 fcntl $SIGPIPE_R, &Fcntl::F_SETFD, &Fcntl::FD_CLOEXEC; 1534 fcntl $SIGPIPE_R, AnyEvent::F_SETFD, AnyEvent::FD_CLOEXEC;
1513 fcntl $SIGPIPE_W, &Fcntl::F_SETFD, &Fcntl::FD_CLOEXEC; 1535 fcntl $SIGPIPE_W, AnyEvent::F_SETFD, AnyEvent::FD_CLOEXEC;
1514 } 1536 }
1515 1537
1516 $SIGPIPE_R 1538 $SIGPIPE_R
1517 or Carp::croak "AnyEvent: unable to create a signal reporting pipe: $!\n"; 1539 or Carp::croak "AnyEvent: unable to create a signal reporting pipe: $!\n";
1518 1540
1519 $SIG_IO = AE::io $SIGPIPE_R, 0, \&_signal_exec; 1541 $SIG_IO = AE::io $SIGPIPE_R, 0, \&_signal_exec;
1520 } 1542 }
1521 1543
1522 *signal = sub { 1544 *signal = $HAVE_ASYNC_INTERRUPT
1545 ? sub {
1523 my (undef, %arg) = @_; 1546 my (undef, %arg) = @_;
1524 1547
1525 my $signal = uc $arg{signal}
1526 or Carp::croak "required option 'signal' is missing";
1527
1528 if ($HAVE_ASYNC_INTERRUPT) {
1529 # async::interrupt 1548 # async::interrupt
1530
1531 $signal = sig2num $signal; 1549 my $signal = sig2num $arg{signal};
1532 $SIG_CB{$signal}{$arg{cb}} = $arg{cb}; 1550 $SIG_CB{$signal}{$arg{cb}} = $arg{cb};
1533 1551
1534 $SIG_ASY{$signal} ||= new Async::Interrupt 1552 $SIG_ASY{$signal} ||= new Async::Interrupt
1535 cb => sub { undef $SIG_EV{$signal} }, 1553 cb => sub { undef $SIG_EV{$signal} },
1536 signal => $signal, 1554 signal => $signal,
1537 pipe => [$SIGPIPE_R->filenos], 1555 pipe => [$SIGPIPE_R->filenos],
1538 pipe_autodrain => 0, 1556 pipe_autodrain => 0,
1539 ; 1557 ;
1540 1558
1541 } else { 1559 bless [$signal, $arg{cb}], "AnyEvent::Base::signal"
1560 }
1561 : sub {
1562 my (undef, %arg) = @_;
1563
1542 # pure perl 1564 # pure perl
1543
1544 # AE::Util has been loaded in signal
1545 $signal = sig2name $signal; 1565 my $signal = sig2name $arg{signal};
1546 $SIG_CB{$signal}{$arg{cb}} = $arg{cb}; 1566 $SIG_CB{$signal}{$arg{cb}} = $arg{cb};
1547 1567
1548 $SIG{$signal} ||= sub { 1568 $SIG{$signal} ||= sub {
1549 local $!; 1569 local $!;
1550 syswrite $SIGPIPE_W, "\x00", 1 unless %SIG_EV; 1570 syswrite $SIGPIPE_W, "\x00", 1 unless %SIG_EV;
1551 undef $SIG_EV{$signal}; 1571 undef $SIG_EV{$signal};
1552 }; 1572 };
1553 1573
1554 # can't do signal processing without introducing races in pure perl, 1574 # can't do signal processing without introducing races in pure perl,
1555 # so limit the signal latency. 1575 # so limit the signal latency.
1556 _sig_add; 1576 _sig_add;
1557 }
1558 1577
1559 bless [$signal, $arg{cb}], "AnyEvent::Base::signal" 1578 bless [$signal, $arg{cb}], "AnyEvent::Base::signal"
1579 }
1560 }; 1580 ;
1561 1581
1562 *AnyEvent::Base::signal::DESTROY = sub { 1582 *AnyEvent::Base::signal::DESTROY = sub {
1563 my ($signal, $cb) = @{$_[0]}; 1583 my ($signal, $cb) = @{$_[0]};
1564 1584
1565 _sig_del; 1585 _sig_del;
1572 # print weird messages, or just unconditionally exit 1592 # print weird messages, or just unconditionally exit
1573 # instead of getting the default action. 1593 # instead of getting the default action.
1574 undef $SIG{$signal} 1594 undef $SIG{$signal}
1575 unless keys %{ $SIG_CB{$signal} }; 1595 unless keys %{ $SIG_CB{$signal} };
1576 }; 1596 };
1597
1598 *_signal_exec = sub {
1599 $HAVE_ASYNC_INTERRUPT
1600 ? $SIGPIPE_R->drain
1601 : sysread $SIGPIPE_R, (my $dummy), 9;
1602
1603 while (%SIG_EV) {
1604 for (keys %SIG_EV) {
1605 delete $SIG_EV{$_};
1606 $_->() for values %{ $SIG_CB{$_} || {} };
1607 }
1608 }
1609 };
1577 }; 1610 };
1578 die if $@; 1611 die if $@;
1612
1579 &signal 1613 &signal
1580} 1614}
1581 1615
1582# default implementation for ->child 1616# default implementation for ->child
1583 1617
1584our %PID_CB; 1618our %PID_CB;
1585our $CHLD_W; 1619our $CHLD_W;
1586our $CHLD_DELAY_W; 1620our $CHLD_DELAY_W;
1587our $WNOHANG; 1621our $WNOHANG;
1588 1622
1623# used by many Impl's
1589sub _emit_childstatus($$) { 1624sub _emit_childstatus($$) {
1590 my (undef, $rpid, $rstatus) = @_; 1625 my (undef, $rpid, $rstatus) = @_;
1591 1626
1592 $_->($rpid, $rstatus) 1627 $_->($rpid, $rstatus)
1593 for values %{ $PID_CB{$rpid} || {} }, 1628 for values %{ $PID_CB{$rpid} || {} },
1594 values %{ $PID_CB{0} || {} }; 1629 values %{ $PID_CB{0} || {} };
1595} 1630}
1596 1631
1597sub _sigchld {
1598 my $pid;
1599
1600 AnyEvent->_emit_childstatus ($pid, $?)
1601 while ($pid = waitpid -1, $WNOHANG) > 0;
1602}
1603
1604sub child { 1632sub child {
1633 eval q{ # poor man's autoloading {}
1634 *_sigchld = sub {
1635 my $pid;
1636
1637 AnyEvent->_emit_childstatus ($pid, $?)
1638 while ($pid = waitpid -1, $WNOHANG) > 0;
1639 };
1640
1641 *child = sub {
1605 my (undef, %arg) = @_; 1642 my (undef, %arg) = @_;
1606 1643
1607 defined (my $pid = $arg{pid} + 0) 1644 defined (my $pid = $arg{pid} + 0)
1608 or Carp::croak "required option 'pid' is missing"; 1645 or Carp::croak "required option 'pid' is missing";
1609 1646
1610 $PID_CB{$pid}{$arg{cb}} = $arg{cb}; 1647 $PID_CB{$pid}{$arg{cb}} = $arg{cb};
1611 1648
1612 # WNOHANG is almost cetrainly 1 everywhere 1649 # WNOHANG is almost cetrainly 1 everywhere
1613 $WNOHANG ||= $^O =~ /^(?:openbsd|netbsd|linux|freebsd|cygwin|MSWin32)$/ 1650 $WNOHANG ||= $^O =~ /^(?:openbsd|netbsd|linux|freebsd|cygwin|MSWin32)$/
1614 ? 1 1651 ? 1
1615 : eval { local $SIG{__DIE__}; require POSIX; &POSIX::WNOHANG } || 1; 1652 : eval { local $SIG{__DIE__}; require POSIX; &POSIX::WNOHANG } || 1;
1616 1653
1617 unless ($CHLD_W) { 1654 unless ($CHLD_W) {
1618 $CHLD_W = AE::signal CHLD => \&_sigchld; 1655 $CHLD_W = AE::signal CHLD => \&_sigchld;
1619 # child could be a zombie already, so make at least one round 1656 # child could be a zombie already, so make at least one round
1620 &_sigchld; 1657 &_sigchld;
1621 } 1658 }
1622 1659
1623 bless [$pid, $arg{cb}], "AnyEvent::Base::child" 1660 bless [$pid, $arg{cb}], "AnyEvent::Base::child"
1624} 1661 };
1625 1662
1626sub AnyEvent::Base::child::DESTROY { 1663 *AnyEvent::Base::child::DESTROY = sub {
1627 my ($pid, $cb) = @{$_[0]}; 1664 my ($pid, $cb) = @{$_[0]};
1628 1665
1629 delete $PID_CB{$pid}{$cb}; 1666 delete $PID_CB{$pid}{$cb};
1630 delete $PID_CB{$pid} unless keys %{ $PID_CB{$pid} }; 1667 delete $PID_CB{$pid} unless keys %{ $PID_CB{$pid} };
1631 1668
1632 undef $CHLD_W unless keys %PID_CB; 1669 undef $CHLD_W unless keys %PID_CB;
1670 };
1671 };
1672 die if $@;
1673
1674 &child
1633} 1675}
1634 1676
1635# idle emulation is done by simply using a timer, regardless 1677# idle emulation is done by simply using a timer, regardless
1636# of whether the process is idle or not, and not letting 1678# of whether the process is idle or not, and not letting
1637# the callback use more than 50% of the time. 1679# the callback use more than 50% of the time.
1638sub idle { 1680sub idle {
1681 eval q{ # poor man's autoloading {}
1682 *idle = sub {
1639 my (undef, %arg) = @_; 1683 my (undef, %arg) = @_;
1640 1684
1641 my ($cb, $w, $rcb) = $arg{cb}; 1685 my ($cb, $w, $rcb) = $arg{cb};
1642 1686
1643 $rcb = sub { 1687 $rcb = sub {
1644 if ($cb) { 1688 if ($cb) {
1645 $w = _time; 1689 $w = _time;
1646 &$cb; 1690 &$cb;
1647 $w = _time - $w; 1691 $w = _time - $w;
1648 1692
1649 # never use more then 50% of the time for the idle watcher, 1693 # never use more then 50% of the time for the idle watcher,
1650 # within some limits 1694 # within some limits
1651 $w = 0.0001 if $w < 0.0001; 1695 $w = 0.0001 if $w < 0.0001;
1652 $w = 5 if $w > 5; 1696 $w = 5 if $w > 5;
1653 1697
1654 $w = AE::timer $w, 0, $rcb; 1698 $w = AE::timer $w, 0, $rcb;
1655 } else { 1699 } else {
1656 # clean up... 1700 # clean up...
1657 undef $w; 1701 undef $w;
1658 undef $rcb; 1702 undef $rcb;
1703 }
1704 };
1705
1706 $w = AE::timer 0.05, 0, $rcb;
1707
1708 bless \\$cb, "AnyEvent::Base::idle"
1659 } 1709 };
1710
1711 *AnyEvent::Base::idle::DESTROY = sub {
1712 undef $${$_[0]};
1713 };
1660 }; 1714 };
1715 die if $@;
1661 1716
1662 $w = AE::timer 0.05, 0, $rcb; 1717 &idle
1663
1664 bless \\$cb, "AnyEvent::Base::idle"
1665}
1666
1667sub AnyEvent::Base::idle::DESTROY {
1668 undef $${$_[0]};
1669} 1718}
1670 1719
1671package AnyEvent::CondVar; 1720package AnyEvent::CondVar;
1672 1721
1673our @ISA = AnyEvent::CondVar::Base::; 1722our @ISA = AnyEvent::CondVar::Base::;
2032 2081
2033The actual code goes further and collects all errors (C<die>s, exceptions) 2082The actual code goes further and collects all errors (C<die>s, exceptions)
2034that occurred during request processing. The C<result> method detects 2083that occurred during request processing. The C<result> method detects
2035whether an exception as thrown (it is stored inside the $txn object) 2084whether an exception as thrown (it is stored inside the $txn object)
2036and just throws the exception, which means connection errors and other 2085and just throws the exception, which means connection errors and other
2037problems get reported tot he code that tries to use the result, not in a 2086problems get reported to the code that tries to use the result, not in a
2038random callback. 2087random callback.
2039 2088
2040All of this enables the following usage styles: 2089All of this enables the following usage styles:
2041 2090
20421. Blocking: 20911. Blocking:
2499automatic timer adjustments even when no monotonic clock is available, 2548automatic timer adjustments even when no monotonic clock is available,
2500can take avdantage of advanced kernel interfaces such as C<epoll> and 2549can take avdantage of advanced kernel interfaces such as C<epoll> and
2501C<kqueue>, and is the fastest backend I<by far>. You can even embed 2550C<kqueue>, and is the fastest backend I<by far>. You can even embed
2502L<Glib>/L<Gtk2> in it (or vice versa, see L<EV::Glib> and L<Glib::EV>). 2551L<Glib>/L<Gtk2> in it (or vice versa, see L<EV::Glib> and L<Glib::EV>).
2503 2552
2553If you only use backends that rely on another event loop (e.g. C<Tk>),
2554then this module will do nothing for you.
2555
2504=item L<Guard> 2556=item L<Guard>
2505 2557
2506The guard module, when used, will be used to implement 2558The guard module, when used, will be used to implement
2507C<AnyEvent::Util::guard>. This speeds up guards considerably (and uses a 2559C<AnyEvent::Util::guard>. This speeds up guards considerably (and uses a
2508lot less memory), but otherwise doesn't affect guard operation much. It is 2560lot less memory), but otherwise doesn't affect guard operation much. It is
2509purely used for performance. 2561purely used for performance.
2510 2562
2511=item L<JSON> and L<JSON::XS> 2563=item L<JSON> and L<JSON::XS>
2512 2564
2513One of these modules is required when you want to read or write JSON data 2565One of these modules is required when you want to read or write JSON data
2514via L<AnyEvent::Handle>. It is also written in pure-perl, but can take 2566via L<AnyEvent::Handle>. L<JSON> is also written in pure-perl, but can take
2515advantage of the ultra-high-speed L<JSON::XS> module when it is installed. 2567advantage of the ultra-high-speed L<JSON::XS> module when it is installed.
2516
2517In fact, L<AnyEvent::Handle> will use L<JSON::XS> by default if it is
2518installed.
2519 2568
2520=item L<Net::SSLeay> 2569=item L<Net::SSLeay>
2521 2570
2522Implementing TLS/SSL in Perl is certainly interesting, but not very 2571Implementing TLS/SSL in Perl is certainly interesting, but not very
2523worthwhile: If this module is installed, then L<AnyEvent::Handle> (with 2572worthwhile: If this module is installed, then L<AnyEvent::Handle> (with
2534 2583
2535 2584
2536=head1 FORK 2585=head1 FORK
2537 2586
2538Most event libraries are not fork-safe. The ones who are usually are 2587Most event libraries are not fork-safe. The ones who are usually are
2539because they rely on inefficient but fork-safe C<select> or C<poll> 2588because they rely on inefficient but fork-safe C<select> or C<poll> calls
2540calls. Only L<EV> is fully fork-aware. 2589- higher performance APIs such as BSD's kqueue or the dreaded Linux epoll
2590are usually badly thought-out hacks that are incompatible with fork in
2591one way or another. Only L<EV> is fully fork-aware and ensures that you
2592continue event-processing in both parent and child (or both, if you know
2593what you are doing).
2541 2594
2542This means that, in general, you cannot fork and do event processing 2595This means that, in general, you cannot fork and do event processing in
2543in the child if a watcher was created before the fork (which in turn 2596the child if the event library was initialised before the fork (which
2544initialises the event library). 2597usually happens when the first AnyEvent watcher is created, or the library
2598is loaded).
2545 2599
2546If you have to fork, you must either do so I<before> creating your first 2600If you have to fork, you must either do so I<before> creating your first
2547watcher OR you must not use AnyEvent at all in the child OR you must do 2601watcher OR you must not use AnyEvent at all in the child OR you must do
2548something completely out of the scope of AnyEvent. 2602something completely out of the scope of AnyEvent.
2549 2603
2550The problem of doing event processing in the parent I<and> the child 2604The problem of doing event processing in the parent I<and> the child
2551is much more complicated: even for backends that I<are> fork-aware or 2605is much more complicated: even for backends that I<are> fork-aware or
2552fork-safe, their behaviour is not usually what you want: fork clones all 2606fork-safe, their behaviour is not usually what you want: fork clones all
2553watchers, that means all timers, I/O watchers etc. are active in both 2607watchers, that means all timers, I/O watchers etc. are active in both
2554parent and child, which is almost never what you want. 2608parent and child, which is almost never what you want. USing C<exec>
2609to start worker children from some kind of manage rprocess is usually
2610preferred, because it is much easier and cleaner, at the expense of having
2611to have another binary.
2555 2612
2556 2613
2557=head1 SECURITY CONSIDERATIONS 2614=head1 SECURITY CONSIDERATIONS
2558 2615
2559AnyEvent can be forced to load any event model via 2616AnyEvent can be forced to load any event model via

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines