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.363 by root, Sun Aug 14 13:56:52 2011 UTC

878 AnyEvent::Impl::EventLib based on Event::Lib, leaks memory and worse. 878 AnyEvent::Impl::EventLib based on Event::Lib, leaks memory and worse.
879 AnyEvent::Impl::POE based on POE, very slow, some limitations. 879 AnyEvent::Impl::POE based on POE, very slow, some limitations.
880 AnyEvent::Impl::Irssi used when running within irssi. 880 AnyEvent::Impl::Irssi used when running within irssi.
881 AnyEvent::Impl::IOAsync based on IO::Async. 881 AnyEvent::Impl::IOAsync based on IO::Async.
882 AnyEvent::Impl::Cocoa based on Cocoa::EventLoop. 882 AnyEvent::Impl::Cocoa based on Cocoa::EventLoop.
883 AnyEvent::Impl::FLTK based on FLTK. 883 AnyEvent::Impl::FLTK2 based on FLTK (fltk 2 binding).
884 884
885=item Backends with special needs. 885=item Backends with special needs.
886 886
887Qt requires the Qt::Application to be instantiated first, but will 887Qt requires the Qt::Application to be instantiated first, but will
888otherwise be picked up automatically. As long as the main program 888otherwise be picked up automatically. As long as the main program
933 933
934Returns C<$AnyEvent::MODEL>, forcing autodetection of the event model 934Returns C<$AnyEvent::MODEL>, forcing autodetection of the event model
935if necessary. You should only call this function right before you would 935if necessary. You should only call this function right before you would
936have created an AnyEvent watcher anyway, that is, as late as possible at 936have created an AnyEvent watcher anyway, that is, as late as possible at
937runtime, and not e.g. during initialisation of your module. 937runtime, and not e.g. during initialisation of your module.
938
939The effect of calling this function is as if a watcher had been created
940(specifically, actions that happen "when the first watcher is created"
941happen when calling detetc as well).
938 942
939If you need to do some initialisation before AnyEvent watchers are 943If you need to do some initialisation before AnyEvent watchers are
940created, use C<post_detect>. 944created, use C<post_detect>.
941 945
942=item $guard = AnyEvent::post_detect { BLOCK } 946=item $guard = AnyEvent::post_detect { BLOCK }
1202 1206
1203BEGIN { AnyEvent::common_sense } 1207BEGIN { AnyEvent::common_sense }
1204 1208
1205use Carp (); 1209use Carp ();
1206 1210
1207our $VERSION = '5.34'; 1211our $VERSION = '6.01';
1208our $MODEL; 1212our $MODEL;
1209 1213
1210our $AUTOLOAD;
1211our @ISA; 1214our @ISA;
1212 1215
1213our @REGISTRY; 1216our @REGISTRY;
1214 1217
1215our $VERBOSE; 1218our $VERBOSE;
1235 $PROTOCOL{$_} = ++$idx 1238 $PROTOCOL{$_} = ++$idx
1236 for reverse split /\s*,\s*/, 1239 for reverse split /\s*,\s*/,
1237 $ENV{PERL_ANYEVENT_PROTOCOLS} || "ipv4,ipv6"; 1240 $ENV{PERL_ANYEVENT_PROTOCOLS} || "ipv4,ipv6";
1238} 1241}
1239 1242
1243our @post_detect;
1244
1245sub post_detect(&) {
1246 my ($cb) = @_;
1247
1248 push @post_detect, $cb;
1249
1250 defined wantarray
1251 ? bless \$cb, "AnyEvent::Util::postdetect"
1252 : ()
1253}
1254
1255sub AnyEvent::Util::postdetect::DESTROY {
1256 @post_detect = grep $_ != ${$_[0]}, @post_detect;
1257}
1258
1259our $POSTPONE_W;
1260our @POSTPONE;
1261
1262sub _postpone_exec {
1263 undef $POSTPONE_W;
1264
1265 &{ shift @POSTPONE }
1266 while @POSTPONE;
1267}
1268
1269sub postpone(&) {
1270 push @POSTPONE, shift;
1271
1272 $POSTPONE_W ||= AE::timer (0, 0, \&_postpone_exec);
1273
1274 ()
1275}
1276
1240my @models = ( 1277our @models = (
1241 [EV:: => AnyEvent::Impl::EV:: , 1], 1278 [EV:: => AnyEvent::Impl::EV:: , 1],
1242 [AnyEvent::Loop:: => AnyEvent::Impl::Perl:: , 1], 1279 [AnyEvent::Loop:: => AnyEvent::Impl::Perl:: , 1],
1243 # everything below here will not (normally) be autoprobed 1280 # everything below here will not (normally) be autoprobed
1244 # as the pure perl backend should work everywhere 1281 # as the pure perl backend should work everywhere
1245 # and is usually faster 1282 # and is usually faster
1250 [Tk:: => AnyEvent::Impl::Tk::], # crashes with many handles 1287 [Tk:: => AnyEvent::Impl::Tk::], # crashes with many handles
1251 [Qt:: => AnyEvent::Impl::Qt::], # requires special main program 1288 [Qt:: => AnyEvent::Impl::Qt::], # requires special main program
1252 [POE::Kernel:: => AnyEvent::Impl::POE::], # lasciate ogni speranza 1289 [POE::Kernel:: => AnyEvent::Impl::POE::], # lasciate ogni speranza
1253 [Wx:: => AnyEvent::Impl::POE::], 1290 [Wx:: => AnyEvent::Impl::POE::],
1254 [Prima:: => AnyEvent::Impl::POE::], 1291 [Prima:: => AnyEvent::Impl::POE::],
1255 [IO::Async::Loop:: => AnyEvent::Impl::IOAsync::], 1292 [IO::Async::Loop:: => AnyEvent::Impl::IOAsync::], # a bitch to autodetect
1256 [Cocoa::EventLoop:: => AnyEvent::Impl::Cocoa::], 1293 [Cocoa::EventLoop:: => AnyEvent::Impl::Cocoa::],
1257 [FLTK:: => AnyEvent::Impl::FLTK::], 1294 [FLTK:: => AnyEvent::Impl::FLTK2::],
1258); 1295);
1259 1296
1260our %method = map +($_ => 1), 1297our @isa_hook;
1298
1299sub _isa_set {
1300 my @pkg = ("AnyEvent", (map $_->[0], grep defined, @isa_hook), $MODEL);
1301
1302 @{"$pkg[$_-1]::ISA"} = $pkg[$_]
1303 for 1 .. $#pkg;
1304
1305 grep $_ && $_->[1], @isa_hook
1306 and AE::_reset ();
1307}
1308
1309# used for hooking AnyEvent::Strict and AnyEvent::Debug::Wrap into the class hierarchy
1310sub _isa_hook($$;$) {
1311 my ($i, $pkg, $reset_ae) = @_;
1312
1313 $isa_hook[$i] = $pkg ? [$pkg, $reset_ae] : undef;
1314
1315 _isa_set;
1316}
1317
1318# all autoloaded methods reserve the complete glob, not just the method slot.
1319# due to bugs in perls method cache implementation.
1261 qw(io timer time now now_update signal child idle condvar DESTROY); 1320our @methods = qw(io timer time now now_update signal child idle condvar);
1262
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 1321
1279sub detect() { 1322sub detect() {
1323 return $MODEL if $MODEL; # some programs keep references to detect
1324
1325 local $!; # for good measure
1326 local $SIG{__DIE__}; # we use eval
1327
1280 # free some memory 1328 # free some memory
1281 *detect = sub () { $MODEL }; 1329 *detect = sub () { $MODEL };
1330 # undef &func doesn't correctly update the method cache. grmbl.
1331 # so we delete the whole glob. grmbl.
1332 # otoh, perl doesn't let me undef an active usb, but it lets me free
1333 # a glob with an active sub. hrm. i hope it works, but perl is
1334 # usually buggy in this department. sigh.
1335 delete @{"AnyEvent::"}{@methods};
1336 undef @methods;
1282 1337
1283 local $!; # for good measure
1284 local $SIG{__DIE__};
1285
1286 if ($ENV{PERL_ANYEVENT_MODEL} =~ /^([a-zA-Z]+)$/) { 1338 if ($ENV{PERL_ANYEVENT_MODEL} =~ /^([a-zA-Z0-9:]+)$/) {
1287 my $model = "AnyEvent::Impl::$1"; 1339 my $model = $1;
1340 $model = "AnyEvent::Impl::$model" unless $model =~ s/::$//;
1288 if (eval "require $model") { 1341 if (eval "require $model") {
1289 $MODEL = $model; 1342 $MODEL = $model;
1290 warn "AnyEvent: loaded model '$model' (forced by \$ENV{PERL_ANYEVENT_MODEL}), using it.\n" if $VERBOSE >= 2; 1343 warn "AnyEvent: loaded model '$model' (forced by \$ENV{PERL_ANYEVENT_MODEL}), using it.\n" if $VERBOSE >= 2;
1291 } else { 1344 } else {
1292 warn "AnyEvent: unable to load model '$model' (from \$ENV{PERL_ANYEVENT_MODEL}):\n$@" if $VERBOSE; 1345 warn "AnyEvent: unable to load model '$model' (from \$ENV{PERL_ANYEVENT_MODEL}):\n$@" if $VERBOSE;
1325 $MODEL 1378 $MODEL
1326 or die "AnyEvent: backend autodetection failed - did you properly install AnyEvent?\n"; 1379 or die "AnyEvent: backend autodetection failed - did you properly install AnyEvent?\n";
1327 } 1380 }
1328 } 1381 }
1329 1382
1330 @models = (); # free probe data 1383 # free memory only needed for probing
1384 undef @models;
1385 undef @REGISTRY;
1331 1386
1332 push @{"$MODEL\::ISA"}, "AnyEvent::Base"; 1387 push @{"$MODEL\::ISA"}, "AnyEvent::Base";
1333 unshift @ISA, $MODEL;
1334 1388
1335 # now nuke some methods that are overridden by the backend. 1389 # now nuke some methods that are overridden by the backend.
1336 # SUPER is not allowed. 1390 # SUPER usage is not allowed in these.
1337 for (qw(time signal child idle)) { 1391 for (qw(time signal child idle)) {
1338 undef &{"AnyEvent::Base::$_"} 1392 undef &{"AnyEvent::Base::$_"}
1339 if defined &{"$MODEL\::$_"}; 1393 if defined &{"$MODEL\::$_"};
1340 } 1394 }
1341 1395
1396 _isa_set;
1397
1342 if ($ENV{PERL_ANYEVENT_STRICT}) { 1398 if ($ENV{PERL_ANYEVENT_STRICT}) {
1343 eval { require AnyEvent::Strict }; 1399 require AnyEvent::Strict;
1344 warn "AnyEvent: cannot load AnyEvent::Strict: $@"
1345 if $@ && $VERBOSE;
1346 } 1400 }
1347 1401
1402 if ($ENV{PERL_ANYEVENT_DEBUG_WRAP}) {
1403 require AnyEvent::Debug;
1404 AnyEvent::Debug::wrap ($ENV{PERL_ANYEVENT_DEBUG_WRAP});
1405 }
1406
1407 if (exists $ENV{PERL_ANYEVENT_DEBUG_SHELL}) {
1408 require AnyEvent::Socket;
1409 require AnyEvent::Debug;
1410
1411 my $shell = $ENV{PERL_ANYEVENT_DEBUG_SHELL};
1412 $shell =~ s/\$\$/$$/g;
1413
1414 my ($host, $service) = AnyEvent::Socket::parse_hostport ($shell);
1415 $AnyEvent::Debug::SHELL = AnyEvent::Debug::shell ($host, $service);
1416 }
1417
1348 (shift @post_detect)->() while @post_detect; 1418 (shift @post_detect)->() while @post_detect;
1419 undef @post_detect;
1349 1420
1350 *post_detect = sub(&) { 1421 *post_detect = sub(&) {
1351 shift->(); 1422 shift->();
1352 1423
1353 undef 1424 undef
1354 }; 1425 };
1355 1426
1356 $MODEL 1427 $MODEL
1357} 1428}
1358 1429
1359sub AUTOLOAD { 1430for my $name (@methods) {
1360 (my $func = $AUTOLOAD) =~ s/.*://; 1431 *$name = sub {
1361
1362 $method{$func}
1363 or Carp::croak "$func: not a valid AnyEvent class method";
1364
1365 detect; 1432 detect;
1366 1433 # we use goto because
1367 my $class = shift; 1434 # a) it makes the thunk more transparent
1368 $class->$func (@_); 1435 # b) it allows us to delete the thunk later
1369} 1436 goto &{ UNIVERSAL::can AnyEvent => "SUPER::$name" }
1370 1437 };
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} 1438}
1387 1439
1388# utility function to dup a filehandle. this is used by many backends 1440# utility function to dup a filehandle. this is used by many backends
1389# to support binding more than one watcher per filehandle (they usually 1441# 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). 1442# allow only one watcher per fd, so we dup it to get a different one).
1414 1466
1415package AE; 1467package AE;
1416 1468
1417our $VERSION = $AnyEvent::VERSION; 1469our $VERSION = $AnyEvent::VERSION;
1418 1470
1471sub _reset() {
1472 eval q{
1419# fall back to the main API by default - backends and AnyEvent::Base 1473 # fall back to the main API by default - backends and AnyEvent::Base
1420# implementations can overwrite these. 1474 # implementations can overwrite these.
1421 1475
1422sub io($$$) { 1476 sub io($$$) {
1423 AnyEvent->io (fh => $_[0], poll => $_[1] ? "w" : "r", cb => $_[2]) 1477 AnyEvent->io (fh => $_[0], poll => $_[1] ? "w" : "r", cb => $_[2])
1424} 1478 }
1425 1479
1426sub timer($$$) { 1480 sub timer($$$) {
1427 AnyEvent->timer (after => $_[0], interval => $_[1], cb => $_[2]) 1481 AnyEvent->timer (after => $_[0], interval => $_[1], cb => $_[2])
1428} 1482 }
1429 1483
1430sub signal($$) { 1484 sub signal($$) {
1431 AnyEvent->signal (signal => $_[0], cb => $_[1]) 1485 AnyEvent->signal (signal => $_[0], cb => $_[1])
1432} 1486 }
1433 1487
1434sub child($$) { 1488 sub child($$) {
1435 AnyEvent->child (pid => $_[0], cb => $_[1]) 1489 AnyEvent->child (pid => $_[0], cb => $_[1])
1436} 1490 }
1437 1491
1438sub idle($) { 1492 sub idle($) {
1439 AnyEvent->idle (cb => $_[0]) 1493 AnyEvent->idle (cb => $_[0]);
1440} 1494 }
1441 1495
1442sub cv(;&) { 1496 sub cv(;&) {
1443 AnyEvent->condvar (@_ ? (cb => $_[0]) : ()) 1497 AnyEvent->condvar (@_ ? (cb => $_[0]) : ())
1444} 1498 }
1445 1499
1446sub now() { 1500 sub now() {
1447 AnyEvent->now 1501 AnyEvent->now
1448} 1502 }
1449 1503
1450sub now_update() { 1504 sub now_update() {
1451 AnyEvent->now_update 1505 AnyEvent->now_update
1452} 1506 }
1453 1507
1454sub time() { 1508 sub time() {
1455 AnyEvent->time 1509 AnyEvent->time
1456} 1510 }
1457 1511
1458*postpone = \&AnyEvent::postpone; 1512 *postpone = \&AnyEvent::postpone;
1513 };
1514 die if $@;
1515}
1516
1517BEGIN { _reset }
1459 1518
1460package AnyEvent::Base; 1519package AnyEvent::Base;
1461 1520
1462# default implementations for many methods 1521# default implementations for many methods
1463 1522
1464sub time { 1523sub time {
1465 eval q{ # poor man's autoloading {} 1524 eval q{ # poor man's autoloading {}
1466 # probe for availability of Time::HiRes 1525 # probe for availability of Time::HiRes
1467 if (eval "use Time::HiRes (); Time::HiRes::time (); 1") { 1526 if (eval "use Time::HiRes (); Time::HiRes::time (); 1") {
1468 warn "AnyEvent: using Time::HiRes for sub-second timing accuracy.\n" if $VERBOSE >= 8; 1527 warn "AnyEvent: using Time::HiRes for sub-second timing accuracy.\n" if $VERBOSE >= 8;
1528 *time = sub { Time::HiRes::time () };
1469 *AE::time = \&Time::HiRes::time; 1529 *AE::time = \& Time::HiRes::time ;
1470 # if (eval "use POSIX (); (POSIX::times())... 1530 # if (eval "use POSIX (); (POSIX::times())...
1471 } else { 1531 } else {
1472 warn "AnyEvent: using built-in time(), WARNING, no sub-second resolution!\n" if $VERBOSE; 1532 warn "AnyEvent: using built-in time(), WARNING, no sub-second resolution!\n" if $VERBOSE;
1533 *time = sub { CORE::time };
1473 *AE::time = sub (){ time }; # epic fail 1534 *AE::time = sub (){ CORE::time };
1474 } 1535 }
1475 1536
1476 *time = sub { AE::time }; # different prototypes 1537 *now = \&time;
1477 }; 1538 };
1478 die if $@; 1539 die if $@;
1479 1540
1480 &time 1541 &time
1481} 1542}
1482 1543
1483*now = \&time; 1544*now = \&time;
1484
1485sub now_update { } 1545sub now_update { }
1486 1546
1487sub _poll { 1547sub _poll {
1488 Carp::croak "$AnyEvent::MODEL does not support blocking waits. Caught"; 1548 Carp::croak "$AnyEvent::MODEL does not support blocking waits. Caught";
1489} 1549}
1667 : sysread $SIGPIPE_R, (my $dummy), 9; 1727 : sysread $SIGPIPE_R, (my $dummy), 9;
1668 1728
1669 while (%SIG_EV) { 1729 while (%SIG_EV) {
1670 for (keys %SIG_EV) { 1730 for (keys %SIG_EV) {
1671 delete $SIG_EV{$_}; 1731 delete $SIG_EV{$_};
1672 $_->() for values %{ $SIG_CB{$_} || {} }; 1732 &$_ for values %{ $SIG_CB{$_} || {} };
1673 } 1733 }
1674 } 1734 }
1675 }; 1735 };
1676 }; 1736 };
1677 die if $@; 1737 die if $@;
1744 1804
1745 my ($cb, $w, $rcb) = $arg{cb}; 1805 my ($cb, $w, $rcb) = $arg{cb};
1746 1806
1747 $rcb = sub { 1807 $rcb = sub {
1748 if ($cb) { 1808 if ($cb) {
1749 $w = _time; 1809 $w = AE::time;
1750 &$cb; 1810 &$cb;
1751 $w = _time - $w; 1811 $w = AE::time - $w;
1752 1812
1753 # never use more then 50% of the time for the idle watcher, 1813 # never use more then 50% of the time for the idle watcher,
1754 # within some limits 1814 # within some limits
1755 $w = 0.0001 if $w < 0.0001; 1815 $w = 0.0001 if $w < 0.0001;
1756 $w = 5 if $w > 5; 1816 $w = 5 if $w > 5;
1925Unlike C<use strict> (or its modern cousin, C<< use L<common::sense> 1985Unlike C<use strict> (or its modern cousin, C<< use L<common::sense>
1926>>, it is definitely recommended to keep it off in production. Keeping 1986>>, it is definitely recommended to keep it off in production. Keeping
1927C<PERL_ANYEVENT_STRICT=1> in your environment while developing programs 1987C<PERL_ANYEVENT_STRICT=1> in your environment while developing programs
1928can be very useful, however. 1988can be very useful, however.
1929 1989
1990=item C<PERL_ANYEVENT_DEBUG_SHELL>
1991
1992If this env variable is set, then its contents will be interpreted by
1993C<AnyEvent::Socket::parse_hostport> (after replacing every occurance of
1994C<$$> by the process pid) and an C<AnyEvent::Debug::shell> is bound on
1995that port. The shell object is saved in C<$AnyEvent::Debug::SHELL>.
1996
1997This takes place when the first watcher is created.
1998
1999For example, to bind a debug shell on a unix domain socket in
2000F<< /tmp/debug<pid>.sock >>, you could use this:
2001
2002 PERL_ANYEVENT_DEBUG_SHELL=unix/:/tmp/debug\$\$.sock perlprog
2003
2004Note that creating sockets in F</tmp> is very unsafe on multiuser
2005systems.
2006
2007=item C<PERL_ANYEVENT_DEBUG_WRAP>
2008
2009Can be set to C<0>, C<1> or C<2> and enables wrapping of all watchers for
2010debugging purposes. See C<AnyEvent::Debug::wrap> for details.
2011
1930=item C<PERL_ANYEVENT_MODEL> 2012=item C<PERL_ANYEVENT_MODEL>
1931 2013
1932This can be used to specify the event model to be used by AnyEvent, before 2014This 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 2015auto detection and -probing kicks in.
1934entirely of ASCII letters. The string C<AnyEvent::Impl::> gets prepended 2016
2017It normally is a string consisting entirely of ASCII letters (e.g. C<EV>
2018or C<IOAsync>). The string C<AnyEvent::Impl::> gets prepended and the
1935and the resulting module name is loaded and if the load was successful, 2019resulting 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 2020event model backend. If it fails to load then AnyEvent will proceed with
1937auto detection and -probing. 2021auto detection and -probing.
1938 2022
1939This functionality might change in future versions. 2023If the string ends with C<::> instead (e.g. C<AnyEvent::Impl::EV::>) then
2024nothing gets prepended and the module name is used as-is (hint: C<::> at
2025the end of a string designates a module name and quotes it appropriately).
1940 2026
1941For example, to force the pure perl model (L<AnyEvent::Loop::Perl>) you 2027For example, to force the pure perl model (L<AnyEvent::Loop::Perl>) you
1942could start your program like this: 2028could start your program like this:
1943 2029
1944 PERL_ANYEVENT_MODEL=Perl perl ... 2030 PERL_ANYEVENT_MODEL=Perl perl ...
2336(even when used without AnyEvent), but most event loops have acceptable 2422(even when used without AnyEvent), but most event loops have acceptable
2337performance with or without AnyEvent. 2423performance with or without AnyEvent.
2338 2424
2339=item * The overhead AnyEvent adds is usually much smaller than the overhead of 2425=item * The overhead AnyEvent adds is usually much smaller than the overhead of
2340the actual event loop, only with extremely fast event loops such as EV 2426the actual event loop, only with extremely fast event loops such as EV
2341adds AnyEvent significant overhead. 2427does AnyEvent add significant overhead.
2342 2428
2343=item * You should avoid POE like the plague if you want performance or 2429=item * You should avoid POE like the plague if you want performance or
2344reasonable memory usage. 2430reasonable memory usage.
2345 2431
2346=back 2432=back

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines