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.310 by root, Tue Jan 5 10:45:25 2010 UTC vs.
Revision 1.312 by root, Mon Feb 15 18:02:35 2010 UTC

… …
1240sub AnyEvent::Util::postdetect::DESTROY { 1240sub AnyEvent::Util::postdetect::DESTROY {
1241 @post_detect = grep $_ != ${$_[0]}, @post_detect; 1241 @post_detect = grep $_ != ${$_[0]}, @post_detect;
1242} 1242}
1243 1243
1244sub detect() { 1244sub detect() {
1245 # free some memory
1246 *detect = sub () { $MODEL };
1247
1248 local $!; # for good measure
1249 local $SIG{__DIE__};
1250
1251 if ($ENV{PERL_ANYEVENT_MODEL} =~ /^([a-zA-Z]+)$/) {
1252 my $model = "AnyEvent::Impl::$1";
1253 if (eval "require $model") {
1254 $MODEL = $model;
1255 warn "AnyEvent: loaded model '$model' (forced by \$ENV{PERL_ANYEVENT_MODEL}), using it.\n" if $VERBOSE >= 2;
1256 } else {
1257 warn "AnyEvent: unable to load model '$model' (from \$ENV{PERL_ANYEVENT_MODEL}):\n$@" if $VERBOSE;
1258 }
1259 }
1260
1261 # check for already loaded models
1245 unless ($MODEL) { 1262 unless ($MODEL) {
1246 local $SIG{__DIE__}; 1263 for (@REGISTRY, @models) {
1247 1264 my ($package, $model) = @$_;
1248 if ($ENV{PERL_ANYEVENT_MODEL} =~ /^([a-zA-Z]+)$/) { 1265 if (${"$package\::VERSION"} > 0) {
1249 my $model = "AnyEvent::Impl::$1";
1250 if (eval "require $model") { 1266 if (eval "require $model") {
1251 $MODEL = $model; 1267 $MODEL = $model;
1252 warn "AnyEvent: loaded model '$model' (forced by \$ENV{PERL_ANYEVENT_MODEL}), using it.\n" if $VERBOSE >= 2; 1268 warn "AnyEvent: autodetected model '$model', using it.\n" if $VERBOSE >= 2;
1253 } else { 1269 last;
1254 warn "AnyEvent: unable to load model '$model' (from \$ENV{PERL_ANYEVENT_MODEL}):\n$@" if $VERBOSE; 1270 }
1255 } 1271 }
1256 } 1272 }
1257 1273
1258 # check for already loaded models
1259 unless ($MODEL) { 1274 unless ($MODEL) {
1275 # try to autoload a model
1260 for (@REGISTRY, @models) { 1276 for (@REGISTRY, @models) {
1261 my ($package, $model) = @$_; 1277 my ($package, $model, $autoload) = @$_;
1278 if (
1279 $autoload
1280 and eval "require $package"
1262 if (${"$package\::VERSION"} > 0) { 1281 and ${"$package\::VERSION"} > 0
1263 if (eval "require $model") { 1282 and eval "require $model"
1283 ) {
1264 $MODEL = $model; 1284 $MODEL = $model;
1265 warn "AnyEvent: autodetected model '$model', using it.\n" if $VERBOSE >= 2; 1285 warn "AnyEvent: autoloaded model '$model', using it.\n" if $VERBOSE >= 2;
1266 last; 1286 last;
1267 }
1268 } 1287 }
1269 } 1288 }
1270 1289
1271 unless ($MODEL) {
1272 # try to autoload a model
1273 for (@REGISTRY, @models) {
1274 my ($package, $model, $autoload) = @$_;
1275 if (
1276 $autoload
1277 and eval "require $package"
1278 and ${"$package\::VERSION"} > 0
1279 and eval "require $model"
1280 ) {
1281 $MODEL = $model;
1282 warn "AnyEvent: autoloaded model '$model', using it.\n" if $VERBOSE >= 2;
1283 last;
1284 }
1285 }
1286
1287 $MODEL 1290 $MODEL
1288 or die "No event module selected for AnyEvent and autodetect failed. Install any one of these modules: EV, Event or Glib.\n"; 1291 or die "No event module selected for AnyEvent and autodetect failed. Install any one of these modules: EV, Event or Glib.\n";
1289 }
1290 } 1292 }
1291
1292 push @{"$MODEL\::ISA"}, "AnyEvent::Base";
1293
1294 unshift @ISA, $MODEL;
1295
1296 require AnyEvent::Strict if $ENV{PERL_ANYEVENT_STRICT};
1297
1298 (shift @post_detect)->() while @post_detect;
1299 } 1293 }
1294
1295 @models = (); # free probe data
1296
1297 push @{"$MODEL\::ISA"}, "AnyEvent::Base";
1298 unshift @ISA, $MODEL;
1299
1300 require AnyEvent::Strict if $ENV{PERL_ANYEVENT_STRICT};
1301
1302 (shift @post_detect)->() while @post_detect;
1300 1303
1301 $MODEL 1304 $MODEL
1302} 1305}
1303 1306
1304sub AUTOLOAD { 1307sub AUTOLOAD {
1305 (my $func = $AUTOLOAD) =~ s/.*://; 1308 (my $func = $AUTOLOAD) =~ s/.*://;
1306 1309
1307 $method{$func} 1310 $method{$func}
1308 or Carp::croak "$func: not a valid method for AnyEvent objects"; 1311 or Carp::croak "$func: not a valid AnyEvent class method";
1309 1312
1310 detect unless $MODEL; 1313 detect;
1311 1314
1312 my $class = shift; 1315 my $class = shift;
1313 $class->$func (@_); 1316 $class->$func (@_);
1314} 1317}
1315 1318
… …
1383package AnyEvent::Base; 1386package AnyEvent::Base;
1384 1387
1385# default implementations for many methods 1388# default implementations for many methods
1386 1389
1387sub _time() { 1390sub _time() {
1391 eval q{ # poor man's autoloading
1388 # probe for availability of Time::HiRes 1392 # probe for availability of Time::HiRes
1389 if (eval "use Time::HiRes (); Time::HiRes::time (); 1") { 1393 if (eval "use Time::HiRes (); Time::HiRes::time (); 1") {
1390 warn "AnyEvent: using Time::HiRes for sub-second timing accuracy.\n" if $VERBOSE >= 8; 1394 warn "AnyEvent: using Time::HiRes for sub-second timing accuracy.\n" if $VERBOSE >= 8;
1391 *_time = \&Time::HiRes::time; 1395 *_time = \&Time::HiRes::time;
1392 # if (eval "use POSIX (); (POSIX::times())... 1396 # if (eval "use POSIX (); (POSIX::times())...
1393 } else { 1397 } else {
1394 warn "AnyEvent: using built-in time(), WARNING, no sub-second resolution!\n" if $VERBOSE; 1398 warn "AnyEvent: using built-in time(), WARNING, no sub-second resolution!\n" if $VERBOSE;
1395 *_time = sub { time }; # epic fail 1399 *_time = sub (){ time }; # epic fail
1400 }
1396 } 1401 };
1402 die if $@;
1397 1403
1398 &_time 1404 &_time
1399} 1405}
1400 1406
1401sub time { _time } 1407sub time { _time }
… …
1422 1428
1423our ($SIGPIPE_R, $SIGPIPE_W, %SIG_CB, %SIG_EV, $SIG_IO); 1429our ($SIGPIPE_R, $SIGPIPE_W, %SIG_CB, %SIG_EV, $SIG_IO);
1424our (%SIG_ASY, %SIG_ASY_W); 1430our (%SIG_ASY, %SIG_ASY_W);
1425our ($SIG_COUNT, $SIG_TW); 1431our ($SIG_COUNT, $SIG_TW);
1426 1432
1427sub _signal_exec {
1428 $HAVE_ASYNC_INTERRUPT
1429 ? $SIGPIPE_R->drain
1430 : sysread $SIGPIPE_R, (my $dummy), 9;
1431
1432 while (%SIG_EV) {
1433 for (keys %SIG_EV) {
1434 delete $SIG_EV{$_};
1435 $_->() for values %{ $SIG_CB{$_} || {} };
1436 }
1437 }
1438}
1439
1440# install a dummy wakeup watcher to reduce signal catching latency 1433# install a dummy wakeup watcher to reduce signal catching latency
1434# used by Impls
1441sub _sig_add() { 1435sub _sig_add() {
1442 unless ($SIG_COUNT++) { 1436 unless ($SIG_COUNT++) {
1443 # try to align timer on a full-second boundary, if possible 1437 # try to align timer on a full-second boundary, if possible
1444 my $NOW = AE::now; 1438 my $NOW = AE::now;
1445 1439
… …
1576 # print weird messages, or just unconditionally exit 1570 # print weird messages, or just unconditionally exit
1577 # instead of getting the default action. 1571 # instead of getting the default action.
1578 undef $SIG{$signal} 1572 undef $SIG{$signal}
1579 unless keys %{ $SIG_CB{$signal} }; 1573 unless keys %{ $SIG_CB{$signal} };
1580 }; 1574 };
1575
1576 *_signal_exec = sub {
1577 $HAVE_ASYNC_INTERRUPT
1578 ? $SIGPIPE_R->drain
1579 : sysread $SIGPIPE_R, (my $dummy), 9;
1580
1581 while (%SIG_EV) {
1582 for (keys %SIG_EV) {
1583 delete $SIG_EV{$_};
1584 $_->() for values %{ $SIG_CB{$_} || {} };
1585 }
1586 }
1587 };
1581 }; 1588 };
1582 die if $@; 1589 die if $@;
1590
1583 &signal 1591 &signal
1584} 1592}
1585 1593
1586# default implementation for ->child 1594# default implementation for ->child
1587 1595
1588our %PID_CB; 1596our %PID_CB;
1589our $CHLD_W; 1597our $CHLD_W;
1590our $CHLD_DELAY_W; 1598our $CHLD_DELAY_W;
1591our $WNOHANG; 1599our $WNOHANG;
1592 1600
1601# used by many Impl's
1593sub _emit_childstatus($$) { 1602sub _emit_childstatus($$) {
1594 my (undef, $rpid, $rstatus) = @_; 1603 my (undef, $rpid, $rstatus) = @_;
1595 1604
1596 $_->($rpid, $rstatus) 1605 $_->($rpid, $rstatus)
1597 for values %{ $PID_CB{$rpid} || {} }, 1606 for values %{ $PID_CB{$rpid} || {} },
1598 values %{ $PID_CB{0} || {} }; 1607 values %{ $PID_CB{0} || {} };
1599} 1608}
1600 1609
1601sub _sigchld {
1602 my $pid;
1603
1604 AnyEvent->_emit_childstatus ($pid, $?)
1605 while ($pid = waitpid -1, $WNOHANG) > 0;
1606}
1607
1608sub child { 1610sub child {
1611 eval q{ # poor man's autoloading {}
1612 *_sigchld = sub {
1613 my $pid;
1614
1615 AnyEvent->_emit_childstatus ($pid, $?)
1616 while ($pid = waitpid -1, $WNOHANG) > 0;
1617 };
1618
1619 *child = sub {
1609 my (undef, %arg) = @_; 1620 my (undef, %arg) = @_;
1610 1621
1611 defined (my $pid = $arg{pid} + 0) 1622 defined (my $pid = $arg{pid} + 0)
1612 or Carp::croak "required option 'pid' is missing"; 1623 or Carp::croak "required option 'pid' is missing";
1613 1624
1614 $PID_CB{$pid}{$arg{cb}} = $arg{cb}; 1625 $PID_CB{$pid}{$arg{cb}} = $arg{cb};
1615 1626
1616 # WNOHANG is almost cetrainly 1 everywhere 1627 # WNOHANG is almost cetrainly 1 everywhere
1617 $WNOHANG ||= $^O =~ /^(?:openbsd|netbsd|linux|freebsd|cygwin|MSWin32)$/ 1628 $WNOHANG ||= $^O =~ /^(?:openbsd|netbsd|linux|freebsd|cygwin|MSWin32)$/
1618 ? 1 1629 ? 1
1619 : eval { local $SIG{__DIE__}; require POSIX; &POSIX::WNOHANG } || 1; 1630 : eval { local $SIG{__DIE__}; require POSIX; &POSIX::WNOHANG } || 1;
1620 1631
1621 unless ($CHLD_W) { 1632 unless ($CHLD_W) {
1622 $CHLD_W = AE::signal CHLD => \&_sigchld; 1633 $CHLD_W = AE::signal CHLD => \&_sigchld;
1623 # child could be a zombie already, so make at least one round 1634 # child could be a zombie already, so make at least one round
1624 &_sigchld; 1635 &_sigchld;
1625 } 1636 }
1626 1637
1627 bless [$pid, $arg{cb}], "AnyEvent::Base::child" 1638 bless [$pid, $arg{cb}], "AnyEvent::Base::child"
1628} 1639 };
1629 1640
1630sub AnyEvent::Base::child::DESTROY { 1641 *AnyEvent::Base::child::DESTROY = sub {
1631 my ($pid, $cb) = @{$_[0]}; 1642 my ($pid, $cb) = @{$_[0]};
1632 1643
1633 delete $PID_CB{$pid}{$cb}; 1644 delete $PID_CB{$pid}{$cb};
1634 delete $PID_CB{$pid} unless keys %{ $PID_CB{$pid} }; 1645 delete $PID_CB{$pid} unless keys %{ $PID_CB{$pid} };
1635 1646
1636 undef $CHLD_W unless keys %PID_CB; 1647 undef $CHLD_W unless keys %PID_CB;
1648 };
1649 };
1650 die if $@;
1651
1652 &child
1637} 1653}
1638 1654
1639# idle emulation is done by simply using a timer, regardless 1655# idle emulation is done by simply using a timer, regardless
1640# of whether the process is idle or not, and not letting 1656# of whether the process is idle or not, and not letting
1641# the callback use more than 50% of the time. 1657# the callback use more than 50% of the time.
1642sub idle { 1658sub idle {
1659 eval q{ # poor man's autoloading {}
1660 *idle = sub {
1643 my (undef, %arg) = @_; 1661 my (undef, %arg) = @_;
1644 1662
1645 my ($cb, $w, $rcb) = $arg{cb}; 1663 my ($cb, $w, $rcb) = $arg{cb};
1646 1664
1647 $rcb = sub { 1665 $rcb = sub {
1648 if ($cb) { 1666 if ($cb) {
1649 $w = _time; 1667 $w = _time;
1650 &$cb; 1668 &$cb;
1651 $w = _time - $w; 1669 $w = _time - $w;
1652 1670
1653 # never use more then 50% of the time for the idle watcher, 1671 # never use more then 50% of the time for the idle watcher,
1654 # within some limits 1672 # within some limits
1655 $w = 0.0001 if $w < 0.0001; 1673 $w = 0.0001 if $w < 0.0001;
1656 $w = 5 if $w > 5; 1674 $w = 5 if $w > 5;
1657 1675
1658 $w = AE::timer $w, 0, $rcb; 1676 $w = AE::timer $w, 0, $rcb;
1659 } else { 1677 } else {
1660 # clean up... 1678 # clean up...
1661 undef $w; 1679 undef $w;
1662 undef $rcb; 1680 undef $rcb;
1681 }
1682 };
1683
1684 $w = AE::timer 0.05, 0, $rcb;
1685
1686 bless \\$cb, "AnyEvent::Base::idle"
1663 } 1687 };
1688
1689 *AnyEvent::Base::idle::DESTROY = sub {
1690 undef $${$_[0]};
1691 };
1664 }; 1692 };
1693 die if $@;
1665 1694
1666 $w = AE::timer 0.05, 0, $rcb; 1695 &idle
1667
1668 bless \\$cb, "AnyEvent::Base::idle"
1669}
1670
1671sub AnyEvent::Base::idle::DESTROY {
1672 undef $${$_[0]};
1673} 1696}
1674 1697
1675package AnyEvent::CondVar; 1698package AnyEvent::CondVar;
1676 1699
1677our @ISA = AnyEvent::CondVar::Base::; 1700our @ISA = AnyEvent::CondVar::Base::;

Diff Legend

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