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.360 by root, Sat Aug 13 22:44:05 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.0';
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), 1297# all autoloaded methods reserve the complete glob, not just the method slot.
1298# due to bugs in perls method cache implementation.
1261 qw(io timer time now now_update signal child idle condvar DESTROY); 1299our @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 1300
1279sub detect() { 1301sub detect() {
1302 local $!; # for good measure
1303 local $SIG{__DIE__}; # we use eval
1304
1280 # free some memory 1305 # free some memory
1281 *detect = sub () { $MODEL }; 1306 *detect = sub () { $MODEL };
1307 # undef &func doesn't correctly update the method cache. grmbl.
1308 # so we delete the whole glob. grmbl.
1309 # otoh, perl doesn't let me undef an active usb, but it lets me free
1310 # a glob with an active sub. hrm. i hope it works, but perl is
1311 # usually buggy in this department. sigh.
1312 delete @{"AnyEvent::"}{@methods};
1313 undef @methods;
1282 1314
1283 local $!; # for good measure
1284 local $SIG{__DIE__};
1285
1286 if ($ENV{PERL_ANYEVENT_MODEL} =~ /^([a-zA-Z]+)$/) { 1315 if ($ENV{PERL_ANYEVENT_MODEL} =~ /^([a-zA-Z0-9:]+)$/) {
1287 my $model = "AnyEvent::Impl::$1"; 1316 my $model = $1;
1317 $model = "AnyEvent::Impl::$model" unless $model =~ s/::$//;
1288 if (eval "require $model") { 1318 if (eval "require $model") {
1289 $MODEL = $model; 1319 $MODEL = $model;
1290 warn "AnyEvent: loaded model '$model' (forced by \$ENV{PERL_ANYEVENT_MODEL}), using it.\n" if $VERBOSE >= 2; 1320 warn "AnyEvent: loaded model '$model' (forced by \$ENV{PERL_ANYEVENT_MODEL}), using it.\n" if $VERBOSE >= 2;
1291 } else { 1321 } else {
1292 warn "AnyEvent: unable to load model '$model' (from \$ENV{PERL_ANYEVENT_MODEL}):\n$@" if $VERBOSE; 1322 warn "AnyEvent: unable to load model '$model' (from \$ENV{PERL_ANYEVENT_MODEL}):\n$@" if $VERBOSE;
1325 $MODEL 1355 $MODEL
1326 or die "AnyEvent: backend autodetection failed - did you properly install AnyEvent?\n"; 1356 or die "AnyEvent: backend autodetection failed - did you properly install AnyEvent?\n";
1327 } 1357 }
1328 } 1358 }
1329 1359
1330 @models = (); # free probe data 1360 # free memory only needed for probing
1361 undef @models;
1362 undef @REGISTRY;
1331 1363
1332 push @{"$MODEL\::ISA"}, "AnyEvent::Base"; 1364 push @{"$MODEL\::ISA"}, "AnyEvent::Base";
1333 unshift @ISA, $MODEL; 1365 unshift @ISA, $MODEL;
1334 1366
1335 # now nuke some methods that are overridden by the backend. 1367 # now nuke some methods that are overridden by the backend.
1336 # SUPER is not allowed. 1368 # SUPER usage is not allowed in these.
1337 for (qw(time signal child idle)) { 1369 for (qw(time signal child idle)) {
1338 undef &{"AnyEvent::Base::$_"} 1370 undef &{"AnyEvent::Base::$_"}
1339 if defined &{"$MODEL\::$_"}; 1371 if defined &{"$MODEL\::$_"};
1340 } 1372 }
1341 1373
1342 if ($ENV{PERL_ANYEVENT_STRICT}) { 1374 if ($ENV{PERL_ANYEVENT_STRICT}) {
1343 eval { require AnyEvent::Strict }; 1375 require AnyEvent::Strict;
1344 warn "AnyEvent: cannot load AnyEvent::Strict: $@"
1345 if $@ && $VERBOSE;
1346 } 1376 }
1347 1377
1378 if ($ENV{PERL_ANYEVENT_DEBUG_WRAP}) {
1379 require AnyEvent::Debug;
1380 AnyEvent::Debug::wrap ($ENV{PERL_ANYEVENT_DEBUG_WRAP});
1381 }
1382
1383 if (exists $ENV{PERL_ANYEVENT_DEBUG_SHELL}) {
1384 require AnyEvent::Socket;
1385 require AnyEvent::Debug;
1386
1387 my $shell = $ENV{PERL_ANYEVENT_DEBUG_SHELL};
1388 $shell =~ s/\$\$/$$/g;
1389
1390 my ($host, $service) = AnyEvent::Socket::parse_hostport ($shell);
1391 $AnyEvent::Debug::SHELL = AnyEvent::Debug::shell ($host, $service);
1392 }
1393
1348 (shift @post_detect)->() while @post_detect; 1394 (shift @post_detect)->() while @post_detect;
1395 undef @post_detect;
1349 1396
1350 *post_detect = sub(&) { 1397 *post_detect = sub(&) {
1351 shift->(); 1398 shift->();
1352 1399
1353 undef 1400 undef
1354 }; 1401 };
1355 1402
1356 $MODEL 1403 $MODEL
1357} 1404}
1358 1405
1359sub AUTOLOAD { 1406for my $name (@methods) {
1360 (my $func = $AUTOLOAD) =~ s/.*://; 1407 *$name = sub {
1361
1362 $method{$func}
1363 or Carp::croak "$func: not a valid AnyEvent class method";
1364
1365 detect; 1408 detect;
1366 1409 # we use goto because
1367 my $class = shift; 1410 # a) it makes the thunk more transparent
1368 $class->$func (@_); 1411 # b) it allows us to delete the thunk later
1369} 1412 goto &{ UNIVERSAL::can AnyEvent => "SUPER::$name" }
1370 1413 };
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} 1414}
1387 1415
1388# utility function to dup a filehandle. this is used by many backends 1416# utility function to dup a filehandle. this is used by many backends
1389# to support binding more than one watcher per filehandle (they usually 1417# 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). 1418# allow only one watcher per fd, so we dup it to get a different one).
1414 1442
1415package AE; 1443package AE;
1416 1444
1417our $VERSION = $AnyEvent::VERSION; 1445our $VERSION = $AnyEvent::VERSION;
1418 1446
1447sub _reset() {
1448 eval q{
1419# fall back to the main API by default - backends and AnyEvent::Base 1449 # fall back to the main API by default - backends and AnyEvent::Base
1420# implementations can overwrite these. 1450 # implementations can overwrite these.
1421 1451
1422sub io($$$) { 1452 sub io($$$) {
1423 AnyEvent->io (fh => $_[0], poll => $_[1] ? "w" : "r", cb => $_[2]) 1453 AnyEvent->io (fh => $_[0], poll => $_[1] ? "w" : "r", cb => $_[2])
1424} 1454 }
1425 1455
1426sub timer($$$) { 1456 sub timer($$$) {
1427 AnyEvent->timer (after => $_[0], interval => $_[1], cb => $_[2]) 1457 AnyEvent->timer (after => $_[0], interval => $_[1], cb => $_[2])
1428} 1458 }
1429 1459
1430sub signal($$) { 1460 sub signal($$) {
1431 AnyEvent->signal (signal => $_[0], cb => $_[1]) 1461 AnyEvent->signal (signal => $_[0], cb => $_[1])
1432} 1462 }
1433 1463
1434sub child($$) { 1464 sub child($$) {
1435 AnyEvent->child (pid => $_[0], cb => $_[1]) 1465 AnyEvent->child (pid => $_[0], cb => $_[1])
1436} 1466 }
1437 1467
1438sub idle($) { 1468 sub idle($) {
1439 AnyEvent->idle (cb => $_[0]) 1469 AnyEvent->idle (cb => $_[0]);
1440} 1470 }
1441 1471
1442sub cv(;&) { 1472 sub cv(;&) {
1443 AnyEvent->condvar (@_ ? (cb => $_[0]) : ()) 1473 AnyEvent->condvar (@_ ? (cb => $_[0]) : ())
1444} 1474 }
1445 1475
1446sub now() { 1476 sub now() {
1447 AnyEvent->now 1477 AnyEvent->now
1448} 1478 }
1449 1479
1450sub now_update() { 1480 sub now_update() {
1451 AnyEvent->now_update 1481 AnyEvent->now_update
1452} 1482 }
1453 1483
1454sub time() { 1484 sub time() {
1455 AnyEvent->time 1485 AnyEvent->time
1456} 1486 }
1457 1487
1458*postpone = \&AnyEvent::postpone; 1488 *postpone = \&AnyEvent::postpone;
1489 };
1490 die if $@;
1491}
1492
1493BEGIN { _reset }
1459 1494
1460package AnyEvent::Base; 1495package AnyEvent::Base;
1461 1496
1462# default implementations for many methods 1497# default implementations for many methods
1463 1498
1667 : sysread $SIGPIPE_R, (my $dummy), 9; 1702 : sysread $SIGPIPE_R, (my $dummy), 9;
1668 1703
1669 while (%SIG_EV) { 1704 while (%SIG_EV) {
1670 for (keys %SIG_EV) { 1705 for (keys %SIG_EV) {
1671 delete $SIG_EV{$_}; 1706 delete $SIG_EV{$_};
1672 $_->() for values %{ $SIG_CB{$_} || {} }; 1707 &$_ for values %{ $SIG_CB{$_} || {} };
1673 } 1708 }
1674 } 1709 }
1675 }; 1710 };
1676 }; 1711 };
1677 die if $@; 1712 die if $@;
1744 1779
1745 my ($cb, $w, $rcb) = $arg{cb}; 1780 my ($cb, $w, $rcb) = $arg{cb};
1746 1781
1747 $rcb = sub { 1782 $rcb = sub {
1748 if ($cb) { 1783 if ($cb) {
1749 $w = _time; 1784 $w = AE::time;
1750 &$cb; 1785 &$cb;
1751 $w = _time - $w; 1786 $w = AE::time - $w;
1752 1787
1753 # never use more then 50% of the time for the idle watcher, 1788 # never use more then 50% of the time for the idle watcher,
1754 # within some limits 1789 # within some limits
1755 $w = 0.0001 if $w < 0.0001; 1790 $w = 0.0001 if $w < 0.0001;
1756 $w = 5 if $w > 5; 1791 $w = 5 if $w > 5;
1925Unlike C<use strict> (or its modern cousin, C<< use L<common::sense> 1960Unlike C<use strict> (or its modern cousin, C<< use L<common::sense>
1926>>, it is definitely recommended to keep it off in production. Keeping 1961>>, it is definitely recommended to keep it off in production. Keeping
1927C<PERL_ANYEVENT_STRICT=1> in your environment while developing programs 1962C<PERL_ANYEVENT_STRICT=1> in your environment while developing programs
1928can be very useful, however. 1963can be very useful, however.
1929 1964
1965=item C<PERL_ANYEVENT_DEBUG_SHELL>
1966
1967If this env variable is set, then its contents will be interpreted by
1968C<AnyEvent::Socket::parse_hostport> (after replacing every occurance of
1969C<$$> by the process pid) and an C<AnyEvent::Debug::shell> is bound on
1970that port. The shell object is saved in C<$AnyEvent::Debug::SHELL>.
1971
1972This takes place when the first watcher is created.
1973
1974For example, to bind a debug shell on a unix domain socket in
1975F<< /tmp/debug<pid>.sock >>, you could use this:
1976
1977 PERL_ANYEVENT_DEBUG_SHELL=unix/:/tmp/debug\$\$.sock perlprog
1978
1979Note that creating sockets in F</tmp> is very unsafe on multiuser
1980systems.
1981
1982=item C<PERL_ANYEVENT_DEBUG_WRAP>
1983
1984Can be set to C<0>, C<1> or C<2> and enables wrapping of all watchers for
1985debugging purposes. See C<AnyEvent::Debug::wrap> for details.
1986
1930=item C<PERL_ANYEVENT_MODEL> 1987=item C<PERL_ANYEVENT_MODEL>
1931 1988
1932This can be used to specify the event model to be used by AnyEvent, before 1989This 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 1990auto detection and -probing kicks in.
1934entirely of ASCII letters. The string C<AnyEvent::Impl::> gets prepended 1991
1992It normally is a string consisting entirely of ASCII letters (e.g. C<EV>
1993or C<IOAsync>). The string C<AnyEvent::Impl::> gets prepended and the
1935and the resulting module name is loaded and if the load was successful, 1994resulting 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 1995event model backend. If it fails to load then AnyEvent will proceed with
1937auto detection and -probing. 1996auto detection and -probing.
1938 1997
1939This functionality might change in future versions. 1998If the string ends with C<::> instead (e.g. C<AnyEvent::Impl::EV::>) then
1999nothing gets prepended and the module name is used as-is (hint: C<::> at
2000the end of a string designates a module name and quotes it appropriately).
1940 2001
1941For example, to force the pure perl model (L<AnyEvent::Loop::Perl>) you 2002For example, to force the pure perl model (L<AnyEvent::Loop::Perl>) you
1942could start your program like this: 2003could start your program like this:
1943 2004
1944 PERL_ANYEVENT_MODEL=Perl perl ... 2005 PERL_ANYEVENT_MODEL=Perl perl ...

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines