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.280 by root, Sun Aug 9 23:45:40 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 => ...
363might affect timers and time-outs. 366might affect timers and time-outs.
364 367
365When this is the case, you can call this method, which will update the 368When this is the case, you can call this method, which will update the
366event loop's idea of "current time". 369event loop's idea of "current time".
367 370
371A typical example would be a script in a web server (e.g. C<mod_perl>) -
372when mod_perl executes the script, then the event loop will have the wrong
373idea about the "current time" (being potentially far in the past, when the
374script ran the last time). In that case you should arrange a call to C<<
375AnyEvent->now_update >> each time the web server process wakes up again
376(e.g. at the start of your script, or in a handler).
377
368Note that updating the time I<might> cause some events to be handled. 378Note that updating the time I<might> cause some events to be handled.
369 379
370=back 380=back
371 381
372=head2 SIGNAL WATCHERS 382=head2 SIGNAL WATCHERS
395correctly. 405correctly.
396 406
397Example: exit on SIGINT 407Example: exit on SIGINT
398 408
399 my $w = AnyEvent->signal (signal => "INT", cb => sub { exit 1 }); 409 my $w = AnyEvent->signal (signal => "INT", cb => sub { exit 1 });
410
411=head3 Restart Behaviour
412
413While restart behaviour is up to the event loop implementation, most will
414not restart syscalls (that includes L<Async::Interrupt> and AnyEvent's
415pure perl implementation).
416
417=head3 Safe/Unsafe Signals
418
419Perl signals can be either "safe" (synchronous to opcode handling) or
420"unsafe" (asynchronous) - the former might get delayed indefinitely, the
421latter might corrupt your memory.
422
423AnyEvent signal handlers are, in addition, synchronous to the event loop,
424i.e. they will not interrupt your running perl program but will only be
425called as part of the normal event handling (just like timer, I/O etc.
426callbacks, too).
400 427
401=head3 Signal Races, Delays and Workarounds 428=head3 Signal Races, Delays and Workarounds
402 429
403Many event loops (e.g. Glib, Tk, Qt, IO::Async) do not support attaching 430Many event loops (e.g. Glib, Tk, Qt, IO::Async) do not support attaching
404callbacks to signals in a generic way, which is a pity, as you cannot 431callbacks to signals in a generic way, which is a pity, as you cannot
479 506
480=head2 IDLE WATCHERS 507=head2 IDLE WATCHERS
481 508
482 $w = AnyEvent->idle (cb => <callback>); 509 $w = AnyEvent->idle (cb => <callback>);
483 510
484Sometimes there is a need to do something, but it is not so important 511Repeatedly invoke the callback after the process becomes idle, until
485to do it instantly, but only when there is nothing better to do. This 512either the watcher is destroyed or new events have been detected.
486"nothing better to do" is usually defined to be "no other events need
487attention by the event loop".
488 513
489Idle watchers ideally get invoked when the event loop has nothing 514Idle watchers are useful when there is a need to do something, but it
490better 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
491events. 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.
492 522
493Most event loops unfortunately do not really support idle watchers (only 523Unfortunately, most event loops do not really support idle watchers (only
494EV, 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
495will simply call the callback "from time to time". 525will simply call the callback "from time to time".
496 526
497Example: read lines from STDIN, but only process them when the 527Example: read lines from STDIN, but only process them when the
498program is otherwise idle: 528program is otherwise idle:
579eventually calls C<< -> send >>, and the "consumer side", which waits 609eventually calls C<< -> send >>, and the "consumer side", which waits
580for the send to occur. 610for the send to occur.
581 611
582Example: wait for a timer. 612Example: wait for a timer.
583 613
584 # wait till the result is ready 614 # condition: "wait till the timer is fired"
585 my $result_ready = AnyEvent->condvar; 615 my $timer_fired = AnyEvent->condvar;
586 616
587 # do something such as adding a timer 617 # create the timer - we could wait for, say
588 # or socket watcher the calls $result_ready->send 618 # a handle becomign ready, or even an
589 # when the "result" is ready. 619 # AnyEvent::HTTP request to finish, but
590 # in this case, we simply use a timer: 620 # in this case, we simply use a timer:
591 my $w = AnyEvent->timer ( 621 my $w = AnyEvent->timer (
592 after => 1, 622 after => 1,
593 cb => sub { $result_ready->send }, 623 cb => sub { $timer_fired->send },
594 ); 624 );
595 625
596 # this "blocks" (while handling events) till the callback 626 # this "blocks" (while handling events) till the callback
597 # calls -<send 627 # calls ->send
598 $result_ready->recv; 628 $timer_fired->recv;
599 629
600Example: 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
601variables are also callable directly. 631variables are also callable directly.
602 632
603 my $done = AnyEvent->condvar; 633 my $done = AnyEvent->condvar;
942You should check C<$AnyEvent::MODEL> before adding to this array, though: 972You should check C<$AnyEvent::MODEL> before adding to this array, though:
943if it is defined then the event loop has already been detected, and the 973if it is defined then the event loop has already been detected, and the
944array will be ignored. 974array will be ignored.
945 975
946Best use C<AnyEvent::post_detect { BLOCK }> when your application allows 976Best use C<AnyEvent::post_detect { BLOCK }> when your application allows
947it,as it takes care of these details. 977it, as it takes care of these details.
948 978
949This variable is mainly useful for modules that can do something useful 979This variable is mainly useful for modules that can do something useful
950when AnyEvent is used and thus want to know when it is initialised, but do 980when AnyEvent is used and thus want to know when it is initialised, but do
951not need to even load it by default. This array provides the means to hook 981not need to even load it by default. This array provides the means to hook
952into AnyEvent passively, without loading it. 982into AnyEvent passively, without loading it.
983
984Example: To load Coro::AnyEvent whenever Coro and AnyEvent are used
985together, you could put this into Coro (this is the actual code used by
986Coro to accomplish this):
987
988 if (defined $AnyEvent::MODEL) {
989 # AnyEvent already initialised, so load Coro::AnyEvent
990 require Coro::AnyEvent;
991 } else {
992 # AnyEvent not yet initialised, so make sure to load Coro::AnyEvent
993 # as soon as it is
994 push @AnyEvent::post_detect, sub { require Coro::AnyEvent };
995 }
953 996
954=back 997=back
955 998
956=head1 WHAT TO DO IN A MODULE 999=head1 WHAT TO DO IN A MODULE
957 1000
1106 1149
1107package AnyEvent; 1150package AnyEvent;
1108 1151
1109# basically a tuned-down version of common::sense 1152# basically a tuned-down version of common::sense
1110sub common_sense { 1153sub common_sense {
1111 # no warnings 1154 # from common:.sense 1.0
1112 ${^WARNING_BITS} ^= ${^WARNING_BITS}; 1155 ${^WARNING_BITS} = "\xfc\x3f\x33\x00\x0f\xf3\xcf\xc0\xf3\xfc\x33\x00";
1113 # use strict vars subs 1156 # use strict vars subs - NO UTF-8, as Util.pm doesn't like this atm. (uts46data.pl)
1114 $^H |= 0x00000600; 1157 $^H |= 0x00000600;
1115} 1158}
1116 1159
1117BEGIN { AnyEvent::common_sense } 1160BEGIN { AnyEvent::common_sense }
1118 1161
1119use Carp (); 1162use Carp ();
1120 1163
1121our $VERSION = '5.0'; 1164our $VERSION = '5.26';
1122our $MODEL; 1165our $MODEL;
1123 1166
1124our $AUTOLOAD; 1167our $AUTOLOAD;
1125our @ISA; 1168our @ISA;
1126 1169
1127our @REGISTRY; 1170our @REGISTRY;
1128 1171
1129our $WIN32;
1130
1131our $VERBOSE; 1172our $VERBOSE;
1132 1173
1133BEGIN { 1174BEGIN {
1134 eval "sub WIN32(){ " . (($^O =~ /mswin32/i)*1) ." }"; 1175 require "AnyEvent/constants.pl";
1176
1135 eval "sub TAINT(){ " . (${^TAINT}*1) . " }"; 1177 eval "sub TAINT (){" . (${^TAINT}*1) . "}";
1136 1178
1137 delete @ENV{grep /^PERL_ANYEVENT_/, keys %ENV} 1179 delete @ENV{grep /^PERL_ANYEVENT_/, keys %ENV}
1138 if ${^TAINT}; 1180 if ${^TAINT};
1139 1181
1140 $VERBOSE = $ENV{PERL_ANYEVENT_VERBOSE}*1; 1182 $VERBOSE = $ENV{PERL_ANYEVENT_VERBOSE}*1;
1183our @post_detect; 1225our @post_detect;
1184 1226
1185sub post_detect(&) { 1227sub post_detect(&) {
1186 my ($cb) = @_; 1228 my ($cb) = @_;
1187 1229
1188 if ($MODEL) {
1189 $cb->();
1190
1191 undef
1192 } else {
1193 push @post_detect, $cb; 1230 push @post_detect, $cb;
1194 1231
1195 defined wantarray 1232 defined wantarray
1196 ? bless \$cb, "AnyEvent::Util::postdetect" 1233 ? bless \$cb, "AnyEvent::Util::postdetect"
1197 : () 1234 : ()
1198 }
1199} 1235}
1200 1236
1201sub AnyEvent::Util::postdetect::DESTROY { 1237sub AnyEvent::Util::postdetect::DESTROY {
1202 @post_detect = grep $_ != ${$_[0]}, @post_detect; 1238 @post_detect = grep $_ != ${$_[0]}, @post_detect;
1203} 1239}
1204 1240
1205sub 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
1206 unless ($MODEL) { 1259 unless ($MODEL) {
1207 local $SIG{__DIE__}; 1260 for (@REGISTRY, @models) {
1208 1261 my ($package, $model) = @$_;
1209 if ($ENV{PERL_ANYEVENT_MODEL} =~ /^([a-zA-Z]+)$/) { 1262 if (${"$package\::VERSION"} > 0) {
1210 my $model = "AnyEvent::Impl::$1";
1211 if (eval "require $model") { 1263 if (eval "require $model") {
1212 $MODEL = $model; 1264 $MODEL = $model;
1213 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;
1214 } else { 1266 last;
1215 warn "AnyEvent: unable to load model '$model' (from \$ENV{PERL_ANYEVENT_MODEL}):\n$@" if $VERBOSE; 1267 }
1216 } 1268 }
1217 } 1269 }
1218 1270
1219 # check for already loaded models
1220 unless ($MODEL) { 1271 unless ($MODEL) {
1272 # try to autoload a model
1221 for (@REGISTRY, @models) { 1273 for (@REGISTRY, @models) {
1222 my ($package, $model) = @$_; 1274 my ($package, $model, $autoload) = @$_;
1275 if (
1276 $autoload
1277 and eval "require $package"
1223 if (${"$package\::VERSION"} > 0) { 1278 and ${"$package\::VERSION"} > 0
1224 if (eval "require $model") { 1279 and eval "require $model"
1280 ) {
1225 $MODEL = $model; 1281 $MODEL = $model;
1226 warn "AnyEvent: autodetected model '$model', using it.\n" if $VERBOSE >= 2; 1282 warn "AnyEvent: autoloaded model '$model', using it.\n" if $VERBOSE >= 2;
1227 last; 1283 last;
1228 }
1229 } 1284 }
1230 } 1285 }
1231 1286
1232 unless ($MODEL) {
1233 # try to autoload a model
1234 for (@REGISTRY, @models) {
1235 my ($package, $model, $autoload) = @$_;
1236 if (
1237 $autoload
1238 and eval "require $package"
1239 and ${"$package\::VERSION"} > 0
1240 and eval "require $model"
1241 ) {
1242 $MODEL = $model;
1243 warn "AnyEvent: autoloaded model '$model', using it.\n" if $VERBOSE >= 2;
1244 last;
1245 }
1246 }
1247
1248 $MODEL 1287 $MODEL
1249 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";
1250 }
1251 } 1289 }
1252
1253 push @{"$MODEL\::ISA"}, "AnyEvent::Base";
1254
1255 unshift @ISA, $MODEL;
1256
1257 require AnyEvent::Strict if $ENV{PERL_ANYEVENT_STRICT};
1258
1259 (shift @post_detect)->() while @post_detect;
1260 } 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 };
1261 1313
1262 $MODEL 1314 $MODEL
1263} 1315}
1264 1316
1265sub AUTOLOAD { 1317sub AUTOLOAD {
1266 (my $func = $AUTOLOAD) =~ s/.*://; 1318 (my $func = $AUTOLOAD) =~ s/.*://;
1267 1319
1268 $method{$func} 1320 $method{$func}
1269 or Carp::croak "$func: not a valid method for AnyEvent objects"; 1321 or Carp::croak "$func: not a valid AnyEvent class method";
1270 1322
1271 detect unless $MODEL; 1323 detect;
1272 1324
1273 my $class = shift; 1325 my $class = shift;
1274 $class->$func (@_); 1326 $class->$func (@_);
1275} 1327}
1276 1328
1293 1345
1294=head1 SIMPLIFIED AE API 1346=head1 SIMPLIFIED AE API
1295 1347
1296Starting with version 5.0, AnyEvent officially supports a second, much 1348Starting with version 5.0, AnyEvent officially supports a second, much
1297simpler, API that is designed to reduce the calling, typing and memory 1349simpler, API that is designed to reduce the calling, typing and memory
1298overhead. 1350overhead by using function call syntax and a fixed number of parameters.
1299 1351
1300See the L<AE> manpage for details. 1352See the L<AE> manpage for details.
1301 1353
1302=cut 1354=cut
1303 1355
1304package AE; 1356package AE;
1305 1357
1306our $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.
1307 1362
1308sub io($$$) { 1363sub io($$$) {
1309 AnyEvent->io (fh => $_[0], poll => $_[1] ? "w" : "r", cb => $_[2]) 1364 AnyEvent->io (fh => $_[0], poll => $_[1] ? "w" : "r", cb => $_[2])
1310} 1365}
1311 1366
1343 1398
1344package AnyEvent::Base; 1399package AnyEvent::Base;
1345 1400
1346# default implementations for many methods 1401# default implementations for many methods
1347 1402
1348sub _time { 1403sub time {
1404 eval q{ # poor man's autoloading {}
1349 # probe for availability of Time::HiRes 1405 # probe for availability of Time::HiRes
1350 if (eval "use Time::HiRes (); Time::HiRes::time (); 1") { 1406 if (eval "use Time::HiRes (); Time::HiRes::time (); 1") {
1351 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;
1352 *_time = \&Time::HiRes::time; 1408 *AE::time = \&Time::HiRes::time;
1353 # if (eval "use POSIX (); (POSIX::times())... 1409 # if (eval "use POSIX (); (POSIX::times())...
1354 } else { 1410 } else {
1355 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;
1356 *_time = sub { time }; # epic fail 1412 *AE::time = sub (){ time }; # epic fail
1413 }
1414
1415 *time = sub { AE::time }; # different prototypes
1357 } 1416 };
1417 die if $@;
1358 1418
1359 &_time 1419 &time
1360} 1420}
1361 1421
1362sub time { _time } 1422*now = \&time;
1363sub now { _time } 1423
1364sub now_update { } 1424sub now_update { }
1365 1425
1366# default implementation for ->condvar 1426# default implementation for ->condvar
1367 1427
1368sub condvar { 1428sub condvar {
1429 eval q{ # poor man's autoloading {}
1430 *condvar = sub {
1369 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
1370} 1441}
1371 1442
1372# default implementation for ->signal 1443# default implementation for ->signal
1373 1444
1374our $HAVE_ASYNC_INTERRUPT; 1445our $HAVE_ASYNC_INTERRUPT;
1375 1446
1376sub _have_async_interrupt() { 1447sub _have_async_interrupt() {
1377 $HAVE_ASYNC_INTERRUPT = 1*(!$ENV{PERL_ANYEVENT_AVOID_ASYNC_INTERRUPT} 1448 $HAVE_ASYNC_INTERRUPT = 1*(!$ENV{PERL_ANYEVENT_AVOID_ASYNC_INTERRUPT}
1378 && eval "use Async::Interrupt 1.0 (); 1") 1449 && eval "use Async::Interrupt 1.02 (); 1")
1379 unless defined $HAVE_ASYNC_INTERRUPT; 1450 unless defined $HAVE_ASYNC_INTERRUPT;
1380 1451
1381 $HAVE_ASYNC_INTERRUPT 1452 $HAVE_ASYNC_INTERRUPT
1382} 1453}
1383 1454
1384our ($SIGPIPE_R, $SIGPIPE_W, %SIG_CB, %SIG_EV, $SIG_IO); 1455our ($SIGPIPE_R, $SIGPIPE_W, %SIG_CB, %SIG_EV, $SIG_IO);
1385our (%SIG_ASY, %SIG_ASY_W); 1456our (%SIG_ASY, %SIG_ASY_W);
1386our ($SIG_COUNT, $SIG_TW); 1457our ($SIG_COUNT, $SIG_TW);
1387 1458
1388sub _signal_exec {
1389 $HAVE_ASYNC_INTERRUPT
1390 ? $SIGPIPE_R->drain
1391 : sysread $SIGPIPE_R, my $dummy, 9;
1392
1393 while (%SIG_EV) {
1394 for (keys %SIG_EV) {
1395 delete $SIG_EV{$_};
1396 $_->() for values %{ $SIG_CB{$_} || {} };
1397 }
1398 }
1399}
1400
1401# 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
1402sub _sig_add() { 1461sub _sig_add() {
1403 unless ($SIG_COUNT++) { 1462 unless ($SIG_COUNT++) {
1404 # try to align timer on a full-second boundary, if possible 1463 # try to align timer on a full-second boundary, if possible
1405 my $NOW = AE::now; 1464 my $NOW = AE::now;
1406 1465
1416 undef $SIG_TW 1475 undef $SIG_TW
1417 unless --$SIG_COUNT; 1476 unless --$SIG_COUNT;
1418} 1477}
1419 1478
1420our $_sig_name_init; $_sig_name_init = sub { 1479our $_sig_name_init; $_sig_name_init = sub {
1421 eval q{ # poor man's autoloading 1480 eval q{ # poor man's autoloading {}
1422 undef $_sig_name_init; 1481 undef $_sig_name_init;
1423 1482
1424 if (_have_async_interrupt) { 1483 if (_have_async_interrupt) {
1425 *sig2num = \&Async::Interrupt::sig2num; 1484 *sig2num = \&Async::Interrupt::sig2num;
1426 *sig2name = \&Async::Interrupt::sig2name; 1485 *sig2name = \&Async::Interrupt::sig2name;
1458 $SIG_IO = AE::io $SIGPIPE_R->fileno, 0, \&_signal_exec; 1517 $SIG_IO = AE::io $SIGPIPE_R->fileno, 0, \&_signal_exec;
1459 1518
1460 } else { 1519 } else {
1461 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;
1462 1521
1463 require Fcntl;
1464
1465 if (AnyEvent::WIN32) { 1522 if (AnyEvent::WIN32) {
1466 require AnyEvent::Util; 1523 require AnyEvent::Util;
1467 1524
1468 ($SIGPIPE_R, $SIGPIPE_W) = AnyEvent::Util::portable_pipe (); 1525 ($SIGPIPE_R, $SIGPIPE_W) = AnyEvent::Util::portable_pipe ();
1469 AnyEvent::Util::fh_nonblocking ($SIGPIPE_R, 1) if $SIGPIPE_R; 1526 AnyEvent::Util::fh_nonblocking ($SIGPIPE_R, 1) if $SIGPIPE_R;
1470 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
1471 } else { 1528 } else {
1472 pipe $SIGPIPE_R, $SIGPIPE_W; 1529 pipe $SIGPIPE_R, $SIGPIPE_W;
1473 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;
1474 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
1475 1532
1476 # 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...
1477 fcntl $SIGPIPE_R, &Fcntl::F_SETFD, &Fcntl::FD_CLOEXEC; 1534 fcntl $SIGPIPE_R, AnyEvent::F_SETFD, AnyEvent::FD_CLOEXEC;
1478 fcntl $SIGPIPE_W, &Fcntl::F_SETFD, &Fcntl::FD_CLOEXEC; 1535 fcntl $SIGPIPE_W, AnyEvent::F_SETFD, AnyEvent::FD_CLOEXEC;
1479 } 1536 }
1480 1537
1481 $SIGPIPE_R 1538 $SIGPIPE_R
1482 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";
1483 1540
1484 $SIG_IO = AE::io $SIGPIPE_R, 0, \&_signal_exec; 1541 $SIG_IO = AE::io $SIGPIPE_R, 0, \&_signal_exec;
1485 } 1542 }
1486 1543
1487 *signal = sub { 1544 *signal = $HAVE_ASYNC_INTERRUPT
1545 ? sub {
1488 my (undef, %arg) = @_; 1546 my (undef, %arg) = @_;
1489 1547
1490 my $signal = uc $arg{signal}
1491 or Carp::croak "required option 'signal' is missing";
1492
1493 if ($HAVE_ASYNC_INTERRUPT) {
1494 # async::interrupt 1548 # async::interrupt
1495
1496 $signal = sig2num $signal; 1549 my $signal = sig2num $arg{signal};
1497 $SIG_CB{$signal}{$arg{cb}} = $arg{cb}; 1550 $SIG_CB{$signal}{$arg{cb}} = $arg{cb};
1498 1551
1499 $SIG_ASY{$signal} ||= new Async::Interrupt 1552 $SIG_ASY{$signal} ||= new Async::Interrupt
1500 cb => sub { undef $SIG_EV{$signal} }, 1553 cb => sub { undef $SIG_EV{$signal} },
1501 signal => $signal, 1554 signal => $signal,
1502 pipe => [$SIGPIPE_R->filenos], 1555 pipe => [$SIGPIPE_R->filenos],
1503 pipe_autodrain => 0, 1556 pipe_autodrain => 0,
1504 ; 1557 ;
1505 1558
1506 } else { 1559 bless [$signal, $arg{cb}], "AnyEvent::Base::signal"
1560 }
1561 : sub {
1562 my (undef, %arg) = @_;
1563
1507 # pure perl 1564 # pure perl
1508
1509 # AE::Util has been loaded in signal
1510 $signal = sig2name $signal; 1565 my $signal = sig2name $arg{signal};
1511 $SIG_CB{$signal}{$arg{cb}} = $arg{cb}; 1566 $SIG_CB{$signal}{$arg{cb}} = $arg{cb};
1512 1567
1513 $SIG{$signal} ||= sub { 1568 $SIG{$signal} ||= sub {
1514 local $!; 1569 local $!;
1515 syswrite $SIGPIPE_W, "\x00", 1 unless %SIG_EV; 1570 syswrite $SIGPIPE_W, "\x00", 1 unless %SIG_EV;
1516 undef $SIG_EV{$signal}; 1571 undef $SIG_EV{$signal};
1517 }; 1572 };
1518 1573
1519 # can't do signal processing without introducing races in pure perl, 1574 # can't do signal processing without introducing races in pure perl,
1520 # so limit the signal latency. 1575 # so limit the signal latency.
1521 _sig_add; 1576 _sig_add;
1522 }
1523 1577
1524 bless [$signal, $arg{cb}], "AnyEvent::Base::signal" 1578 bless [$signal, $arg{cb}], "AnyEvent::Base::signal"
1579 }
1525 }; 1580 ;
1526 1581
1527 *AnyEvent::Base::signal::DESTROY = sub { 1582 *AnyEvent::Base::signal::DESTROY = sub {
1528 my ($signal, $cb) = @{$_[0]}; 1583 my ($signal, $cb) = @{$_[0]};
1529 1584
1530 _sig_del; 1585 _sig_del;
1537 # print weird messages, or just unconditionally exit 1592 # print weird messages, or just unconditionally exit
1538 # instead of getting the default action. 1593 # instead of getting the default action.
1539 undef $SIG{$signal} 1594 undef $SIG{$signal}
1540 unless keys %{ $SIG_CB{$signal} }; 1595 unless keys %{ $SIG_CB{$signal} };
1541 }; 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 };
1542 }; 1610 };
1543 die if $@; 1611 die if $@;
1612
1544 &signal 1613 &signal
1545} 1614}
1546 1615
1547# default implementation for ->child 1616# default implementation for ->child
1548 1617
1549our %PID_CB; 1618our %PID_CB;
1550our $CHLD_W; 1619our $CHLD_W;
1551our $CHLD_DELAY_W; 1620our $CHLD_DELAY_W;
1552our $WNOHANG; 1621our $WNOHANG;
1553 1622
1623# used by many Impl's
1554sub _emit_childstatus($$) { 1624sub _emit_childstatus($$) {
1555 my (undef, $rpid, $rstatus) = @_; 1625 my (undef, $rpid, $rstatus) = @_;
1556 1626
1557 $_->($rpid, $rstatus) 1627 $_->($rpid, $rstatus)
1558 for values %{ $PID_CB{$rpid} || {} }, 1628 for values %{ $PID_CB{$rpid} || {} },
1559 values %{ $PID_CB{0} || {} }; 1629 values %{ $PID_CB{0} || {} };
1560} 1630}
1561 1631
1562sub _sigchld {
1563 my $pid;
1564
1565 AnyEvent->_emit_childstatus ($pid, $?)
1566 while ($pid = waitpid -1, $WNOHANG) > 0;
1567}
1568
1569sub 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 {
1570 my (undef, %arg) = @_; 1642 my (undef, %arg) = @_;
1571 1643
1572 defined (my $pid = $arg{pid} + 0) 1644 defined (my $pid = $arg{pid} + 0)
1573 or Carp::croak "required option 'pid' is missing"; 1645 or Carp::croak "required option 'pid' is missing";
1574 1646
1575 $PID_CB{$pid}{$arg{cb}} = $arg{cb}; 1647 $PID_CB{$pid}{$arg{cb}} = $arg{cb};
1576 1648
1577 # WNOHANG is almost cetrainly 1 everywhere 1649 # WNOHANG is almost cetrainly 1 everywhere
1578 $WNOHANG ||= $^O =~ /^(?:openbsd|netbsd|linux|freebsd|cygwin|MSWin32)$/ 1650 $WNOHANG ||= $^O =~ /^(?:openbsd|netbsd|linux|freebsd|cygwin|MSWin32)$/
1579 ? 1 1651 ? 1
1580 : eval { local $SIG{__DIE__}; require POSIX; &POSIX::WNOHANG } || 1; 1652 : eval { local $SIG{__DIE__}; require POSIX; &POSIX::WNOHANG } || 1;
1581 1653
1582 unless ($CHLD_W) { 1654 unless ($CHLD_W) {
1583 $CHLD_W = AE::signal CHLD => \&_sigchld; 1655 $CHLD_W = AE::signal CHLD => \&_sigchld;
1584 # 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
1585 &_sigchld; 1657 &_sigchld;
1586 } 1658 }
1587 1659
1588 bless [$pid, $arg{cb}], "AnyEvent::Base::child" 1660 bless [$pid, $arg{cb}], "AnyEvent::Base::child"
1589} 1661 };
1590 1662
1591sub AnyEvent::Base::child::DESTROY { 1663 *AnyEvent::Base::child::DESTROY = sub {
1592 my ($pid, $cb) = @{$_[0]}; 1664 my ($pid, $cb) = @{$_[0]};
1593 1665
1594 delete $PID_CB{$pid}{$cb}; 1666 delete $PID_CB{$pid}{$cb};
1595 delete $PID_CB{$pid} unless keys %{ $PID_CB{$pid} }; 1667 delete $PID_CB{$pid} unless keys %{ $PID_CB{$pid} };
1596 1668
1597 undef $CHLD_W unless keys %PID_CB; 1669 undef $CHLD_W unless keys %PID_CB;
1670 };
1671 };
1672 die if $@;
1673
1674 &child
1598} 1675}
1599 1676
1600# idle emulation is done by simply using a timer, regardless 1677# idle emulation is done by simply using a timer, regardless
1601# of whether the process is idle or not, and not letting 1678# of whether the process is idle or not, and not letting
1602# the callback use more than 50% of the time. 1679# the callback use more than 50% of the time.
1603sub idle { 1680sub idle {
1681 eval q{ # poor man's autoloading {}
1682 *idle = sub {
1604 my (undef, %arg) = @_; 1683 my (undef, %arg) = @_;
1605 1684
1606 my ($cb, $w, $rcb) = $arg{cb}; 1685 my ($cb, $w, $rcb) = $arg{cb};
1607 1686
1608 $rcb = sub { 1687 $rcb = sub {
1609 if ($cb) { 1688 if ($cb) {
1610 $w = _time; 1689 $w = _time;
1611 &$cb; 1690 &$cb;
1612 $w = _time - $w; 1691 $w = _time - $w;
1613 1692
1614 # 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,
1615 # within some limits 1694 # within some limits
1616 $w = 0.0001 if $w < 0.0001; 1695 $w = 0.0001 if $w < 0.0001;
1617 $w = 5 if $w > 5; 1696 $w = 5 if $w > 5;
1618 1697
1619 $w = AE::timer $w, 0, $rcb; 1698 $w = AE::timer $w, 0, $rcb;
1620 } else { 1699 } else {
1621 # clean up... 1700 # clean up...
1622 undef $w; 1701 undef $w;
1623 undef $rcb; 1702 undef $rcb;
1703 }
1704 };
1705
1706 $w = AE::timer 0.05, 0, $rcb;
1707
1708 bless \\$cb, "AnyEvent::Base::idle"
1624 } 1709 };
1710
1711 *AnyEvent::Base::idle::DESTROY = sub {
1712 undef $${$_[0]};
1713 };
1625 }; 1714 };
1715 die if $@;
1626 1716
1627 $w = AE::timer 0.05, 0, $rcb; 1717 &idle
1628
1629 bless \\$cb, "AnyEvent::Base::idle"
1630}
1631
1632sub AnyEvent::Base::idle::DESTROY {
1633 undef $${$_[0]};
1634} 1718}
1635 1719
1636package AnyEvent::CondVar; 1720package AnyEvent::CondVar;
1637 1721
1638our @ISA = AnyEvent::CondVar::Base::; 1722our @ISA = AnyEvent::CondVar::Base::;
1912 warn "read: $input\n"; # output what has been read 1996 warn "read: $input\n"; # output what has been read
1913 $cv->send if $input =~ /^q/i; # quit program if /^q/i 1997 $cv->send if $input =~ /^q/i; # quit program if /^q/i
1914 }, 1998 },
1915 ); 1999 );
1916 2000
1917 my $time_watcher; # can only be used once
1918
1919 sub new_timer {
1920 $timer = AnyEvent->timer (after => 1, cb => sub { 2001 my $time_watcher = AnyEvent->timer (after => 1, interval => 1, cb => sub {
1921 warn "timeout\n"; # print 'timeout' about every second 2002 warn "timeout\n"; # print 'timeout' at most every second
1922 &new_timer; # and restart the time
1923 }); 2003 });
1924 }
1925
1926 new_timer; # create first timer
1927 2004
1928 $cv->recv; # wait until user enters /^q/i 2005 $cv->recv; # wait until user enters /^q/i
1929 2006
1930=head1 REAL-WORLD EXAMPLE 2007=head1 REAL-WORLD EXAMPLE
1931 2008
2004 2081
2005The 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)
2006that occurred during request processing. The C<result> method detects 2083that occurred during request processing. The C<result> method detects
2007whether an exception as thrown (it is stored inside the $txn object) 2084whether an exception as thrown (it is stored inside the $txn object)
2008and just throws the exception, which means connection errors and other 2085and just throws the exception, which means connection errors and other
2009problems 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
2010random callback. 2087random callback.
2011 2088
2012All of this enables the following usage styles: 2089All of this enables the following usage styles:
2013 2090
20141. Blocking: 20911. Blocking:
2375As you can see, the AnyEvent + EV combination even beats the 2452As you can see, the AnyEvent + EV combination even beats the
2376hand-optimised "raw sockets benchmark", while AnyEvent + its pure perl 2453hand-optimised "raw sockets benchmark", while AnyEvent + its pure perl
2377backend easily beats IO::Lambda and POE. 2454backend easily beats IO::Lambda and POE.
2378 2455
2379And even the 100% non-blocking version written using the high-level (and 2456And even the 100% non-blocking version written using the high-level (and
2380slow :) L<AnyEvent::Handle> abstraction beats both POE and IO::Lambda by a 2457slow :) L<AnyEvent::Handle> abstraction beats both POE and IO::Lambda
2381large margin, even though it does all of DNS, tcp-connect and socket I/O 2458higher level ("unoptimised") abstractions by a large margin, even though
2382in a non-blocking way. 2459it does all of DNS, tcp-connect and socket I/O in a non-blocking way.
2383 2460
2384The two AnyEvent benchmarks programs can be found as F<eg/ae0.pl> and 2461The two AnyEvent benchmarks programs can be found as F<eg/ae0.pl> and
2385F<eg/ae2.pl> in the AnyEvent distribution, the remaining benchmarks are 2462F<eg/ae2.pl> in the AnyEvent distribution, the remaining benchmarks are
2386part of the IO::lambda distribution and were used without any changes. 2463part of the IO::Lambda distribution and were used without any changes.
2387 2464
2388 2465
2389=head1 SIGNALS 2466=head1 SIGNALS
2390 2467
2391AnyEvent currently installs handlers for these signals: 2468AnyEvent currently installs handlers for these signals:
2433it's built-in modules) are required to use it. 2510it's built-in modules) are required to use it.
2434 2511
2435That does not mean that AnyEvent won't take advantage of some additional 2512That does not mean that AnyEvent won't take advantage of some additional
2436modules if they are installed. 2513modules if they are installed.
2437 2514
2438This section epxlains which additional modules will be used, and how they 2515This section explains which additional modules will be used, and how they
2439affect AnyEvent's operetion. 2516affect AnyEvent's operation.
2440 2517
2441=over 4 2518=over 4
2442 2519
2443=item L<Async::Interrupt> 2520=item L<Async::Interrupt>
2444 2521
2449catch the signals) with some delay (default is 10 seconds, look for 2526catch the signals) with some delay (default is 10 seconds, look for
2450C<$AnyEvent::MAX_SIGNAL_LATENCY>). 2527C<$AnyEvent::MAX_SIGNAL_LATENCY>).
2451 2528
2452If this module is available, then it will be used to implement signal 2529If this module is available, then it will be used to implement signal
2453catching, which means that signals will not be delayed, and the event loop 2530catching, which means that signals will not be delayed, and the event loop
2454will not be interrupted regularly, which is more efficient (And good for 2531will not be interrupted regularly, which is more efficient (and good for
2455battery life on laptops). 2532battery life on laptops).
2456 2533
2457This affects not just the pure-perl event loop, but also other event loops 2534This affects not just the pure-perl event loop, but also other event loops
2458that have no signal handling on their own (e.g. Glib, Tk, Qt). 2535that have no signal handling on their own (e.g. Glib, Tk, Qt).
2459 2536
2471automatic timer adjustments even when no monotonic clock is available, 2548automatic timer adjustments even when no monotonic clock is available,
2472can take avdantage of advanced kernel interfaces such as C<epoll> and 2549can take avdantage of advanced kernel interfaces such as C<epoll> and
2473C<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
2474L<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>).
2475 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
2476=item L<Guard> 2556=item L<Guard>
2477 2557
2478The guard module, when used, will be used to implement 2558The guard module, when used, will be used to implement
2479C<AnyEvent::Util::guard>. This speeds up guards considerably (and uses a 2559C<AnyEvent::Util::guard>. This speeds up guards considerably (and uses a
2480lot 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
2481purely used for performance. 2561purely used for performance.
2482 2562
2483=item L<JSON> and L<JSON::XS> 2563=item L<JSON> and L<JSON::XS>
2484 2564
2485This module is required when you want to read or write JSON data via 2565One of these modules is required when you want to read or write JSON data
2486L<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
2487advantage 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.
2488
2489In fact, L<AnyEvent::Handle> will use L<JSON::XS> by default if it is
2490installed.
2491 2568
2492=item L<Net::SSLeay> 2569=item L<Net::SSLeay>
2493 2570
2494Implementing TLS/SSL in Perl is certainly interesting, but not very 2571Implementing TLS/SSL in Perl is certainly interesting, but not very
2495worthwhile: If this module is installed, then L<AnyEvent::Handle> (with 2572worthwhile: If this module is installed, then L<AnyEvent::Handle> (with
2506 2583
2507 2584
2508=head1 FORK 2585=head1 FORK
2509 2586
2510Most 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
2511because 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
2512calls. 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).
2594
2595This means that, in general, you cannot fork and do event processing in
2596the child if the event library was initialised before the fork (which
2597usually happens when the first AnyEvent watcher is created, or the library
2598is loaded).
2513 2599
2514If 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
2515watcher 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
2516something completely out of the scope of AnyEvent. 2602something completely out of the scope of AnyEvent.
2603
2604The problem of doing event processing in the parent I<and> the child
2605is much more complicated: even for backends that I<are> fork-aware or
2606fork-safe, their behaviour is not usually what you want: fork clones all
2607watchers, that means all timers, I/O watchers etc. are active in both
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.
2517 2612
2518 2613
2519=head1 SECURITY CONSIDERATIONS 2614=head1 SECURITY CONSIDERATIONS
2520 2615
2521AnyEvent 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