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.354 by root, Thu Aug 11 21:26:39 2011 UTC vs.
Revision 1.355 by root, Fri Aug 12 00:53:29 2011 UTC

1235 $PROTOCOL{$_} = ++$idx 1235 $PROTOCOL{$_} = ++$idx
1236 for reverse split /\s*,\s*/, 1236 for reverse split /\s*,\s*/,
1237 $ENV{PERL_ANYEVENT_PROTOCOLS} || "ipv4,ipv6"; 1237 $ENV{PERL_ANYEVENT_PROTOCOLS} || "ipv4,ipv6";
1238} 1238}
1239 1239
1240our @post_detect;
1241
1242sub post_detect(&) {
1243 my ($cb) = @_;
1244
1245 push @post_detect, $cb;
1246
1247 defined wantarray
1248 ? bless \$cb, "AnyEvent::Util::postdetect"
1249 : ()
1250}
1251
1252sub AnyEvent::Util::postdetect::DESTROY {
1253 @post_detect = grep $_ != ${$_[0]}, @post_detect;
1254}
1255
1256our $POSTPONE_W;
1257our @POSTPONE;
1258
1259sub _postpone_exec {
1260 undef $POSTPONE_W;
1261
1262 &{ shift @POSTPONE }
1263 while @POSTPONE;
1264}
1265
1266sub postpone(&) {
1267 push @POSTPONE, shift;
1268
1269 $POSTPONE_W ||= AE::timer (0, 0, \&_postpone_exec);
1270
1271 ()
1272}
1273
1240my @models = ( 1274our @models = (
1241 [EV:: => AnyEvent::Impl::EV:: , 1], 1275 [EV:: => AnyEvent::Impl::EV:: , 1],
1242 [AnyEvent::Loop:: => AnyEvent::Impl::Perl:: , 1], 1276 [AnyEvent::Loop:: => AnyEvent::Impl::Perl:: , 1],
1243 # everything below here will not (normally) be autoprobed 1277 # everything below here will not (normally) be autoprobed
1244 # as the pure perl backend should work everywhere 1278 # as the pure perl backend should work everywhere
1245 # and is usually faster 1279 # and is usually faster
1250 [Tk:: => AnyEvent::Impl::Tk::], # crashes with many handles 1284 [Tk:: => AnyEvent::Impl::Tk::], # crashes with many handles
1251 [Qt:: => AnyEvent::Impl::Qt::], # requires special main program 1285 [Qt:: => AnyEvent::Impl::Qt::], # requires special main program
1252 [POE::Kernel:: => AnyEvent::Impl::POE::], # lasciate ogni speranza 1286 [POE::Kernel:: => AnyEvent::Impl::POE::], # lasciate ogni speranza
1253 [Wx:: => AnyEvent::Impl::POE::], 1287 [Wx:: => AnyEvent::Impl::POE::],
1254 [Prima:: => AnyEvent::Impl::POE::], 1288 [Prima:: => AnyEvent::Impl::POE::],
1255 [IO::Async::Loop:: => AnyEvent::Impl::IOAsync::], 1289 [IO::Async::Loop:: => AnyEvent::Impl::IOAsync::], # a bitch to autodetect
1256 [Cocoa::EventLoop:: => AnyEvent::Impl::Cocoa::], 1290 [Cocoa::EventLoop:: => AnyEvent::Impl::Cocoa::],
1257 [FLTK:: => AnyEvent::Impl::FLTK::], 1291 [FLTK:: => AnyEvent::Impl::FLTK::],
1258); 1292);
1259 1293
1260our %method = map +($_ => 1), 1294our %method = map +($_ => 1),
1261 qw(io timer time now now_update signal child idle condvar DESTROY); 1295 qw(io timer time now now_update signal child idle condvar DESTROY);
1262 1296
1263our @post_detect;
1264
1265sub post_detect(&) {
1266 my ($cb) = @_;
1267
1268 push @post_detect, $cb;
1269
1270 defined wantarray
1271 ? bless \$cb, "AnyEvent::Util::postdetect"
1272 : ()
1273}
1274
1275sub AnyEvent::Util::postdetect::DESTROY {
1276 @post_detect = grep $_ != ${$_[0]}, @post_detect;
1277}
1278
1279sub detect() { 1297sub detect() {
1280 # free some memory 1298 # free some memory
1281 *detect = sub () { $MODEL }; 1299 *detect = sub () { $MODEL };
1282 1300
1283 local $!; # for good measure 1301 local $!; # for good measure
1284 local $SIG{__DIE__}; 1302 local $SIG{__DIE__};
1285 1303
1286 if ($ENV{PERL_ANYEVENT_MODEL} =~ /^([a-zA-Z]+)$/) { 1304 if ($ENV{PERL_ANYEVENT_MODEL} =~ /^([a-zA-Z0-9:]+)$/) {
1287 my $model = "AnyEvent::Impl::$1"; 1305 my $model = $1;
1306 $model = "AnyEvent::Impl::$model" unless $model =~ s/::$//;
1288 if (eval "require $model") { 1307 if (eval "require $model") {
1289 $MODEL = $model; 1308 $MODEL = $model;
1290 warn "AnyEvent: loaded model '$model' (forced by \$ENV{PERL_ANYEVENT_MODEL}), using it.\n" if $VERBOSE >= 2; 1309 warn "AnyEvent: loaded model '$model' (forced by \$ENV{PERL_ANYEVENT_MODEL}), using it.\n" if $VERBOSE >= 2;
1291 } else { 1310 } else {
1292 warn "AnyEvent: unable to load model '$model' (from \$ENV{PERL_ANYEVENT_MODEL}):\n$@" if $VERBOSE; 1311 warn "AnyEvent: unable to load model '$model' (from \$ENV{PERL_ANYEVENT_MODEL}):\n$@" if $VERBOSE;
1325 $MODEL 1344 $MODEL
1326 or die "AnyEvent: backend autodetection failed - did you properly install AnyEvent?\n"; 1345 or die "AnyEvent: backend autodetection failed - did you properly install AnyEvent?\n";
1327 } 1346 }
1328 } 1347 }
1329 1348
1330 @models = (); # free probe data 1349 # free memory only needed for probing
1350 undef @models;
1351 undef @REGISTRY;
1331 1352
1332 push @{"$MODEL\::ISA"}, "AnyEvent::Base"; 1353 push @{"$MODEL\::ISA"}, "AnyEvent::Base";
1333 unshift @ISA, $MODEL; 1354 unshift @ISA, $MODEL;
1334 1355
1335 # now nuke some methods that are overridden by the backend. 1356 # now nuke some methods that are overridden by the backend.
1336 # SUPER is not allowed. 1357 # SUPER usage is not allowed in these.
1337 for (qw(time signal child idle)) { 1358 for (qw(time signal child idle)) {
1338 undef &{"AnyEvent::Base::$_"} 1359 undef &{"AnyEvent::Base::$_"}
1339 if defined &{"$MODEL\::$_"}; 1360 if defined &{"$MODEL\::$_"};
1340 } 1361 }
1341 1362
1344 warn "AnyEvent: cannot load AnyEvent::Strict: $@" 1365 warn "AnyEvent: cannot load AnyEvent::Strict: $@"
1345 if $@ && $VERBOSE; 1366 if $@ && $VERBOSE;
1346 } 1367 }
1347 1368
1348 (shift @post_detect)->() while @post_detect; 1369 (shift @post_detect)->() while @post_detect;
1370 undef @post_detect;
1349 1371
1350 *post_detect = sub(&) { 1372 *post_detect = sub(&) {
1351 shift->(); 1373 shift->();
1352 1374
1353 undef 1375 undef
1354 }; 1376 };
1355 1377
1378 # recover a few more bytes
1379 postpone {
1380 undef &AUTOLOAD;
1381 };
1382
1356 $MODEL 1383 $MODEL
1357} 1384}
1385
1386our %method = map +($_ => 1),
1387 qw(io timer time now now_update signal child idle condvar DESTROY);
1358 1388
1359sub AUTOLOAD { 1389sub AUTOLOAD {
1360 (my $func = $AUTOLOAD) =~ s/.*://; 1390 (my $func = $AUTOLOAD) =~ s/.*://;
1361 1391
1362 $method{$func} 1392 $method{$func}
1363 or Carp::croak "$func: not a valid AnyEvent class method"; 1393 or Carp::croak "$func: not a valid AnyEvent class method";
1364 1394
1395 # free some memory
1396 undef %method;
1397
1365 detect; 1398 detect;
1366 1399
1367 my $class = shift; 1400 my $class = shift;
1368 $class->$func (@_); 1401 $class->$func (@_);
1369}
1370
1371our $POSTPONE_W;
1372our @POSTPONE;
1373
1374sub _postpone_exec {
1375 undef $POSTPONE_W;
1376 (pop @POSTPONE)->()
1377 while @POSTPONE;
1378}
1379
1380sub postpone(&) {
1381 push @POSTPONE, shift;
1382
1383 $POSTPONE_W ||= AE::timer (0, 0, \&_postpone_exec);
1384
1385 ()
1386} 1402}
1387 1403
1388# utility function to dup a filehandle. this is used by many backends 1404# utility function to dup a filehandle. this is used by many backends
1389# to support binding more than one watcher per filehandle (they usually 1405# to support binding more than one watcher per filehandle (they usually
1390# allow only one watcher per fd, so we dup it to get a different one). 1406# allow only one watcher per fd, so we dup it to get a different one).
1414 1430
1415package AE; 1431package AE;
1416 1432
1417our $VERSION = $AnyEvent::VERSION; 1433our $VERSION = $AnyEvent::VERSION;
1418 1434
1435
1436sub _reset() {
1437 eval q{
1419# fall back to the main API by default - backends and AnyEvent::Base 1438 # fall back to the main API by default - backends and AnyEvent::Base
1420# implementations can overwrite these. 1439 # implementations can overwrite these.
1421 1440
1422sub io($$$) { 1441 sub io($$$) {
1423 AnyEvent->io (fh => $_[0], poll => $_[1] ? "w" : "r", cb => $_[2]) 1442 AnyEvent->io (fh => $_[0], poll => $_[1] ? "w" : "r", cb => $_[2])
1424} 1443 }
1425 1444
1426sub timer($$$) { 1445 sub timer($$$) {
1427 AnyEvent->timer (after => $_[0], interval => $_[1], cb => $_[2]) 1446 AnyEvent->timer (after => $_[0], interval => $_[1], cb => $_[2])
1428} 1447 }
1429 1448
1430sub signal($$) { 1449 sub signal($$) {
1431 AnyEvent->signal (signal => $_[0], cb => $_[1]) 1450 AnyEvent->signal (signal => $_[0], cb => $_[1])
1432} 1451 }
1433 1452
1434sub child($$) { 1453 sub child($$) {
1435 AnyEvent->child (pid => $_[0], cb => $_[1]) 1454 AnyEvent->child (pid => $_[0], cb => $_[1])
1436} 1455 }
1437 1456
1438sub idle($) { 1457 sub idle($) {
1439 AnyEvent->idle (cb => $_[0]) 1458 AnyEvent->idle (cb => $_[0])
1440} 1459 }
1441 1460
1442sub cv(;&) { 1461 sub cv(;&) {
1443 AnyEvent->condvar (@_ ? (cb => $_[0]) : ()) 1462 AnyEvent->condvar (@_ ? (cb => $_[0]) : ())
1444} 1463 }
1445 1464
1446sub now() { 1465 sub now() {
1447 AnyEvent->now 1466 AnyEvent->now
1448} 1467 }
1449 1468
1450sub now_update() { 1469 sub now_update() {
1451 AnyEvent->now_update 1470 AnyEvent->now_update
1452} 1471 }
1453 1472
1454sub time() { 1473 sub time() {
1455 AnyEvent->time 1474 AnyEvent->time
1456} 1475 }
1457 1476
1458*postpone = \&AnyEvent::postpone; 1477 *postpone = \&AnyEvent::postpone;
1478 };
1479 die if $@;
1480}
1481
1482BEGIN { _reset }
1459 1483
1460package AnyEvent::Base; 1484package AnyEvent::Base;
1461 1485
1462# default implementations for many methods 1486# default implementations for many methods
1463 1487
1667 : sysread $SIGPIPE_R, (my $dummy), 9; 1691 : sysread $SIGPIPE_R, (my $dummy), 9;
1668 1692
1669 while (%SIG_EV) { 1693 while (%SIG_EV) {
1670 for (keys %SIG_EV) { 1694 for (keys %SIG_EV) {
1671 delete $SIG_EV{$_}; 1695 delete $SIG_EV{$_};
1672 $_->() for values %{ $SIG_CB{$_} || {} }; 1696 &$_ for values %{ $SIG_CB{$_} || {} };
1673 } 1697 }
1674 } 1698 }
1675 }; 1699 };
1676 }; 1700 };
1677 die if $@; 1701 die if $@;
1928can be very useful, however. 1952can be very useful, however.
1929 1953
1930=item C<PERL_ANYEVENT_MODEL> 1954=item C<PERL_ANYEVENT_MODEL>
1931 1955
1932This can be used to specify the event model to be used by AnyEvent, before 1956This can be used to specify the event model to be used by AnyEvent, before
1933auto detection and -probing kicks in. It must be a string consisting 1957auto detection and -probing kicks in.
1934entirely of ASCII letters. The string C<AnyEvent::Impl::> gets prepended 1958
1959It normally is a string consisting entirely of ASCII letters (e.g. C<EV>
1960or C<IOAsync>). The string C<AnyEvent::Impl::> gets prepended and the
1935and the resulting module name is loaded and if the load was successful, 1961resulting module name is loaded and - if the load was successful - used as
1936used as event model. If it fails to load AnyEvent will proceed with 1962event model backend. If it fails to load then AnyEvent will proceed with
1937auto detection and -probing. 1963auto detection and -probing.
1938 1964
1939This functionality might change in future versions. 1965If the string ends with C<::> instead (e.g. C<AnyEvent::Impl::EV::>) then
1966nothing gets prepended and the module name is used as-is (hint: C<::> at
1967the end of a string designates a module name and quotes it appropriately).
1940 1968
1941For example, to force the pure perl model (L<AnyEvent::Loop::Perl>) you 1969For example, to force the pure perl model (L<AnyEvent::Loop::Perl>) you
1942could start your program like this: 1970could start your program like this:
1943 1971
1944 PERL_ANYEVENT_MODEL=Perl perl ... 1972 PERL_ANYEVENT_MODEL=Perl perl ...

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines