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.356 by root, Fri Aug 12 18:41:25 2011 UTC vs.
Revision 1.362 by root, Sun Aug 14 01:57:18 2011 UTC

… …
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 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).
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 }
943 947
… …
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;
… …
1289 [IO::Async::Loop:: => AnyEvent::Impl::IOAsync::], # a bitch to autodetect 1292 [IO::Async::Loop:: => AnyEvent::Impl::IOAsync::], # a bitch to autodetect
1290 [Cocoa::EventLoop:: => AnyEvent::Impl::Cocoa::], 1293 [Cocoa::EventLoop:: => AnyEvent::Impl::Cocoa::],
1291 [FLTK:: => AnyEvent::Impl::FLTK2::], 1294 [FLTK:: => AnyEvent::Impl::FLTK2::],
1292); 1295);
1293 1296
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.
1320our @methods = qw(io timer time now now_update signal child idle condvar);
1321
1294sub detect() { 1322sub detect() {
1323 local $!; # for good measure
1324 local $SIG{__DIE__}; # we use eval
1325
1295 # free some memory 1326 # free some memory
1296 *detect = sub () { $MODEL }; 1327 *detect = sub () { $MODEL };
1297 1328 # undef &func doesn't correctly update the method cache. grmbl.
1298 local $!; # for good measure 1329 # so we delete the whole glob. grmbl.
1299 local $SIG{__DIE__}; 1330 # otoh, perl doesn't let me undef an active usb, but it lets me free
1331 # a glob with an active sub. hrm. i hope it works, but perl is
1332 # usually buggy in this department. sigh.
1333 delete @{"AnyEvent::"}{@methods};
1334 undef @methods;
1300 1335
1301 if ($ENV{PERL_ANYEVENT_MODEL} =~ /^([a-zA-Z0-9:]+)$/) { 1336 if ($ENV{PERL_ANYEVENT_MODEL} =~ /^([a-zA-Z0-9:]+)$/) {
1302 my $model = $1; 1337 my $model = $1;
1303 $model = "AnyEvent::Impl::$model" unless $model =~ s/::$//; 1338 $model = "AnyEvent::Impl::$model" unless $model =~ s/::$//;
1304 if (eval "require $model") { 1339 if (eval "require $model") {
… …
1346 # free memory only needed for probing 1381 # free memory only needed for probing
1347 undef @models; 1382 undef @models;
1348 undef @REGISTRY; 1383 undef @REGISTRY;
1349 1384
1350 push @{"$MODEL\::ISA"}, "AnyEvent::Base"; 1385 push @{"$MODEL\::ISA"}, "AnyEvent::Base";
1351 unshift @ISA, $MODEL;
1352 1386
1353 # now nuke some methods that are overridden by the backend. 1387 # now nuke some methods that are overridden by the backend.
1354 # SUPER usage is not allowed in these. 1388 # SUPER usage is not allowed in these.
1355 for (qw(time signal child idle)) { 1389 for (qw(time signal child idle)) {
1356 undef &{"AnyEvent::Base::$_"} 1390 undef &{"AnyEvent::Base::$_"}
1357 if defined &{"$MODEL\::$_"}; 1391 if defined &{"$MODEL\::$_"};
1358 } 1392 }
1359 1393
1394 _isa_set;
1395
1360 if ($ENV{PERL_ANYEVENT_STRICT}) { 1396 if ($ENV{PERL_ANYEVENT_STRICT}) {
1361 eval { require AnyEvent::Strict }; 1397 require AnyEvent::Strict;
1362 warn "AnyEvent: cannot load AnyEvent::Strict: $@" 1398 }
1363 if $@ && $VERBOSE; 1399
1400 if ($ENV{PERL_ANYEVENT_DEBUG_WRAP}) {
1401 require AnyEvent::Debug;
1402 AnyEvent::Debug::wrap ($ENV{PERL_ANYEVENT_DEBUG_WRAP});
1403 }
1404
1405 if (exists $ENV{PERL_ANYEVENT_DEBUG_SHELL}) {
1406 require AnyEvent::Socket;
1407 require AnyEvent::Debug;
1408
1409 my $shell = $ENV{PERL_ANYEVENT_DEBUG_SHELL};
1410 $shell =~ s/\$\$/$$/g;
1411
1412 my ($host, $service) = AnyEvent::Socket::parse_hostport ($shell);
1413 $AnyEvent::Debug::SHELL = AnyEvent::Debug::shell ($host, $service);
1364 } 1414 }
1365 1415
1366 (shift @post_detect)->() while @post_detect; 1416 (shift @post_detect)->() while @post_detect;
1367 undef @post_detect; 1417 undef @post_detect;
1368 1418
… …
1370 shift->(); 1420 shift->();
1371 1421
1372 undef 1422 undef
1373 }; 1423 };
1374 1424
1375 # recover a few more bytes 1425 $MODEL
1376 postpone { 1426}
1377 undef &AUTOLOAD; 1427
1428for my $name (@methods) {
1429 *$name = sub {
1430 detect;
1431 # we use goto because
1432 # a) it makes the thunk more transparent
1433 # b) it allows us to delete the thunk later
1434 goto &{ UNIVERSAL::can AnyEvent => "SUPER::$name" }
1378 }; 1435 };
1379
1380 $MODEL
1381}
1382
1383our %method = map +($_ => 1),
1384 qw(io timer time now now_update signal child idle condvar DESTROY);
1385
1386sub AUTOLOAD {
1387 (my $func = $AUTOLOAD) =~ s/.*://;
1388
1389 $method{$func}
1390 or Carp::croak "$func: not a valid AnyEvent class method";
1391
1392 # free some memory
1393 undef %method;
1394
1395 detect;
1396
1397 my $class = shift;
1398 $class->$func (@_);
1399} 1436}
1400 1437
1401# utility function to dup a filehandle. this is used by many backends 1438# utility function to dup a filehandle. this is used by many backends
1402# to support binding more than one watcher per filehandle (they usually 1439# to support binding more than one watcher per filehandle (they usually
1403# allow only one watcher per fd, so we dup it to get a different one). 1440# allow only one watcher per fd, so we dup it to get a different one).
… …
1427 1464
1428package AE; 1465package AE;
1429 1466
1430our $VERSION = $AnyEvent::VERSION; 1467our $VERSION = $AnyEvent::VERSION;
1431 1468
1432
1433sub _reset() { 1469sub _reset() {
1434 eval q{ 1470 eval q{
1435 # fall back to the main API by default - backends and AnyEvent::Base 1471 # fall back to the main API by default - backends and AnyEvent::Base
1436 # implementations can overwrite these. 1472 # implementations can overwrite these.
1437 1473
… …
1450 sub child($$) { 1486 sub child($$) {
1451 AnyEvent->child (pid => $_[0], cb => $_[1]) 1487 AnyEvent->child (pid => $_[0], cb => $_[1])
1452 } 1488 }
1453 1489
1454 sub idle($) { 1490 sub idle($) {
1455 AnyEvent->idle (cb => $_[0]) 1491 AnyEvent->idle (cb => $_[0]);
1456 } 1492 }
1457 1493
1458 sub cv(;&) { 1494 sub cv(;&) {
1459 AnyEvent->condvar (@_ ? (cb => $_[0]) : ()) 1495 AnyEvent->condvar (@_ ? (cb => $_[0]) : ())
1460 } 1496 }
… …
1485sub time { 1521sub time {
1486 eval q{ # poor man's autoloading {} 1522 eval q{ # poor man's autoloading {}
1487 # probe for availability of Time::HiRes 1523 # probe for availability of Time::HiRes
1488 if (eval "use Time::HiRes (); Time::HiRes::time (); 1") { 1524 if (eval "use Time::HiRes (); Time::HiRes::time (); 1") {
1489 warn "AnyEvent: using Time::HiRes for sub-second timing accuracy.\n" if $VERBOSE >= 8; 1525 warn "AnyEvent: using Time::HiRes for sub-second timing accuracy.\n" if $VERBOSE >= 8;
1526 *time = sub { Time::HiRes::time () };
1490 *AE::time = \&Time::HiRes::time; 1527 *AE::time = \& Time::HiRes::time ;
1491 # if (eval "use POSIX (); (POSIX::times())... 1528 # if (eval "use POSIX (); (POSIX::times())...
1492 } else { 1529 } else {
1493 warn "AnyEvent: using built-in time(), WARNING, no sub-second resolution!\n" if $VERBOSE; 1530 warn "AnyEvent: using built-in time(), WARNING, no sub-second resolution!\n" if $VERBOSE;
1531 *time = sub { CORE::time };
1494 *AE::time = sub (){ time }; # epic fail 1532 *AE::time = sub (){ CORE::time };
1495 } 1533 }
1496 1534
1497 *time = sub { AE::time }; # different prototypes 1535 *now = \&time;
1498 }; 1536 };
1499 die if $@; 1537 die if $@;
1500 1538
1501 &time 1539 &time
1502} 1540}
1503 1541
1504*now = \&time; 1542*now = \&time;
1505
1506sub now_update { } 1543sub now_update { }
1507 1544
1508sub _poll { 1545sub _poll {
1509 Carp::croak "$AnyEvent::MODEL does not support blocking waits. Caught"; 1546 Carp::croak "$AnyEvent::MODEL does not support blocking waits. Caught";
1510} 1547}
… …
1945 1982
1946Unlike C<use strict> (or its modern cousin, C<< use L<common::sense> 1983Unlike C<use strict> (or its modern cousin, C<< use L<common::sense>
1947>>, it is definitely recommended to keep it off in production. Keeping 1984>>, it is definitely recommended to keep it off in production. Keeping
1948C<PERL_ANYEVENT_STRICT=1> in your environment while developing programs 1985C<PERL_ANYEVENT_STRICT=1> in your environment while developing programs
1949can be very useful, however. 1986can be very useful, however.
1987
1988=item C<PERL_ANYEVENT_DEBUG_SHELL>
1989
1990If this env variable is set, then its contents will be interpreted by
1991C<AnyEvent::Socket::parse_hostport> (after replacing every occurance of
1992C<$$> by the process pid) and an C<AnyEvent::Debug::shell> is bound on
1993that port. The shell object is saved in C<$AnyEvent::Debug::SHELL>.
1994
1995This takes place when the first watcher is created.
1996
1997For example, to bind a debug shell on a unix domain socket in
1998F<< /tmp/debug<pid>.sock >>, you could use this:
1999
2000 PERL_ANYEVENT_DEBUG_SHELL=unix/:/tmp/debug\$\$.sock perlprog
2001
2002Note that creating sockets in F</tmp> is very unsafe on multiuser
2003systems.
2004
2005=item C<PERL_ANYEVENT_DEBUG_WRAP>
2006
2007Can be set to C<0>, C<1> or C<2> and enables wrapping of all watchers for
2008debugging purposes. See C<AnyEvent::Debug::wrap> for details.
1950 2009
1951=item C<PERL_ANYEVENT_MODEL> 2010=item C<PERL_ANYEVENT_MODEL>
1952 2011
1953This can be used to specify the event model to be used by AnyEvent, before 2012This can be used to specify the event model to be used by AnyEvent, before
1954auto detection and -probing kicks in. 2013auto detection and -probing kicks in.
… …
2361(even when used without AnyEvent), but most event loops have acceptable 2420(even when used without AnyEvent), but most event loops have acceptable
2362performance with or without AnyEvent. 2421performance with or without AnyEvent.
2363 2422
2364=item * The overhead AnyEvent adds is usually much smaller than the overhead of 2423=item * The overhead AnyEvent adds is usually much smaller than the overhead of
2365the actual event loop, only with extremely fast event loops such as EV 2424the actual event loop, only with extremely fast event loops such as EV
2366adds AnyEvent significant overhead. 2425does AnyEvent add significant overhead.
2367 2426
2368=item * You should avoid POE like the plague if you want performance or 2427=item * You should avoid POE like the plague if you want performance or
2369reasonable memory usage. 2428reasonable memory usage.
2370 2429
2371=back 2430=back

Diff Legend

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