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.242 by root, Fri Jul 17 22:05:12 2009 UTC vs.
Revision 1.246 by root, Sat Jul 18 15:51:52 2009 UTC

… …
1041 1041
1042=cut 1042=cut
1043 1043
1044package AnyEvent; 1044package AnyEvent;
1045 1045
1046# basically a tuned-down version of common::sense
1047sub common_sense {
1046no warnings; 1048 # no warnings
1049 ${^WARNING_BITS} ^= ${^WARNING_BITS};
1047use strict qw(vars subs); 1050 # use strict vars subs
1051 $^H |= 0x00000600;
1052}
1053
1054BEGIN { AnyEvent::common_sense }
1048 1055
1049use Carp (); 1056use Carp ();
1050 1057
1051our $VERSION = 4.83; 1058our $VERSION = 4.85;
1052our $MODEL; 1059our $MODEL;
1053 1060
1054our $AUTOLOAD; 1061our $AUTOLOAD;
1055our @ISA; 1062our @ISA;
1056 1063
… …
1130 @post_detect = grep $_ != ${$_[0]}, @post_detect; 1137 @post_detect = grep $_ != ${$_[0]}, @post_detect;
1131} 1138}
1132 1139
1133sub detect() { 1140sub detect() {
1134 unless ($MODEL) { 1141 unless ($MODEL) {
1135 no strict 'refs';
1136 local $SIG{__DIE__}; 1142 local $SIG{__DIE__};
1137 1143
1138 if ($ENV{PERL_ANYEVENT_MODEL} =~ /^([a-zA-Z]+)$/) { 1144 if ($ENV{PERL_ANYEVENT_MODEL} =~ /^([a-zA-Z]+)$/) {
1139 my $model = "AnyEvent::Impl::$1"; 1145 my $model = "AnyEvent::Impl::$1";
1140 if (eval "require $model") { 1146 if (eval "require $model") {
… …
1264 $_->() for values %{ $SIG_CB{$_} || {} }; 1270 $_->() for values %{ $SIG_CB{$_} || {} };
1265 } 1271 }
1266 } 1272 }
1267} 1273}
1268 1274
1275# install a dumym wakeupw atcher to reduce signal catching latency
1276sub _sig_add() {
1277 unless ($SIG_COUNT++) {
1278 # try to align timer on a full-second boundary, if possible
1279 my $NOW = AnyEvent->now;
1280
1281 $SIG_TW = AnyEvent->timer (
1282 after => $MAX_SIGNAL_LATENCY - ($NOW - int $NOW),
1283 interval => $MAX_SIGNAL_LATENCY,
1284 cb => sub { }, # just for the PERL_ASYNC_CHECK
1285 );
1286 }
1287}
1288
1289sub _sig_del {
1290 undef $SIG_TW
1291 unless --$SIG_COUNT;
1292}
1293
1269sub _signal { 1294sub _signal {
1270 my (undef, %arg) = @_; 1295 my (undef, %arg) = @_;
1271 1296
1272 my $signal = uc $arg{signal} 1297 my $signal = uc $arg{signal}
1273 or Carp::croak "required option 'signal' is missing"; 1298 or Carp::croak "required option 'signal' is missing";
… …
1297 undef $SIG_EV{$signal}; 1322 undef $SIG_EV{$signal};
1298 }; 1323 };
1299 1324
1300 # can't do signal processing without introducing races in pure perl, 1325 # can't do signal processing without introducing races in pure perl,
1301 # so limit the signal latency. 1326 # so limit the signal latency.
1302 ++$SIG_COUNT; 1327 _sig_add;
1303 $SIG_TW ||= AnyEvent->timer (
1304 after => $MAX_SIGNAL_LATENCY,
1305 interval => $MAX_SIGNAL_LATENCY,
1306 cb => sub { }, # just for the PERL_ASYNC_CHECK
1307 );
1308 } 1328 }
1309 1329
1310 bless [$signal, $arg{cb}], "AnyEvent::Base::signal" 1330 bless [$signal, $arg{cb}], "AnyEvent::Base::signal"
1311} 1331}
1312 1332
… …
1351} 1371}
1352 1372
1353sub AnyEvent::Base::signal::DESTROY { 1373sub AnyEvent::Base::signal::DESTROY {
1354 my ($signal, $cb) = @{$_[0]}; 1374 my ($signal, $cb) = @{$_[0]};
1355 1375
1356 undef $SIG_TW 1376 _sig_del;
1357 unless --$SIG_COUNT;
1358 1377
1359 delete $SIG_CB{$signal}{$cb}; 1378 delete $SIG_CB{$signal}{$cb};
1360 1379
1380 $HAVE_ASYNC_INTERRUPT
1381 ? delete $SIG_ASY{$signal}
1361 # delete doesn't work with older perls - they then 1382 : # delete doesn't work with older perls - they then
1362 # print weird messages, or just unconditionally exit 1383 # print weird messages, or just unconditionally exit
1363 # instead of getting the default action. 1384 # instead of getting the default action.
1364 undef $SIG{$signal} 1385 undef $SIG{$signal}
1365 unless keys %{ $SIG_CB{$signal} }; 1386 unless keys %{ $SIG_CB{$signal} };
1366} 1387}
1367 1388
1368# default implementation for ->child 1389# default implementation for ->child
1369 1390
… …
1386 defined (my $pid = $arg{pid} + 0) 1407 defined (my $pid = $arg{pid} + 0)
1387 or Carp::croak "required option 'pid' is missing"; 1408 or Carp::croak "required option 'pid' is missing";
1388 1409
1389 $PID_CB{$pid}{$arg{cb}} = $arg{cb}; 1410 $PID_CB{$pid}{$arg{cb}} = $arg{cb};
1390 1411
1412 # WNOHANG is almost cetrainly 1 everywhere
1413 $WNOHANG ||= $^O =~ /^(?:openbsd|netbsd|linux|freebsd|cygwin|MSWin32)$/
1414 ? 1
1391 $WNOHANG ||= eval { local $SIG{__DIE__}; require POSIX; &POSIX::WNOHANG } || 1; 1415 : eval { local $SIG{__DIE__}; require POSIX; &POSIX::WNOHANG } || 1;
1392 1416
1393 unless ($CHLD_W) { 1417 unless ($CHLD_W) {
1394 $CHLD_W = AnyEvent->signal (signal => 'CHLD', cb => \&_sigchld); 1418 $CHLD_W = AnyEvent->signal (signal => 'CHLD', cb => \&_sigchld);
1395 # child could be a zombie already, so make at least one round 1419 # child could be a zombie already, so make at least one round
1396 &_sigchld; 1420 &_sigchld;
… …
1448 1472
1449our @ISA = AnyEvent::CondVar::Base::; 1473our @ISA = AnyEvent::CondVar::Base::;
1450 1474
1451package AnyEvent::CondVar::Base; 1475package AnyEvent::CondVar::Base;
1452 1476
1453use overload 1477#use overload
1454 '&{}' => sub { my $self = shift; sub { $self->send (@_) } }, 1478# '&{}' => sub { my $self = shift; sub { $self->send (@_) } },
1455 fallback => 1; 1479# fallback => 1;
1480
1481# save 300+ kilobytes by dirtily hardcoding overloading
1482${"AnyEvent::CondVar::Base::OVERLOAD"}{dummy}++; # Register with magic by touching.
1483*{'AnyEvent::CondVar::Base::()'} = sub { }; # "Make it findable via fetchmethod."
1484*{'AnyEvent::CondVar::Base::(&{}'} = sub { my $self = shift; sub { $self->send (@_) } }; # &{}
1485${'AnyEvent::CondVar::Base::()'} = 1; # fallback
1456 1486
1457our $WAITING; 1487our $WAITING;
1458 1488
1459sub _send { 1489sub _send {
1460 # nop 1490 # nop
… …
1551C<PERL_ANYEVENT_MODEL>. 1581C<PERL_ANYEVENT_MODEL>.
1552 1582
1553When set to C<2> or higher, cause AnyEvent to report to STDERR which event 1583When set to C<2> or higher, cause AnyEvent to report to STDERR which event
1554model it chooses. 1584model it chooses.
1555 1585
1586When set to C<8> or higher, then AnyEvent will report extra information on
1587which optional modules it loads and how it implements certain features.
1588
1556=item C<PERL_ANYEVENT_STRICT> 1589=item C<PERL_ANYEVENT_STRICT>
1557 1590
1558AnyEvent does not do much argument checking by default, as thorough 1591AnyEvent does not do much argument checking by default, as thorough
1559argument checking is very costly. Setting this variable to a true value 1592argument checking is very costly. Setting this variable to a true value
1560will cause AnyEvent to load C<AnyEvent::Strict> and then to thoroughly 1593will cause AnyEvent to load C<AnyEvent::Strict> and then to thoroughly
1561check the arguments passed to most method calls. If it finds any problems, 1594check the arguments passed to most method calls. If it finds any problems,
1562it will croak. 1595it will croak.
1563 1596
1564In other words, enables "strict" mode. 1597In other words, enables "strict" mode.
1565 1598
1566Unlike C<use strict>, it is definitely recommended to keep it off in 1599Unlike C<use strict> (or it's modern cousin, C<< use L<common::sense>
1567production. Keeping C<PERL_ANYEVENT_STRICT=1> in your environment while 1600>>, it is definitely recommended to keep it off in production. Keeping
1568developing programs can be very useful, however. 1601C<PERL_ANYEVENT_STRICT=1> in your environment while developing programs
1602can be very useful, however.
1569 1603
1570=item C<PERL_ANYEVENT_MODEL> 1604=item C<PERL_ANYEVENT_MODEL>
1571 1605
1572This can be used to specify the event model to be used by AnyEvent, before 1606This can be used to specify the event model to be used by AnyEvent, before
1573auto detection and -probing kicks in. It must be a string consisting 1607auto detection and -probing kicks in. It must be a string consisting
… …
1635 1669
1636When neither C<ca_file> nor C<ca_path> was specified during 1670When neither C<ca_file> nor C<ca_path> was specified during
1637L<AnyEvent::TLS> context creation, and either of these environment 1671L<AnyEvent::TLS> context creation, and either of these environment
1638variables exist, they will be used to specify CA certificate locations 1672variables exist, they will be used to specify CA certificate locations
1639instead of a system-dependent default. 1673instead of a system-dependent default.
1674
1675=item C<PERL_ANYEVENT_AVOID_GUARD> and C<PERL_ANYEVENT_AVOID_ASYNC_INTERRUPT>
1676
1677When these are set to C<1>, then the respective modules are not
1678loaded. Mostly good for testing AnyEvent itself.
1640 1679
1641=back 1680=back
1642 1681
1643=head1 SUPPLYING YOUR OWN EVENT MODEL INTERFACE 1682=head1 SUPPLYING YOUR OWN EVENT MODEL INTERFACE
1644 1683

Diff Legend

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