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.279 by root, Sun Aug 9 16:05:11 2009 UTC vs.
Revision 1.322 by root, Sat May 8 07:51:39 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 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;
666one. For example, a function that pings many hosts in parallel might want 696one. For example, a function that pings many hosts in parallel might want
667to use a condition variable for the whole process. 697to use a condition variable for the whole process.
668 698
669Every call to C<< ->begin >> will increment a counter, and every call to 699Every call to C<< ->begin >> will increment a counter, and every call to
670C<< ->end >> will decrement it. If the counter reaches C<0> in C<< ->end 700C<< ->end >> will decrement it. If the counter reaches C<0> in C<< ->end
671>>, the (last) callback passed to C<begin> will be executed. That callback 701>>, the (last) callback passed to C<begin> will be executed, passing the
672is I<supposed> to call C<< ->send >>, but that is not required. If no 702condvar as first argument. That callback is I<supposed> to call C<< ->send
673callback was set, C<send> will be called without any arguments. 703>>, but that is not required. If no group callback was set, C<send> will
704be called without any arguments.
674 705
675You can think of C<< $cv->send >> giving you an OR condition (one call 706You can think of C<< $cv->send >> giving you an OR condition (one call
676sends), while C<< $cv->begin >> and C<< $cv->end >> giving you an AND 707sends), while C<< $cv->begin >> and C<< $cv->end >> giving you an AND
677condition (all C<begin> calls must be C<end>'ed before the condvar sends). 708condition (all C<begin> calls must be C<end>'ed before the condvar sends).
678 709
705begung can potentially be zero: 736begung can potentially be zero:
706 737
707 my $cv = AnyEvent->condvar; 738 my $cv = AnyEvent->condvar;
708 739
709 my %result; 740 my %result;
710 $cv->begin (sub { $cv->send (\%result) }); 741 $cv->begin (sub { shift->send (\%result) });
711 742
712 for my $host (@list_of_hosts) { 743 for my $host (@list_of_hosts) {
713 $cv->begin; 744 $cv->begin;
714 ping_host_then_call_callback $host, sub { 745 ping_host_then_call_callback $host, sub {
715 $result{$host} = ...; 746 $result{$host} = ...;
941You should check C<$AnyEvent::MODEL> before adding to this array, though: 972You should check C<$AnyEvent::MODEL> before adding to this array, though:
942if 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
943array will be ignored. 974array will be ignored.
944 975
945Best use C<AnyEvent::post_detect { BLOCK }> when your application allows 976Best use C<AnyEvent::post_detect { BLOCK }> when your application allows
946it,as it takes care of these details. 977it, as it takes care of these details.
947 978
948This variable is mainly useful for modules that can do something useful 979This variable is mainly useful for modules that can do something useful
949when 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
950not 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
951into 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 }
952 996
953=back 997=back
954 998
955=head1 WHAT TO DO IN A MODULE 999=head1 WHAT TO DO IN A MODULE
956 1000
1105 1149
1106package AnyEvent; 1150package AnyEvent;
1107 1151
1108# basically a tuned-down version of common::sense 1152# basically a tuned-down version of common::sense
1109sub common_sense { 1153sub common_sense {
1110 # no warnings 1154 # from common:.sense 1.0
1111 ${^WARNING_BITS} ^= ${^WARNING_BITS}; 1155 ${^WARNING_BITS} = "\xfc\x3f\x33\x00\x0f\xf3\xcf\xc0\xf3\xfc\x33\x00";
1112 # use strict vars subs 1156 # use strict vars subs - NO UTF-8, as Util.pm doesn't like this atm. (uts46data.pl)
1113 $^H |= 0x00000600; 1157 $^H |= 0x00000600;
1114} 1158}
1115 1159
1116BEGIN { AnyEvent::common_sense } 1160BEGIN { AnyEvent::common_sense }
1117 1161
1118use Carp (); 1162use Carp ();
1119 1163
1120our $VERSION = '5.0'; 1164our $VERSION = '5.261';
1121our $MODEL; 1165our $MODEL;
1122 1166
1123our $AUTOLOAD; 1167our $AUTOLOAD;
1124our @ISA; 1168our @ISA;
1125 1169
1126our @REGISTRY; 1170our @REGISTRY;
1127 1171
1128our $WIN32;
1129
1130our $VERBOSE; 1172our $VERBOSE;
1131 1173
1132BEGIN { 1174BEGIN {
1133 eval "sub WIN32(){ " . (($^O =~ /mswin32/i)*1) ." }"; 1175 require "AnyEvent/constants.pl";
1176
1134 eval "sub TAINT(){ " . (${^TAINT}*1) . " }"; 1177 eval "sub TAINT (){" . (${^TAINT}*1) . "}";
1135 1178
1136 delete @ENV{grep /^PERL_ANYEVENT_/, keys %ENV} 1179 delete @ENV{grep /^PERL_ANYEVENT_/, keys %ENV}
1137 if ${^TAINT}; 1180 if ${^TAINT};
1138 1181
1139 $VERBOSE = $ENV{PERL_ANYEVENT_VERBOSE}*1; 1182 $VERBOSE = $ENV{PERL_ANYEVENT_VERBOSE}*1;
1182our @post_detect; 1225our @post_detect;
1183 1226
1184sub post_detect(&) { 1227sub post_detect(&) {
1185 my ($cb) = @_; 1228 my ($cb) = @_;
1186 1229
1187 if ($MODEL) {
1188 $cb->();
1189
1190 undef
1191 } else {
1192 push @post_detect, $cb; 1230 push @post_detect, $cb;
1193 1231
1194 defined wantarray 1232 defined wantarray
1195 ? bless \$cb, "AnyEvent::Util::postdetect" 1233 ? bless \$cb, "AnyEvent::Util::postdetect"
1196 : () 1234 : ()
1197 }
1198} 1235}
1199 1236
1200sub AnyEvent::Util::postdetect::DESTROY { 1237sub AnyEvent::Util::postdetect::DESTROY {
1201 @post_detect = grep $_ != ${$_[0]}, @post_detect; 1238 @post_detect = grep $_ != ${$_[0]}, @post_detect;
1202} 1239}
1203 1240
1204sub 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
1205 unless ($MODEL) { 1259 unless ($MODEL) {
1206 local $SIG{__DIE__}; 1260 for (@REGISTRY, @models) {
1207 1261 my ($package, $model) = @$_;
1208 if ($ENV{PERL_ANYEVENT_MODEL} =~ /^([a-zA-Z]+)$/) { 1262 if (${"$package\::VERSION"} > 0) {
1209 my $model = "AnyEvent::Impl::$1";
1210 if (eval "require $model") { 1263 if (eval "require $model") {
1211 $MODEL = $model; 1264 $MODEL = $model;
1212 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;
1213 } else { 1266 last;
1214 warn "AnyEvent: unable to load model '$model' (from \$ENV{PERL_ANYEVENT_MODEL}):\n$@" if $VERBOSE; 1267 }
1215 } 1268 }
1216 } 1269 }
1217 1270
1218 # check for already loaded models
1219 unless ($MODEL) { 1271 unless ($MODEL) {
1272 # try to autoload a model
1220 for (@REGISTRY, @models) { 1273 for (@REGISTRY, @models) {
1221 my ($package, $model) = @$_; 1274 my ($package, $model, $autoload) = @$_;
1275 if (
1276 $autoload
1277 and eval "require $package"
1222 if (${"$package\::VERSION"} > 0) { 1278 and ${"$package\::VERSION"} > 0
1223 if (eval "require $model") { 1279 and eval "require $model"
1280 ) {
1224 $MODEL = $model; 1281 $MODEL = $model;
1225 warn "AnyEvent: autodetected model '$model', using it.\n" if $VERBOSE >= 2; 1282 warn "AnyEvent: autoloaded model '$model', using it.\n" if $VERBOSE >= 2;
1226 last; 1283 last;
1227 }
1228 } 1284 }
1229 } 1285 }
1230 1286
1231 unless ($MODEL) {
1232 # try to autoload a model
1233 for (@REGISTRY, @models) {
1234 my ($package, $model, $autoload) = @$_;
1235 if (
1236 $autoload
1237 and eval "require $package"
1238 and ${"$package\::VERSION"} > 0
1239 and eval "require $model"
1240 ) {
1241 $MODEL = $model;
1242 warn "AnyEvent: autoloaded model '$model', using it.\n" if $VERBOSE >= 2;
1243 last;
1244 }
1245 }
1246
1247 $MODEL 1287 $MODEL
1248 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";
1249 }
1250 } 1289 }
1251
1252 push @{"$MODEL\::ISA"}, "AnyEvent::Base";
1253
1254 unshift @ISA, $MODEL;
1255
1256 require AnyEvent::Strict if $ENV{PERL_ANYEVENT_STRICT};
1257
1258 (shift @post_detect)->() while @post_detect;
1259 } 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 };
1260 1313
1261 $MODEL 1314 $MODEL
1262} 1315}
1263 1316
1264sub AUTOLOAD { 1317sub AUTOLOAD {
1265 (my $func = $AUTOLOAD) =~ s/.*://; 1318 (my $func = $AUTOLOAD) =~ s/.*://;
1266 1319
1267 $method{$func} 1320 $method{$func}
1268 or Carp::croak "$func: not a valid method for AnyEvent objects"; 1321 or Carp::croak "$func: not a valid AnyEvent class method";
1269 1322
1270 detect unless $MODEL; 1323 detect;
1271 1324
1272 my $class = shift; 1325 my $class = shift;
1273 $class->$func (@_); 1326 $class->$func (@_);
1274} 1327}
1275 1328
1292 1345
1293=head1 SIMPLIFIED AE API 1346=head1 SIMPLIFIED AE API
1294 1347
1295Starting with version 5.0, AnyEvent officially supports a second, much 1348Starting with version 5.0, AnyEvent officially supports a second, much
1296simpler, API that is designed to reduce the calling, typing and memory 1349simpler, API that is designed to reduce the calling, typing and memory
1297overhead. 1350overhead by using function call syntax and a fixed number of parameters.
1298 1351
1299See the L<AE> manpage for details. 1352See the L<AE> manpage for details.
1300 1353
1301=cut 1354=cut
1302 1355
1303package AE; 1356package AE;
1304 1357
1305our $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.
1306 1362
1307sub io($$$) { 1363sub io($$$) {
1308 AnyEvent->io (fh => $_[0], poll => $_[1] ? "w" : "r", cb => $_[2]) 1364 AnyEvent->io (fh => $_[0], poll => $_[1] ? "w" : "r", cb => $_[2])
1309} 1365}
1310 1366
1342 1398
1343package AnyEvent::Base; 1399package AnyEvent::Base;
1344 1400
1345# default implementations for many methods 1401# default implementations for many methods
1346 1402
1347sub _time { 1403sub time {
1404 eval q{ # poor man's autoloading {}
1348 # probe for availability of Time::HiRes 1405 # probe for availability of Time::HiRes
1349 if (eval "use Time::HiRes (); Time::HiRes::time (); 1") { 1406 if (eval "use Time::HiRes (); Time::HiRes::time (); 1") {
1350 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;
1351 *_time = \&Time::HiRes::time; 1408 *AE::time = \&Time::HiRes::time;
1352 # if (eval "use POSIX (); (POSIX::times())... 1409 # if (eval "use POSIX (); (POSIX::times())...
1353 } else { 1410 } else {
1354 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;
1355 *_time = sub { time }; # epic fail 1412 *AE::time = sub (){ time }; # epic fail
1413 }
1414
1415 *time = sub { AE::time }; # different prototypes
1356 } 1416 };
1417 die if $@;
1357 1418
1358 &_time 1419 &time
1359} 1420}
1360 1421
1361sub time { _time } 1422*now = \&time;
1362sub now { _time } 1423
1363sub now_update { } 1424sub now_update { }
1364 1425
1365# default implementation for ->condvar 1426# default implementation for ->condvar
1366 1427
1367sub condvar { 1428sub condvar {
1429 eval q{ # poor man's autoloading {}
1430 *condvar = sub {
1368 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
1369} 1441}
1370 1442
1371# default implementation for ->signal 1443# default implementation for ->signal
1372 1444
1373our $HAVE_ASYNC_INTERRUPT; 1445our $HAVE_ASYNC_INTERRUPT;
1374 1446
1375sub _have_async_interrupt() { 1447sub _have_async_interrupt() {
1376 $HAVE_ASYNC_INTERRUPT = 1*(!$ENV{PERL_ANYEVENT_AVOID_ASYNC_INTERRUPT} 1448 $HAVE_ASYNC_INTERRUPT = 1*(!$ENV{PERL_ANYEVENT_AVOID_ASYNC_INTERRUPT}
1377 && eval "use Async::Interrupt 1.0 (); 1") 1449 && eval "use Async::Interrupt 1.02 (); 1")
1378 unless defined $HAVE_ASYNC_INTERRUPT; 1450 unless defined $HAVE_ASYNC_INTERRUPT;
1379 1451
1380 $HAVE_ASYNC_INTERRUPT 1452 $HAVE_ASYNC_INTERRUPT
1381} 1453}
1382 1454
1383our ($SIGPIPE_R, $SIGPIPE_W, %SIG_CB, %SIG_EV, $SIG_IO); 1455our ($SIGPIPE_R, $SIGPIPE_W, %SIG_CB, %SIG_EV, $SIG_IO);
1384our (%SIG_ASY, %SIG_ASY_W); 1456our (%SIG_ASY, %SIG_ASY_W);
1385our ($SIG_COUNT, $SIG_TW); 1457our ($SIG_COUNT, $SIG_TW);
1386 1458
1387sub _signal_exec {
1388 $HAVE_ASYNC_INTERRUPT
1389 ? $SIGPIPE_R->drain
1390 : sysread $SIGPIPE_R, my $dummy, 9;
1391
1392 while (%SIG_EV) {
1393 for (keys %SIG_EV) {
1394 delete $SIG_EV{$_};
1395 $_->() for values %{ $SIG_CB{$_} || {} };
1396 }
1397 }
1398}
1399
1400# 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
1401sub _sig_add() { 1461sub _sig_add() {
1402 unless ($SIG_COUNT++) { 1462 unless ($SIG_COUNT++) {
1403 # try to align timer on a full-second boundary, if possible 1463 # try to align timer on a full-second boundary, if possible
1404 my $NOW = AE::now; 1464 my $NOW = AE::now;
1405 1465
1415 undef $SIG_TW 1475 undef $SIG_TW
1416 unless --$SIG_COUNT; 1476 unless --$SIG_COUNT;
1417} 1477}
1418 1478
1419our $_sig_name_init; $_sig_name_init = sub { 1479our $_sig_name_init; $_sig_name_init = sub {
1420 eval q{ # poor man's autoloading 1480 eval q{ # poor man's autoloading {}
1421 undef $_sig_name_init; 1481 undef $_sig_name_init;
1422 1482
1423 if (_have_async_interrupt) { 1483 if (_have_async_interrupt) {
1424 *sig2num = \&Async::Interrupt::sig2num; 1484 *sig2num = \&Async::Interrupt::sig2num;
1425 *sig2name = \&Async::Interrupt::sig2name; 1485 *sig2name = \&Async::Interrupt::sig2name;
1457 $SIG_IO = AE::io $SIGPIPE_R->fileno, 0, \&_signal_exec; 1517 $SIG_IO = AE::io $SIGPIPE_R->fileno, 0, \&_signal_exec;
1458 1518
1459 } else { 1519 } else {
1460 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;
1461 1521
1462 require Fcntl;
1463
1464 if (AnyEvent::WIN32) { 1522 if (AnyEvent::WIN32) {
1465 require AnyEvent::Util; 1523 require AnyEvent::Util;
1466 1524
1467 ($SIGPIPE_R, $SIGPIPE_W) = AnyEvent::Util::portable_pipe (); 1525 ($SIGPIPE_R, $SIGPIPE_W) = AnyEvent::Util::portable_pipe ();
1468 AnyEvent::Util::fh_nonblocking ($SIGPIPE_R, 1) if $SIGPIPE_R; 1526 AnyEvent::Util::fh_nonblocking ($SIGPIPE_R, 1) if $SIGPIPE_R;
1469 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
1470 } else { 1528 } else {
1471 pipe $SIGPIPE_R, $SIGPIPE_W; 1529 pipe $SIGPIPE_R, $SIGPIPE_W;
1472 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;
1473 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
1474 1532
1475 # 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...
1476 fcntl $SIGPIPE_R, &Fcntl::F_SETFD, &Fcntl::FD_CLOEXEC; 1534 fcntl $SIGPIPE_R, AnyEvent::F_SETFD, AnyEvent::FD_CLOEXEC;
1477 fcntl $SIGPIPE_W, &Fcntl::F_SETFD, &Fcntl::FD_CLOEXEC; 1535 fcntl $SIGPIPE_W, AnyEvent::F_SETFD, AnyEvent::FD_CLOEXEC;
1478 } 1536 }
1479 1537
1480 $SIGPIPE_R 1538 $SIGPIPE_R
1481 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";
1482 1540
1483 $SIG_IO = AE::io $SIGPIPE_R, 0, \&_signal_exec; 1541 $SIG_IO = AE::io $SIGPIPE_R, 0, \&_signal_exec;
1484 } 1542 }
1485 1543
1486 *signal = sub { 1544 *signal = $HAVE_ASYNC_INTERRUPT
1545 ? sub {
1487 my (undef, %arg) = @_; 1546 my (undef, %arg) = @_;
1488 1547
1489 my $signal = uc $arg{signal}
1490 or Carp::croak "required option 'signal' is missing";
1491
1492 if ($HAVE_ASYNC_INTERRUPT) {
1493 # async::interrupt 1548 # async::interrupt
1494
1495 $signal = sig2num $signal; 1549 my $signal = sig2num $arg{signal};
1496 $SIG_CB{$signal}{$arg{cb}} = $arg{cb}; 1550 $SIG_CB{$signal}{$arg{cb}} = $arg{cb};
1497 1551
1498 $SIG_ASY{$signal} ||= new Async::Interrupt 1552 $SIG_ASY{$signal} ||= new Async::Interrupt
1499 cb => sub { undef $SIG_EV{$signal} }, 1553 cb => sub { undef $SIG_EV{$signal} },
1500 signal => $signal, 1554 signal => $signal,
1501 pipe => [$SIGPIPE_R->filenos], 1555 pipe => [$SIGPIPE_R->filenos],
1502 pipe_autodrain => 0, 1556 pipe_autodrain => 0,
1503 ; 1557 ;
1504 1558
1505 } else { 1559 bless [$signal, $arg{cb}], "AnyEvent::Base::signal"
1560 }
1561 : sub {
1562 my (undef, %arg) = @_;
1563
1506 # pure perl 1564 # pure perl
1507
1508 # AE::Util has been loaded in signal
1509 $signal = sig2name $signal; 1565 my $signal = sig2name $arg{signal};
1510 $SIG_CB{$signal}{$arg{cb}} = $arg{cb}; 1566 $SIG_CB{$signal}{$arg{cb}} = $arg{cb};
1511 1567
1512 $SIG{$signal} ||= sub { 1568 $SIG{$signal} ||= sub {
1513 local $!; 1569 local $!;
1514 syswrite $SIGPIPE_W, "\x00", 1 unless %SIG_EV; 1570 syswrite $SIGPIPE_W, "\x00", 1 unless %SIG_EV;
1515 undef $SIG_EV{$signal}; 1571 undef $SIG_EV{$signal};
1516 }; 1572 };
1517 1573
1518 # can't do signal processing without introducing races in pure perl, 1574 # can't do signal processing without introducing races in pure perl,
1519 # so limit the signal latency. 1575 # so limit the signal latency.
1520 _sig_add; 1576 _sig_add;
1521 }
1522 1577
1523 bless [$signal, $arg{cb}], "AnyEvent::Base::signal" 1578 bless [$signal, $arg{cb}], "AnyEvent::Base::signal"
1579 }
1524 }; 1580 ;
1525 1581
1526 *AnyEvent::Base::signal::DESTROY = sub { 1582 *AnyEvent::Base::signal::DESTROY = sub {
1527 my ($signal, $cb) = @{$_[0]}; 1583 my ($signal, $cb) = @{$_[0]};
1528 1584
1529 _sig_del; 1585 _sig_del;
1536 # print weird messages, or just unconditionally exit 1592 # print weird messages, or just unconditionally exit
1537 # instead of getting the default action. 1593 # instead of getting the default action.
1538 undef $SIG{$signal} 1594 undef $SIG{$signal}
1539 unless keys %{ $SIG_CB{$signal} }; 1595 unless keys %{ $SIG_CB{$signal} };
1540 }; 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 };
1541 }; 1610 };
1542 die if $@; 1611 die if $@;
1612
1543 &signal 1613 &signal
1544} 1614}
1545 1615
1546# default implementation for ->child 1616# default implementation for ->child
1547 1617
1548our %PID_CB; 1618our %PID_CB;
1549our $CHLD_W; 1619our $CHLD_W;
1550our $CHLD_DELAY_W; 1620our $CHLD_DELAY_W;
1551our $WNOHANG; 1621our $WNOHANG;
1552 1622
1623# used by many Impl's
1553sub _emit_childstatus($$) { 1624sub _emit_childstatus($$) {
1554 my (undef, $rpid, $rstatus) = @_; 1625 my (undef, $rpid, $rstatus) = @_;
1555 1626
1556 $_->($rpid, $rstatus) 1627 $_->($rpid, $rstatus)
1557 for values %{ $PID_CB{$rpid} || {} }, 1628 for values %{ $PID_CB{$rpid} || {} },
1558 values %{ $PID_CB{0} || {} }; 1629 values %{ $PID_CB{0} || {} };
1559} 1630}
1560 1631
1561sub _sigchld {
1562 my $pid;
1563
1564 AnyEvent->_emit_childstatus ($pid, $?)
1565 while ($pid = waitpid -1, $WNOHANG) > 0;
1566}
1567
1568sub 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 {
1569 my (undef, %arg) = @_; 1642 my (undef, %arg) = @_;
1570 1643
1571 defined (my $pid = $arg{pid} + 0) 1644 defined (my $pid = $arg{pid} + 0)
1572 or Carp::croak "required option 'pid' is missing"; 1645 or Carp::croak "required option 'pid' is missing";
1573 1646
1574 $PID_CB{$pid}{$arg{cb}} = $arg{cb}; 1647 $PID_CB{$pid}{$arg{cb}} = $arg{cb};
1575 1648
1576 # WNOHANG is almost cetrainly 1 everywhere 1649 # WNOHANG is almost cetrainly 1 everywhere
1577 $WNOHANG ||= $^O =~ /^(?:openbsd|netbsd|linux|freebsd|cygwin|MSWin32)$/ 1650 $WNOHANG ||= $^O =~ /^(?:openbsd|netbsd|linux|freebsd|cygwin|MSWin32)$/
1578 ? 1 1651 ? 1
1579 : eval { local $SIG{__DIE__}; require POSIX; &POSIX::WNOHANG } || 1; 1652 : eval { local $SIG{__DIE__}; require POSIX; &POSIX::WNOHANG } || 1;
1580 1653
1581 unless ($CHLD_W) { 1654 unless ($CHLD_W) {
1582 $CHLD_W = AE::signal CHLD => \&_sigchld; 1655 $CHLD_W = AE::signal CHLD => \&_sigchld;
1583 # 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
1584 &_sigchld; 1657 &_sigchld;
1585 } 1658 }
1586 1659
1587 bless [$pid, $arg{cb}], "AnyEvent::Base::child" 1660 bless [$pid, $arg{cb}], "AnyEvent::Base::child"
1588} 1661 };
1589 1662
1590sub AnyEvent::Base::child::DESTROY { 1663 *AnyEvent::Base::child::DESTROY = sub {
1591 my ($pid, $cb) = @{$_[0]}; 1664 my ($pid, $cb) = @{$_[0]};
1592 1665
1593 delete $PID_CB{$pid}{$cb}; 1666 delete $PID_CB{$pid}{$cb};
1594 delete $PID_CB{$pid} unless keys %{ $PID_CB{$pid} }; 1667 delete $PID_CB{$pid} unless keys %{ $PID_CB{$pid} };
1595 1668
1596 undef $CHLD_W unless keys %PID_CB; 1669 undef $CHLD_W unless keys %PID_CB;
1670 };
1671 };
1672 die if $@;
1673
1674 &child
1597} 1675}
1598 1676
1599# idle emulation is done by simply using a timer, regardless 1677# idle emulation is done by simply using a timer, regardless
1600# of whether the process is idle or not, and not letting 1678# of whether the process is idle or not, and not letting
1601# the callback use more than 50% of the time. 1679# the callback use more than 50% of the time.
1602sub idle { 1680sub idle {
1681 eval q{ # poor man's autoloading {}
1682 *idle = sub {
1603 my (undef, %arg) = @_; 1683 my (undef, %arg) = @_;
1604 1684
1605 my ($cb, $w, $rcb) = $arg{cb}; 1685 my ($cb, $w, $rcb) = $arg{cb};
1606 1686
1607 $rcb = sub { 1687 $rcb = sub {
1608 if ($cb) { 1688 if ($cb) {
1609 $w = _time; 1689 $w = _time;
1610 &$cb; 1690 &$cb;
1611 $w = _time - $w; 1691 $w = _time - $w;
1612 1692
1613 # 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,
1614 # within some limits 1694 # within some limits
1615 $w = 0.0001 if $w < 0.0001; 1695 $w = 0.0001 if $w < 0.0001;
1616 $w = 5 if $w > 5; 1696 $w = 5 if $w > 5;
1617 1697
1618 $w = AE::timer $w, 0, $rcb; 1698 $w = AE::timer $w, 0, $rcb;
1619 } else { 1699 } else {
1620 # clean up... 1700 # clean up...
1621 undef $w; 1701 undef $w;
1622 undef $rcb; 1702 undef $rcb;
1703 }
1704 };
1705
1706 $w = AE::timer 0.05, 0, $rcb;
1707
1708 bless \\$cb, "AnyEvent::Base::idle"
1623 } 1709 };
1710
1711 *AnyEvent::Base::idle::DESTROY = sub {
1712 undef $${$_[0]};
1713 };
1624 }; 1714 };
1715 die if $@;
1625 1716
1626 $w = AE::timer 0.05, 0, $rcb; 1717 &idle
1627
1628 bless \\$cb, "AnyEvent::Base::idle"
1629}
1630
1631sub AnyEvent::Base::idle::DESTROY {
1632 undef $${$_[0]};
1633} 1718}
1634 1719
1635package AnyEvent::CondVar; 1720package AnyEvent::CondVar;
1636 1721
1637our @ISA = AnyEvent::CondVar::Base::; 1722our @ISA = AnyEvent::CondVar::Base::;
1911 warn "read: $input\n"; # output what has been read 1996 warn "read: $input\n"; # output what has been read
1912 $cv->send if $input =~ /^q/i; # quit program if /^q/i 1997 $cv->send if $input =~ /^q/i; # quit program if /^q/i
1913 }, 1998 },
1914 ); 1999 );
1915 2000
1916 my $time_watcher; # can only be used once
1917
1918 sub new_timer {
1919 $timer = AnyEvent->timer (after => 1, cb => sub { 2001 my $time_watcher = AnyEvent->timer (after => 1, interval => 1, cb => sub {
1920 warn "timeout\n"; # print 'timeout' about every second 2002 warn "timeout\n"; # print 'timeout' at most every second
1921 &new_timer; # and restart the time
1922 }); 2003 });
1923 }
1924
1925 new_timer; # create first timer
1926 2004
1927 $cv->recv; # wait until user enters /^q/i 2005 $cv->recv; # wait until user enters /^q/i
1928 2006
1929=head1 REAL-WORLD EXAMPLE 2007=head1 REAL-WORLD EXAMPLE
1930 2008
2003 2081
2004The 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)
2005that occurred during request processing. The C<result> method detects 2083that occurred during request processing. The C<result> method detects
2006whether an exception as thrown (it is stored inside the $txn object) 2084whether an exception as thrown (it is stored inside the $txn object)
2007and just throws the exception, which means connection errors and other 2085and just throws the exception, which means connection errors and other
2008problems 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
2009random callback. 2087random callback.
2010 2088
2011All of this enables the following usage styles: 2089All of this enables the following usage styles:
2012 2090
20131. Blocking: 20911. Blocking:
2374As you can see, the AnyEvent + EV combination even beats the 2452As you can see, the AnyEvent + EV combination even beats the
2375hand-optimised "raw sockets benchmark", while AnyEvent + its pure perl 2453hand-optimised "raw sockets benchmark", while AnyEvent + its pure perl
2376backend easily beats IO::Lambda and POE. 2454backend easily beats IO::Lambda and POE.
2377 2455
2378And 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
2379slow :) L<AnyEvent::Handle> abstraction beats both POE and IO::Lambda by a 2457slow :) L<AnyEvent::Handle> abstraction beats both POE and IO::Lambda
2380large margin, even though it does all of DNS, tcp-connect and socket I/O 2458higher level ("unoptimised") abstractions by a large margin, even though
2381in a non-blocking way. 2459it does all of DNS, tcp-connect and socket I/O in a non-blocking way.
2382 2460
2383The 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
2384F<eg/ae2.pl> in the AnyEvent distribution, the remaining benchmarks are 2462F<eg/ae2.pl> in the AnyEvent distribution, the remaining benchmarks are
2385part of the IO::lambda distribution and were used without any changes. 2463part of the IO::Lambda distribution and were used without any changes.
2386 2464
2387 2465
2388=head1 SIGNALS 2466=head1 SIGNALS
2389 2467
2390AnyEvent currently installs handlers for these signals: 2468AnyEvent currently installs handlers for these signals:
2432it's built-in modules) are required to use it. 2510it's built-in modules) are required to use it.
2433 2511
2434That 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
2435modules if they are installed. 2513modules if they are installed.
2436 2514
2437This section epxlains which additional modules will be used, and how they 2515This section explains which additional modules will be used, and how they
2438affect AnyEvent's operetion. 2516affect AnyEvent's operation.
2439 2517
2440=over 4 2518=over 4
2441 2519
2442=item L<Async::Interrupt> 2520=item L<Async::Interrupt>
2443 2521
2448catch the signals) with some delay (default is 10 seconds, look for 2526catch the signals) with some delay (default is 10 seconds, look for
2449C<$AnyEvent::MAX_SIGNAL_LATENCY>). 2527C<$AnyEvent::MAX_SIGNAL_LATENCY>).
2450 2528
2451If 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
2452catching, 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
2453will not be interrupted regularly, which is more efficient (And good for 2531will not be interrupted regularly, which is more efficient (and good for
2454battery life on laptops). 2532battery life on laptops).
2455 2533
2456This 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
2457that 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).
2458 2536
2470automatic timer adjustments even when no monotonic clock is available, 2548automatic timer adjustments even when no monotonic clock is available,
2471can take avdantage of advanced kernel interfaces such as C<epoll> and 2549can take avdantage of advanced kernel interfaces such as C<epoll> and
2472C<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
2473L<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>).
2474 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
2475=item L<Guard> 2556=item L<Guard>
2476 2557
2477The guard module, when used, will be used to implement 2558The guard module, when used, will be used to implement
2478C<AnyEvent::Util::guard>. This speeds up guards considerably (and uses a 2559C<AnyEvent::Util::guard>. This speeds up guards considerably (and uses a
2479lot 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
2480purely used for performance. 2561purely used for performance.
2481 2562
2482=item L<JSON> and L<JSON::XS> 2563=item L<JSON> and L<JSON::XS>
2483 2564
2484This 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
2485L<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
2486advantage 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.
2487
2488In fact, L<AnyEvent::Handle> will use L<JSON::XS> by default if it is
2489installed.
2490 2568
2491=item L<Net::SSLeay> 2569=item L<Net::SSLeay>
2492 2570
2493Implementing TLS/SSL in Perl is certainly interesting, but not very 2571Implementing TLS/SSL in Perl is certainly interesting, but not very
2494worthwhile: If this module is installed, then L<AnyEvent::Handle> (with 2572worthwhile: If this module is installed, then L<AnyEvent::Handle> (with
2505 2583
2506 2584
2507=head1 FORK 2585=head1 FORK
2508 2586
2509Most 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
2510because 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
2511calls. 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).
2512 2599
2513If 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
2514watcher 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
2515something 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.
2516 2612
2517 2613
2518=head1 SECURITY CONSIDERATIONS 2614=head1 SECURITY CONSIDERATIONS
2519 2615
2520AnyEvent 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