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.355 by root, Fri Aug 12 00:53:29 2011 UTC vs.
Revision 1.358 by root, Sat Aug 13 02:35:32 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
… …
1205use Carp (); 1205use Carp ();
1206 1206
1207our $VERSION = '5.34'; 1207our $VERSION = '5.34';
1208our $MODEL; 1208our $MODEL;
1209 1209
1210our $AUTOLOAD;
1211our @ISA; 1210our @ISA;
1212 1211
1213our @REGISTRY; 1212our @REGISTRY;
1214 1213
1215our $VERBOSE; 1214our $VERBOSE;
… …
1286 [POE::Kernel:: => AnyEvent::Impl::POE::], # lasciate ogni speranza 1285 [POE::Kernel:: => AnyEvent::Impl::POE::], # lasciate ogni speranza
1287 [Wx:: => AnyEvent::Impl::POE::], 1286 [Wx:: => AnyEvent::Impl::POE::],
1288 [Prima:: => AnyEvent::Impl::POE::], 1287 [Prima:: => AnyEvent::Impl::POE::],
1289 [IO::Async::Loop:: => AnyEvent::Impl::IOAsync::], # a bitch to autodetect 1288 [IO::Async::Loop:: => AnyEvent::Impl::IOAsync::], # a bitch to autodetect
1290 [Cocoa::EventLoop:: => AnyEvent::Impl::Cocoa::], 1289 [Cocoa::EventLoop:: => AnyEvent::Impl::Cocoa::],
1291 [FLTK:: => AnyEvent::Impl::FLTK::], 1290 [FLTK:: => AnyEvent::Impl::FLTK2::],
1292); 1291);
1293 1292
1294our %method = map +($_ => 1), 1293# all autoloaded methods reserve the complete glob, not just the method slot.
1294# due to bugs in perls method cache implementation.
1295 qw(io timer time now now_update signal child idle condvar DESTROY); 1295our @methods = qw(io timer time now now_update signal child idle condvar);
1296 1296
1297sub detect() { 1297sub detect() {
1298 local $!; # for good measure
1299 local $SIG{__DIE__}; # we use eval
1300
1298 # free some memory 1301 # free some memory
1299 *detect = sub () { $MODEL }; 1302 *detect = sub () { $MODEL };
1300 1303 # undef &func doesn't correctly update the method cache. grmbl.
1301 local $!; # for good measure 1304 # so we delete the whole glob. grmbl.
1302 local $SIG{__DIE__}; 1305 # otoh, perl doesn't let me undef an active usb, but it lets me free
1306 # a glob with an active sub. hrm. i hope it works, but perl is
1307 # usually buggy in this department. sigh.
1308 delete @{"AnyEvent::"}{@methods};
1309 undef @methods;
1303 1310
1304 if ($ENV{PERL_ANYEVENT_MODEL} =~ /^([a-zA-Z0-9:]+)$/) { 1311 if ($ENV{PERL_ANYEVENT_MODEL} =~ /^([a-zA-Z0-9:]+)$/) {
1305 my $model = $1; 1312 my $model = $1;
1306 $model = "AnyEvent::Impl::$model" unless $model =~ s/::$//; 1313 $model = "AnyEvent::Impl::$model" unless $model =~ s/::$//;
1307 if (eval "require $model") { 1314 if (eval "require $model") {
… …
1359 undef &{"AnyEvent::Base::$_"} 1366 undef &{"AnyEvent::Base::$_"}
1360 if defined &{"$MODEL\::$_"}; 1367 if defined &{"$MODEL\::$_"};
1361 } 1368 }
1362 1369
1363 if ($ENV{PERL_ANYEVENT_STRICT}) { 1370 if ($ENV{PERL_ANYEVENT_STRICT}) {
1364 eval { require AnyEvent::Strict }; 1371 require AnyEvent::Strict;
1365 warn "AnyEvent: cannot load AnyEvent::Strict: $@" 1372 }
1366 if $@ && $VERBOSE; 1373
1374 if ($ENV{PERL_ANYEVENT_DEBUG_WRAP}) {
1375 require AnyEvent::Debug;
1376 AnyEvent::Debug::wrap ($ENV{PERL_ANYEVENT_DEBUG_WRAP});
1377 }
1378
1379 if (exists $ENV{PERL_ANYEVENT_DEBUG_SHELL}) {
1380 require AnyEvent::Socket;
1381 require AnyEvent::Debug;
1382
1383 my ($host, $service) = AnyEvent::Socket::parse_hostport ($ENV{PERL_ANYEVENT_DEBUG_SHELL});
1384 $AnyEvent::Debug::SHELL = AnyEvent::Debug::shell ($host, $service);
1367 } 1385 }
1368 1386
1369 (shift @post_detect)->() while @post_detect; 1387 (shift @post_detect)->() while @post_detect;
1370 undef @post_detect; 1388 undef @post_detect;
1371 1389
… …
1373 shift->(); 1391 shift->();
1374 1392
1375 undef 1393 undef
1376 }; 1394 };
1377 1395
1378 # recover a few more bytes 1396 $MODEL
1379 postpone { 1397}
1380 undef &AUTOLOAD; 1398
1399for my $name (@methods) {
1400 *$name = sub {
1401 detect;
1402 # we use goto because
1403 # a) it makes the thunk more transparent
1404 # b) it allows us to delete the thunk later
1405 goto &{ UNIVERSAL::can AnyEvent => "SUPER::$name" }
1381 }; 1406 };
1382
1383 $MODEL
1384}
1385
1386our %method = map +($_ => 1),
1387 qw(io timer time now now_update signal child idle condvar DESTROY);
1388
1389sub AUTOLOAD {
1390 (my $func = $AUTOLOAD) =~ s/.*://;
1391
1392 $method{$func}
1393 or Carp::croak "$func: not a valid AnyEvent class method";
1394
1395 # free some memory
1396 undef %method;
1397
1398 detect;
1399
1400 my $class = shift;
1401 $class->$func (@_);
1402} 1407}
1403 1408
1404# utility function to dup a filehandle. this is used by many backends 1409# utility function to dup a filehandle. this is used by many backends
1405# to support binding more than one watcher per filehandle (they usually 1410# to support binding more than one watcher per filehandle (they usually
1406# allow only one watcher per fd, so we dup it to get a different one). 1411# allow only one watcher per fd, so we dup it to get a different one).
… …
1430 1435
1431package AE; 1436package AE;
1432 1437
1433our $VERSION = $AnyEvent::VERSION; 1438our $VERSION = $AnyEvent::VERSION;
1434 1439
1435
1436sub _reset() { 1440sub _reset() {
1437 eval q{ 1441 eval q{
1438 # fall back to the main API by default - backends and AnyEvent::Base 1442 # fall back to the main API by default - backends and AnyEvent::Base
1439 # implementations can overwrite these. 1443 # implementations can overwrite these.
1440 1444
… …
1453 sub child($$) { 1457 sub child($$) {
1454 AnyEvent->child (pid => $_[0], cb => $_[1]) 1458 AnyEvent->child (pid => $_[0], cb => $_[1])
1455 } 1459 }
1456 1460
1457 sub idle($) { 1461 sub idle($) {
1458 AnyEvent->idle (cb => $_[0]) 1462 AnyEvent->idle (cb => $_[0]);
1459 } 1463 }
1460 1464
1461 sub cv(;&) { 1465 sub cv(;&) {
1462 AnyEvent->condvar (@_ ? (cb => $_[0]) : ()) 1466 AnyEvent->condvar (@_ ? (cb => $_[0]) : ())
1463 } 1467 }
… …
1768 1772
1769 my ($cb, $w, $rcb) = $arg{cb}; 1773 my ($cb, $w, $rcb) = $arg{cb};
1770 1774
1771 $rcb = sub { 1775 $rcb = sub {
1772 if ($cb) { 1776 if ($cb) {
1773 $w = _time; 1777 $w = AE::time;
1774 &$cb; 1778 &$cb;
1775 $w = _time - $w; 1779 $w = AE::time - $w;
1776 1780
1777 # never use more then 50% of the time for the idle watcher, 1781 # never use more then 50% of the time for the idle watcher,
1778 # within some limits 1782 # within some limits
1779 $w = 0.0001 if $w < 0.0001; 1783 $w = 0.0001 if $w < 0.0001;
1780 $w = 5 if $w > 5; 1784 $w = 5 if $w > 5;
… …
1948 1952
1949Unlike C<use strict> (or its modern cousin, C<< use L<common::sense> 1953Unlike C<use strict> (or its modern cousin, C<< use L<common::sense>
1950>>, it is definitely recommended to keep it off in production. Keeping 1954>>, it is definitely recommended to keep it off in production. Keeping
1951C<PERL_ANYEVENT_STRICT=1> in your environment while developing programs 1955C<PERL_ANYEVENT_STRICT=1> in your environment while developing programs
1952can be very useful, however. 1956can be very useful, however.
1957
1958=item C<PERL_ANYEVENT_DEBUG_SHELL>
1959
1960If this env variable is set, then its contents will be
1961interpreted by C<AnyEvent::Socket::parse_hostport> and an
1962C<AnyEvent::Debug::shell> is bound on that port. The shell object is saved
1963in C<$AnyEvent::Debug::SHELL>.
1964
1965For example, to bind a debug shell on a unix domain socket in
1966F</tmp/debug.sock>, you could use this:
1967
1968 PERL_ANYEVENT_DEBUG_SHELL=unix/:/tmp/debug.sock perlprog
1969
1970=item C<PERL_ANYEVENT_DEBUG_WRAP>
1971
1972Can be set to C<0>, C<1> or C<2> and enables wrapping of all watchers for
1973debugging purposes. See C<AnyEvent::Debug::wrap> for details.
1953 1974
1954=item C<PERL_ANYEVENT_MODEL> 1975=item C<PERL_ANYEVENT_MODEL>
1955 1976
1956This can be used to specify the event model to be used by AnyEvent, before 1977This can be used to specify the event model to be used by AnyEvent, before
1957auto detection and -probing kicks in. 1978auto detection and -probing kicks in.

Diff Legend

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