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.309 by root, Sat Dec 26 08:59:35 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 => ...
… …
606eventually calls C<< -> send >>, and the "consumer side", which waits 609eventually calls C<< -> send >>, and the "consumer side", which waits
607for the send to occur. 610for the send to occur.
608 611
609Example: wait for a timer. 612Example: wait for a timer.
610 613
611 # wait till the result is ready 614 # condition: "wait till the timer is fired"
612 my $result_ready = AnyEvent->condvar; 615 my $timer_fired = AnyEvent->condvar;
613 616
614 # do something such as adding a timer 617 # create the timer - we could wait for, say
615 # or socket watcher the calls $result_ready->send 618 # a handle becomign ready, or even an
616 # when the "result" is ready. 619 # AnyEvent::HTTP request to finish, but
617 # in this case, we simply use a timer: 620 # in this case, we simply use a timer:
618 my $w = AnyEvent->timer ( 621 my $w = AnyEvent->timer (
619 after => 1, 622 after => 1,
620 cb => sub { $result_ready->send }, 623 cb => sub { $timer_fired->send },
621 ); 624 );
622 625
623 # this "blocks" (while handling events) till the callback 626 # this "blocks" (while handling events) till the callback
624 # calls ->send 627 # calls ->send
625 $result_ready->recv; 628 $timer_fired->recv;
626 629
627Example: 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
628variables are also callable directly. 631variables are also callable directly.
629 632
630 my $done = AnyEvent->condvar; 633 my $done = AnyEvent->condvar;
… …
1156 1159
1157BEGIN { AnyEvent::common_sense } 1160BEGIN { AnyEvent::common_sense }
1158 1161
1159use Carp (); 1162use Carp ();
1160 1163
1161our $VERSION = '5.23'; 1164our $VERSION = '5.26';
1162our $MODEL; 1165our $MODEL;
1163 1166
1164our $AUTOLOAD; 1167our $AUTOLOAD;
1165our @ISA; 1168our @ISA;
1166 1169
1167our @REGISTRY; 1170our @REGISTRY;
1168 1171
1169our $VERBOSE; 1172our $VERBOSE;
1170 1173
1171BEGIN { 1174BEGIN {
1172 eval "sub WIN32(){ " . (($^O =~ /mswin32/i)*1) ." }"; 1175 require "AnyEvent/constants.pl";
1176
1173 eval "sub TAINT(){ " . (${^TAINT}*1) . " }"; 1177 eval "sub TAINT (){" . (${^TAINT}*1) . "}";
1174 1178
1175 delete @ENV{grep /^PERL_ANYEVENT_/, keys %ENV} 1179 delete @ENV{grep /^PERL_ANYEVENT_/, keys %ENV}
1176 if ${^TAINT}; 1180 if ${^TAINT};
1177 1181
1178 $VERBOSE = $ENV{PERL_ANYEVENT_VERBOSE}*1; 1182 $VERBOSE = $ENV{PERL_ANYEVENT_VERBOSE}*1;
… …
1221our @post_detect; 1225our @post_detect;
1222 1226
1223sub post_detect(&) { 1227sub post_detect(&) {
1224 my ($cb) = @_; 1228 my ($cb) = @_;
1225 1229
1226 if ($MODEL) {
1227 $cb->();
1228
1229 undef
1230 } else {
1231 push @post_detect, $cb; 1230 push @post_detect, $cb;
1232 1231
1233 defined wantarray 1232 defined wantarray
1234 ? bless \$cb, "AnyEvent::Util::postdetect" 1233 ? bless \$cb, "AnyEvent::Util::postdetect"
1235 : () 1234 : ()
1236 }
1237} 1235}
1238 1236
1239sub AnyEvent::Util::postdetect::DESTROY { 1237sub AnyEvent::Util::postdetect::DESTROY {
1240 @post_detect = grep $_ != ${$_[0]}, @post_detect; 1238 @post_detect = grep $_ != ${$_[0]}, @post_detect;
1241} 1239}
1242 1240
1243sub 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
1244 unless ($MODEL) { 1259 unless ($MODEL) {
1245 local $SIG{__DIE__}; 1260 for (@REGISTRY, @models) {
1246 1261 my ($package, $model) = @$_;
1247 if ($ENV{PERL_ANYEVENT_MODEL} =~ /^([a-zA-Z]+)$/) { 1262 if (${"$package\::VERSION"} > 0) {
1248 my $model = "AnyEvent::Impl::$1";
1249 if (eval "require $model") { 1263 if (eval "require $model") {
1250 $MODEL = $model; 1264 $MODEL = $model;
1251 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;
1252 } else { 1266 last;
1253 warn "AnyEvent: unable to load model '$model' (from \$ENV{PERL_ANYEVENT_MODEL}):\n$@" if $VERBOSE; 1267 }
1254 } 1268 }
1255 } 1269 }
1256 1270
1257 # check for already loaded models
1258 unless ($MODEL) { 1271 unless ($MODEL) {
1272 # try to autoload a model
1259 for (@REGISTRY, @models) { 1273 for (@REGISTRY, @models) {
1260 my ($package, $model) = @$_; 1274 my ($package, $model, $autoload) = @$_;
1275 if (
1276 $autoload
1277 and eval "require $package"
1261 if (${"$package\::VERSION"} > 0) { 1278 and ${"$package\::VERSION"} > 0
1262 if (eval "require $model") { 1279 and eval "require $model"
1280 ) {
1263 $MODEL = $model; 1281 $MODEL = $model;
1264 warn "AnyEvent: autodetected model '$model', using it.\n" if $VERBOSE >= 2; 1282 warn "AnyEvent: autoloaded model '$model', using it.\n" if $VERBOSE >= 2;
1265 last; 1283 last;
1266 }
1267 } 1284 }
1268 } 1285 }
1269 1286
1270 unless ($MODEL) {
1271 # try to autoload a model
1272 for (@REGISTRY, @models) {
1273 my ($package, $model, $autoload) = @$_;
1274 if (
1275 $autoload
1276 and eval "require $package"
1277 and ${"$package\::VERSION"} > 0
1278 and eval "require $model"
1279 ) {
1280 $MODEL = $model;
1281 warn "AnyEvent: autoloaded model '$model', using it.\n" if $VERBOSE >= 2;
1282 last;
1283 }
1284 }
1285
1286 $MODEL 1287 $MODEL
1287 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";
1288 }
1289 } 1289 }
1290
1291 push @{"$MODEL\::ISA"}, "AnyEvent::Base";
1292
1293 unshift @ISA, $MODEL;
1294
1295 require AnyEvent::Strict if $ENV{PERL_ANYEVENT_STRICT};
1296
1297 (shift @post_detect)->() while @post_detect;
1298 } 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 };
1299 1313
1300 $MODEL 1314 $MODEL
1301} 1315}
1302 1316
1303sub AUTOLOAD { 1317sub AUTOLOAD {
1304 (my $func = $AUTOLOAD) =~ s/.*://; 1318 (my $func = $AUTOLOAD) =~ s/.*://;
1305 1319
1306 $method{$func} 1320 $method{$func}
1307 or Carp::croak "$func: not a valid method for AnyEvent objects"; 1321 or Carp::croak "$func: not a valid AnyEvent class method";
1308 1322
1309 detect unless $MODEL; 1323 detect;
1310 1324
1311 my $class = shift; 1325 my $class = shift;
1312 $class->$func (@_); 1326 $class->$func (@_);
1313} 1327}
1314 1328
… …
1331 1345
1332=head1 SIMPLIFIED AE API 1346=head1 SIMPLIFIED AE API
1333 1347
1334Starting with version 5.0, AnyEvent officially supports a second, much 1348Starting with version 5.0, AnyEvent officially supports a second, much
1335simpler, API that is designed to reduce the calling, typing and memory 1349simpler, API that is designed to reduce the calling, typing and memory
1336overhead. 1350overhead by using function call syntax and a fixed number of parameters.
1337 1351
1338See the L<AE> manpage for details. 1352See the L<AE> manpage for details.
1339 1353
1340=cut 1354=cut
1341 1355
1342package AE; 1356package AE;
1343 1357
1344our $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.
1345 1362
1346sub io($$$) { 1363sub io($$$) {
1347 AnyEvent->io (fh => $_[0], poll => $_[1] ? "w" : "r", cb => $_[2]) 1364 AnyEvent->io (fh => $_[0], poll => $_[1] ? "w" : "r", cb => $_[2])
1348} 1365}
1349 1366
… …
1381 1398
1382package AnyEvent::Base; 1399package AnyEvent::Base;
1383 1400
1384# default implementations for many methods 1401# default implementations for many methods
1385 1402
1386sub _time() { 1403sub time {
1404 eval q{ # poor man's autoloading {}
1387 # probe for availability of Time::HiRes 1405 # probe for availability of Time::HiRes
1388 if (eval "use Time::HiRes (); Time::HiRes::time (); 1") { 1406 if (eval "use Time::HiRes (); Time::HiRes::time (); 1") {
1389 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;
1390 *_time = \&Time::HiRes::time; 1408 *AE::time = \&Time::HiRes::time;
1391 # if (eval "use POSIX (); (POSIX::times())... 1409 # if (eval "use POSIX (); (POSIX::times())...
1392 } else { 1410 } else {
1393 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;
1394 *_time = sub { time }; # epic fail 1412 *AE::time = sub (){ time }; # epic fail
1413 }
1414
1415 *time = sub { AE::time }; # different prototypes
1395 } 1416 };
1417 die if $@;
1396 1418
1397 &_time 1419 &time
1398} 1420}
1399 1421
1400sub time { _time } 1422*now = \&time;
1401sub now { _time } 1423
1402sub now_update { } 1424sub now_update { }
1403 1425
1404# default implementation for ->condvar 1426# default implementation for ->condvar
1405 1427
1406sub condvar { 1428sub condvar {
1429 eval q{ # poor man's autoloading {}
1430 *condvar = sub {
1407 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
1408} 1441}
1409 1442
1410# default implementation for ->signal 1443# default implementation for ->signal
1411 1444
1412our $HAVE_ASYNC_INTERRUPT; 1445our $HAVE_ASYNC_INTERRUPT;
… …
1421 1454
1422our ($SIGPIPE_R, $SIGPIPE_W, %SIG_CB, %SIG_EV, $SIG_IO); 1455our ($SIGPIPE_R, $SIGPIPE_W, %SIG_CB, %SIG_EV, $SIG_IO);
1423our (%SIG_ASY, %SIG_ASY_W); 1456our (%SIG_ASY, %SIG_ASY_W);
1424our ($SIG_COUNT, $SIG_TW); 1457our ($SIG_COUNT, $SIG_TW);
1425 1458
1426sub _signal_exec {
1427 $HAVE_ASYNC_INTERRUPT
1428 ? $SIGPIPE_R->drain
1429 : sysread $SIGPIPE_R, (my $dummy), 9;
1430
1431 while (%SIG_EV) {
1432 for (keys %SIG_EV) {
1433 delete $SIG_EV{$_};
1434 $_->() for values %{ $SIG_CB{$_} || {} };
1435 }
1436 }
1437}
1438
1439# 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
1440sub _sig_add() { 1461sub _sig_add() {
1441 unless ($SIG_COUNT++) { 1462 unless ($SIG_COUNT++) {
1442 # try to align timer on a full-second boundary, if possible 1463 # try to align timer on a full-second boundary, if possible
1443 my $NOW = AE::now; 1464 my $NOW = AE::now;
1444 1465
… …
1454 undef $SIG_TW 1475 undef $SIG_TW
1455 unless --$SIG_COUNT; 1476 unless --$SIG_COUNT;
1456} 1477}
1457 1478
1458our $_sig_name_init; $_sig_name_init = sub { 1479our $_sig_name_init; $_sig_name_init = sub {
1459 eval q{ # poor man's autoloading 1480 eval q{ # poor man's autoloading {}
1460 undef $_sig_name_init; 1481 undef $_sig_name_init;
1461 1482
1462 if (_have_async_interrupt) { 1483 if (_have_async_interrupt) {
1463 *sig2num = \&Async::Interrupt::sig2num; 1484 *sig2num = \&Async::Interrupt::sig2num;
1464 *sig2name = \&Async::Interrupt::sig2name; 1485 *sig2name = \&Async::Interrupt::sig2name;
… …
1496 $SIG_IO = AE::io $SIGPIPE_R->fileno, 0, \&_signal_exec; 1517 $SIG_IO = AE::io $SIGPIPE_R->fileno, 0, \&_signal_exec;
1497 1518
1498 } else { 1519 } else {
1499 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;
1500 1521
1501 require Fcntl;
1502
1503 if (AnyEvent::WIN32) { 1522 if (AnyEvent::WIN32) {
1504 require AnyEvent::Util; 1523 require AnyEvent::Util;
1505 1524
1506 ($SIGPIPE_R, $SIGPIPE_W) = AnyEvent::Util::portable_pipe (); 1525 ($SIGPIPE_R, $SIGPIPE_W) = AnyEvent::Util::portable_pipe ();
1507 AnyEvent::Util::fh_nonblocking ($SIGPIPE_R, 1) if $SIGPIPE_R; 1526 AnyEvent::Util::fh_nonblocking ($SIGPIPE_R, 1) if $SIGPIPE_R;
1508 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
1509 } else { 1528 } else {
1510 pipe $SIGPIPE_R, $SIGPIPE_W; 1529 pipe $SIGPIPE_R, $SIGPIPE_W;
1511 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;
1512 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
1513 1532
1514 # 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...
1515 fcntl $SIGPIPE_R, &Fcntl::F_SETFD, &Fcntl::FD_CLOEXEC; 1534 fcntl $SIGPIPE_R, AnyEvent::F_SETFD, AnyEvent::FD_CLOEXEC;
1516 fcntl $SIGPIPE_W, &Fcntl::F_SETFD, &Fcntl::FD_CLOEXEC; 1535 fcntl $SIGPIPE_W, AnyEvent::F_SETFD, AnyEvent::FD_CLOEXEC;
1517 } 1536 }
1518 1537
1519 $SIGPIPE_R 1538 $SIGPIPE_R
1520 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";
1521 1540
1522 $SIG_IO = AE::io $SIGPIPE_R, 0, \&_signal_exec; 1541 $SIG_IO = AE::io $SIGPIPE_R, 0, \&_signal_exec;
1523 } 1542 }
1524 1543
1525 *signal = sub { 1544 *signal = $HAVE_ASYNC_INTERRUPT
1545 ? sub {
1526 my (undef, %arg) = @_; 1546 my (undef, %arg) = @_;
1527 1547
1528 my $signal = uc $arg{signal}
1529 or Carp::croak "required option 'signal' is missing";
1530
1531 if ($HAVE_ASYNC_INTERRUPT) {
1532 # async::interrupt 1548 # async::interrupt
1533
1534 $signal = sig2num $signal; 1549 my $signal = sig2num $arg{signal};
1535 $SIG_CB{$signal}{$arg{cb}} = $arg{cb}; 1550 $SIG_CB{$signal}{$arg{cb}} = $arg{cb};
1536 1551
1537 $SIG_ASY{$signal} ||= new Async::Interrupt 1552 $SIG_ASY{$signal} ||= new Async::Interrupt
1538 cb => sub { undef $SIG_EV{$signal} }, 1553 cb => sub { undef $SIG_EV{$signal} },
1539 signal => $signal, 1554 signal => $signal,
1540 pipe => [$SIGPIPE_R->filenos], 1555 pipe => [$SIGPIPE_R->filenos],
1541 pipe_autodrain => 0, 1556 pipe_autodrain => 0,
1542 ; 1557 ;
1543 1558
1544 } else { 1559 bless [$signal, $arg{cb}], "AnyEvent::Base::signal"
1560 }
1561 : sub {
1562 my (undef, %arg) = @_;
1563
1545 # pure perl 1564 # pure perl
1546
1547 # AE::Util has been loaded in signal
1548 $signal = sig2name $signal; 1565 my $signal = sig2name $arg{signal};
1549 $SIG_CB{$signal}{$arg{cb}} = $arg{cb}; 1566 $SIG_CB{$signal}{$arg{cb}} = $arg{cb};
1550 1567
1551 $SIG{$signal} ||= sub { 1568 $SIG{$signal} ||= sub {
1552 local $!; 1569 local $!;
1553 syswrite $SIGPIPE_W, "\x00", 1 unless %SIG_EV; 1570 syswrite $SIGPIPE_W, "\x00", 1 unless %SIG_EV;
1554 undef $SIG_EV{$signal}; 1571 undef $SIG_EV{$signal};
1555 }; 1572 };
1556 1573
1557 # can't do signal processing without introducing races in pure perl, 1574 # can't do signal processing without introducing races in pure perl,
1558 # so limit the signal latency. 1575 # so limit the signal latency.
1559 _sig_add; 1576 _sig_add;
1560 }
1561 1577
1562 bless [$signal, $arg{cb}], "AnyEvent::Base::signal" 1578 bless [$signal, $arg{cb}], "AnyEvent::Base::signal"
1579 }
1563 }; 1580 ;
1564 1581
1565 *AnyEvent::Base::signal::DESTROY = sub { 1582 *AnyEvent::Base::signal::DESTROY = sub {
1566 my ($signal, $cb) = @{$_[0]}; 1583 my ($signal, $cb) = @{$_[0]};
1567 1584
1568 _sig_del; 1585 _sig_del;
… …
1575 # print weird messages, or just unconditionally exit 1592 # print weird messages, or just unconditionally exit
1576 # instead of getting the default action. 1593 # instead of getting the default action.
1577 undef $SIG{$signal} 1594 undef $SIG{$signal}
1578 unless keys %{ $SIG_CB{$signal} }; 1595 unless keys %{ $SIG_CB{$signal} };
1579 }; 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 };
1580 }; 1610 };
1581 die if $@; 1611 die if $@;
1612
1582 &signal 1613 &signal
1583} 1614}
1584 1615
1585# default implementation for ->child 1616# default implementation for ->child
1586 1617
1587our %PID_CB; 1618our %PID_CB;
1588our $CHLD_W; 1619our $CHLD_W;
1589our $CHLD_DELAY_W; 1620our $CHLD_DELAY_W;
1590our $WNOHANG; 1621our $WNOHANG;
1591 1622
1623# used by many Impl's
1592sub _emit_childstatus($$) { 1624sub _emit_childstatus($$) {
1593 my (undef, $rpid, $rstatus) = @_; 1625 my (undef, $rpid, $rstatus) = @_;
1594 1626
1595 $_->($rpid, $rstatus) 1627 $_->($rpid, $rstatus)
1596 for values %{ $PID_CB{$rpid} || {} }, 1628 for values %{ $PID_CB{$rpid} || {} },
1597 values %{ $PID_CB{0} || {} }; 1629 values %{ $PID_CB{0} || {} };
1598} 1630}
1599 1631
1600sub _sigchld {
1601 my $pid;
1602
1603 AnyEvent->_emit_childstatus ($pid, $?)
1604 while ($pid = waitpid -1, $WNOHANG) > 0;
1605}
1606
1607sub 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 {
1608 my (undef, %arg) = @_; 1642 my (undef, %arg) = @_;
1609 1643
1610 defined (my $pid = $arg{pid} + 0) 1644 defined (my $pid = $arg{pid} + 0)
1611 or Carp::croak "required option 'pid' is missing"; 1645 or Carp::croak "required option 'pid' is missing";
1612 1646
1613 $PID_CB{$pid}{$arg{cb}} = $arg{cb}; 1647 $PID_CB{$pid}{$arg{cb}} = $arg{cb};
1614 1648
1615 # WNOHANG is almost cetrainly 1 everywhere 1649 # WNOHANG is almost cetrainly 1 everywhere
1616 $WNOHANG ||= $^O =~ /^(?:openbsd|netbsd|linux|freebsd|cygwin|MSWin32)$/ 1650 $WNOHANG ||= $^O =~ /^(?:openbsd|netbsd|linux|freebsd|cygwin|MSWin32)$/
1617 ? 1 1651 ? 1
1618 : eval { local $SIG{__DIE__}; require POSIX; &POSIX::WNOHANG } || 1; 1652 : eval { local $SIG{__DIE__}; require POSIX; &POSIX::WNOHANG } || 1;
1619 1653
1620 unless ($CHLD_W) { 1654 unless ($CHLD_W) {
1621 $CHLD_W = AE::signal CHLD => \&_sigchld; 1655 $CHLD_W = AE::signal CHLD => \&_sigchld;
1622 # 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
1623 &_sigchld; 1657 &_sigchld;
1624 } 1658 }
1625 1659
1626 bless [$pid, $arg{cb}], "AnyEvent::Base::child" 1660 bless [$pid, $arg{cb}], "AnyEvent::Base::child"
1627} 1661 };
1628 1662
1629sub AnyEvent::Base::child::DESTROY { 1663 *AnyEvent::Base::child::DESTROY = sub {
1630 my ($pid, $cb) = @{$_[0]}; 1664 my ($pid, $cb) = @{$_[0]};
1631 1665
1632 delete $PID_CB{$pid}{$cb}; 1666 delete $PID_CB{$pid}{$cb};
1633 delete $PID_CB{$pid} unless keys %{ $PID_CB{$pid} }; 1667 delete $PID_CB{$pid} unless keys %{ $PID_CB{$pid} };
1634 1668
1635 undef $CHLD_W unless keys %PID_CB; 1669 undef $CHLD_W unless keys %PID_CB;
1670 };
1671 };
1672 die if $@;
1673
1674 &child
1636} 1675}
1637 1676
1638# idle emulation is done by simply using a timer, regardless 1677# idle emulation is done by simply using a timer, regardless
1639# of whether the process is idle or not, and not letting 1678# of whether the process is idle or not, and not letting
1640# the callback use more than 50% of the time. 1679# the callback use more than 50% of the time.
1641sub idle { 1680sub idle {
1681 eval q{ # poor man's autoloading {}
1682 *idle = sub {
1642 my (undef, %arg) = @_; 1683 my (undef, %arg) = @_;
1643 1684
1644 my ($cb, $w, $rcb) = $arg{cb}; 1685 my ($cb, $w, $rcb) = $arg{cb};
1645 1686
1646 $rcb = sub { 1687 $rcb = sub {
1647 if ($cb) { 1688 if ($cb) {
1648 $w = _time; 1689 $w = _time;
1649 &$cb; 1690 &$cb;
1650 $w = _time - $w; 1691 $w = _time - $w;
1651 1692
1652 # 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,
1653 # within some limits 1694 # within some limits
1654 $w = 0.0001 if $w < 0.0001; 1695 $w = 0.0001 if $w < 0.0001;
1655 $w = 5 if $w > 5; 1696 $w = 5 if $w > 5;
1656 1697
1657 $w = AE::timer $w, 0, $rcb; 1698 $w = AE::timer $w, 0, $rcb;
1658 } else { 1699 } else {
1659 # clean up... 1700 # clean up...
1660 undef $w; 1701 undef $w;
1661 undef $rcb; 1702 undef $rcb;
1703 }
1704 };
1705
1706 $w = AE::timer 0.05, 0, $rcb;
1707
1708 bless \\$cb, "AnyEvent::Base::idle"
1662 } 1709 };
1710
1711 *AnyEvent::Base::idle::DESTROY = sub {
1712 undef $${$_[0]};
1713 };
1663 }; 1714 };
1715 die if $@;
1664 1716
1665 $w = AE::timer 0.05, 0, $rcb; 1717 &idle
1666
1667 bless \\$cb, "AnyEvent::Base::idle"
1668}
1669
1670sub AnyEvent::Base::idle::DESTROY {
1671 undef $${$_[0]};
1672} 1718}
1673 1719
1674package AnyEvent::CondVar; 1720package AnyEvent::CondVar;
1675 1721
1676our @ISA = AnyEvent::CondVar::Base::; 1722our @ISA = AnyEvent::CondVar::Base::;
… …
2035 2081
2036The 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)
2037that occurred during request processing. The C<result> method detects 2083that occurred during request processing. The C<result> method detects
2038whether an exception as thrown (it is stored inside the $txn object) 2084whether an exception as thrown (it is stored inside the $txn object)
2039and just throws the exception, which means connection errors and other 2085and just throws the exception, which means connection errors and other
2040problems 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
2041random callback. 2087random callback.
2042 2088
2043All of this enables the following usage styles: 2089All of this enables the following usage styles:
2044 2090
20451. Blocking: 20911. Blocking:
… …
2502automatic timer adjustments even when no monotonic clock is available, 2548automatic timer adjustments even when no monotonic clock is available,
2503can take avdantage of advanced kernel interfaces such as C<epoll> and 2549can take avdantage of advanced kernel interfaces such as C<epoll> and
2504C<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
2505L<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>).
2506 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
2507=item L<Guard> 2556=item L<Guard>
2508 2557
2509The guard module, when used, will be used to implement 2558The guard module, when used, will be used to implement
2510C<AnyEvent::Util::guard>. This speeds up guards considerably (and uses a 2559C<AnyEvent::Util::guard>. This speeds up guards considerably (and uses a
2511lot 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
2512purely used for performance. 2561purely used for performance.
2513 2562
2514=item L<JSON> and L<JSON::XS> 2563=item L<JSON> and L<JSON::XS>
2515 2564
2516One 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
2517via 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
2518advantage 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.
2519
2520In fact, L<AnyEvent::Handle> will use L<JSON::XS> by default if it is
2521installed.
2522 2568
2523=item L<Net::SSLeay> 2569=item L<Net::SSLeay>
2524 2570
2525Implementing TLS/SSL in Perl is certainly interesting, but not very 2571Implementing TLS/SSL in Perl is certainly interesting, but not very
2526worthwhile: If this module is installed, then L<AnyEvent::Handle> (with 2572worthwhile: If this module is installed, then L<AnyEvent::Handle> (with

Diff Legend

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