--- AnyEvent/lib/AnyEvent.pm 2010/12/31 04:50:44 1.345 +++ AnyEvent/lib/AnyEvent.pm 2011/08/12 00:53:29 1.355 @@ -123,11 +123,11 @@ During the first call of any watcher-creation method, the module tries to detect the currently loaded event loop by probing whether one of the -following modules is already loaded: L, L, +following modules is already loaded: L, L, L, L, L, L, L, L. The first one found is used. If none are detected, the module tries to load the first four modules in the order given; but note that if L is not -available, the pure-perl L should always work, so +available, the pure-perl L should always work, so the other two are not normally tried. Because AnyEvent first checks for modules that are already loaded, loading @@ -144,9 +144,9 @@ as very few modules hardcode event loops without announcing this very loudly. -The pure-perl implementation of AnyEvent is called -C. Like other event modules you can load it -explicitly and enjoy the high availability of that event loop :) +The pure-perl implementation of AnyEvent is called C. Like +other event modules you can load it explicitly and enjoy the high +availability of that event loop :) =head1 WATCHERS @@ -358,9 +358,9 @@ =item AnyEvent->now_update -Some event loops (such as L or L) cache -the current time for each loop iteration (see the discussion of L<< -AnyEvent->now >>, above). +Some event loops (such as L or L) cache the current +time for each loop iteration (see the discussion of L<< AnyEvent->now >>, +above). When a callback runs for a long time (or when the process sleeps), then this "current" time will differ substantially from the real time, which @@ -484,8 +484,8 @@ C). As most event loops do not support waiting for child events, they will be -emulated by AnyEvent in most cases, in which the latency and race problems -mentioned in the description of signal watchers apply. +emulated by AnyEvent in most cases, in which case the latency and race +problems mentioned in the description of signal watchers apply. Example: fork a process and wait for it @@ -862,7 +862,7 @@ AnyEvent itself. AnyEvent::Impl::EV based on EV (interface to libev, best choice). - AnyEvent::Impl::Perl pure-perl implementation, fast and portable. + AnyEvent::Impl::Perl pure-perl AnyEvent::Loop, fast and portable. =item Backends that are transparently being picked up when they are used. @@ -880,6 +880,7 @@ AnyEvent::Impl::Irssi used when running within irssi. AnyEvent::Impl::IOAsync based on IO::Async. AnyEvent::Impl::Cocoa based on Cocoa::EventLoop. + AnyEvent::Impl::FLTK based on FLTK. =item Backends with special needs. @@ -1006,6 +1007,46 @@ push @AnyEvent::post_detect, sub { require Coro::AnyEvent }; } +=item AnyEvent::postpone { BLOCK } + +Arranges for the block to be executed as soon as possible, but not before +the call itself returns. In practise, the block will be executed just +before the event loop polls for new events, or shortly afterwards. + +This function never returns anything (to make the C idiom more useful. + +To understand the usefulness of this function, consider a function that +asynchronously does something for you and returns some transaction +object or guard to let you cancel the operation. For example, +C: + + # start a conenction attempt unless one is active + $self->{connect_guard} ||= AnyEvent::Socket::tcp_connect "www.example.net", 80, sub { + delete $self->{connect_guard}; + ... + }; + +Imagine that this function could instantly call the callback, for +example, because it detects an obvious error such as a negative port +number. Invoking the callback before the function returns causes problems +however: the callback will be called and will try to delete the guard +object. But since the function hasn't returned yet, there is nothing to +delete. When the function eventually returns it will assign the guard +object to C<< $self->{connect_guard} >>, where it will likely never be +deleted, so the program thinks it is still trying to connect. + +This is where C should be used. Instead of calling the +callback directly on error: + + $cb->(undef), return # signal error to callback, BAD! + if $some_error_condition; + +It should use C: + + AnyEvent::postpone { $cb->(undef) }, return # signal error to callback, later + if $some_error_condition; + =back =head1 WHAT TO DO IN A MODULE @@ -1048,7 +1089,7 @@ might choose the wrong one unless you load the correct one yourself. You can chose to use a pure-perl implementation by loading the -C module, which gives you similar behaviour +C module, which gives you similar behaviour everywhere, but letting AnyEvent chose the model is generally better. =head2 MAINLOOP EMULATION @@ -1153,8 +1194,8 @@ # basically a tuned-down version of common::sense sub common_sense { - # from common:.sense 3.3 - ${^WARNING_BITS} ^= ${^WARNING_BITS} ^ "\x3c\x3f\x33\x00\x0f\xf3\x0f\xc0\xf0\xfc\x33\x00"; + # from common:.sense 3.4 + ${^WARNING_BITS} ^= ${^WARNING_BITS} ^ "\x3c\x3f\x33\x00\x0f\xf0\x0f\xc0\xf0\xfc\x33\x00"; # use strict vars subs - NO UTF-8, as Util.pm doesn't like this atm. (uts46data.pl) $^H |= 0x00000600; } @@ -1163,7 +1204,7 @@ use Carp (); -our $VERSION = '5.3'; +our $VERSION = '5.34'; our $MODEL; our $AUTOLOAD; @@ -1196,11 +1237,45 @@ $ENV{PERL_ANYEVENT_PROTOCOLS} || "ipv4,ipv6"; } -my @models = ( +our @post_detect; + +sub post_detect(&) { + my ($cb) = @_; + + push @post_detect, $cb; + + defined wantarray + ? bless \$cb, "AnyEvent::Util::postdetect" + : () +} + +sub AnyEvent::Util::postdetect::DESTROY { + @post_detect = grep $_ != ${$_[0]}, @post_detect; +} + +our $POSTPONE_W; +our @POSTPONE; + +sub _postpone_exec { + undef $POSTPONE_W; + + &{ shift @POSTPONE } + while @POSTPONE; +} + +sub postpone(&) { + push @POSTPONE, shift; + + $POSTPONE_W ||= AE::timer (0, 0, \&_postpone_exec); + + () +} + +our @models = ( [EV:: => AnyEvent::Impl::EV:: , 1], - [AnyEvent::Impl::Perl:: => AnyEvent::Impl::Perl:: , 1], + [AnyEvent::Loop:: => AnyEvent::Impl::Perl:: , 1], # everything below here will not (normally) be autoprobed - # as the pureperl backend should work everywhere + # as the pure perl backend should work everywhere # and is usually faster [Event:: => AnyEvent::Impl::Event::, 1], [Glib:: => AnyEvent::Impl::Glib:: , 1], # becomes extremely slow with many watchers @@ -1211,28 +1286,13 @@ [POE::Kernel:: => AnyEvent::Impl::POE::], # lasciate ogni speranza [Wx:: => AnyEvent::Impl::POE::], [Prima:: => AnyEvent::Impl::POE::], - [IO::Async::Loop:: => AnyEvent::Impl::IOAsync::], + [IO::Async::Loop:: => AnyEvent::Impl::IOAsync::], # a bitch to autodetect [Cocoa::EventLoop:: => AnyEvent::Impl::Cocoa::], + [FLTK:: => AnyEvent::Impl::FLTK::], ); our %method = map +($_ => 1), - qw(io timer time now now_update signal child idle condvar one_event DESTROY); - -our @post_detect; - -sub post_detect(&) { - my ($cb) = @_; - - push @post_detect, $cb; - - defined wantarray - ? bless \$cb, "AnyEvent::Util::postdetect" - : () -} - -sub AnyEvent::Util::postdetect::DESTROY { - @post_detect = grep $_ != ${$_[0]}, @post_detect; -} + qw(io timer time now now_update signal child idle condvar DESTROY); sub detect() { # free some memory @@ -1241,8 +1301,9 @@ local $!; # for good measure local $SIG{__DIE__}; - if ($ENV{PERL_ANYEVENT_MODEL} =~ /^([a-zA-Z]+)$/) { - my $model = "AnyEvent::Impl::$1"; + if ($ENV{PERL_ANYEVENT_MODEL} =~ /^([a-zA-Z0-9:]+)$/) { + my $model = $1; + $model = "AnyEvent::Impl::$model" unless $model =~ s/::$//; if (eval "require $model") { $MODEL = $model; warn "AnyEvent: loaded model '$model' (forced by \$ENV{PERL_ANYEVENT_MODEL}), using it.\n" if $VERBOSE >= 2; @@ -1285,13 +1346,15 @@ } } - @models = (); # free probe data + # free memory only needed for probing + undef @models; + undef @REGISTRY; push @{"$MODEL\::ISA"}, "AnyEvent::Base"; unshift @ISA, $MODEL; # now nuke some methods that are overridden by the backend. - # SUPER is not allowed. + # SUPER usage is not allowed in these. for (qw(time signal child idle)) { undef &{"AnyEvent::Base::$_"} if defined &{"$MODEL\::$_"}; @@ -1304,6 +1367,7 @@ } (shift @post_detect)->() while @post_detect; + undef @post_detect; *post_detect = sub(&) { shift->(); @@ -1311,15 +1375,26 @@ undef }; + # recover a few more bytes + postpone { + undef &AUTOLOAD; + }; + $MODEL } +our %method = map +($_ => 1), + qw(io timer time now now_update signal child idle condvar DESTROY); + sub AUTOLOAD { (my $func = $AUTOLOAD) =~ s/.*://; $method{$func} or Carp::croak "$func: not a valid AnyEvent class method"; + # free some memory + undef %method; + detect; my $class = shift; @@ -1357,45 +1432,55 @@ our $VERSION = $AnyEvent::VERSION; -# fall back to the main API by default - backends and AnyEvent::Base -# implementations can overwrite these. -sub io($$$) { - AnyEvent->io (fh => $_[0], poll => $_[1] ? "w" : "r", cb => $_[2]) -} +sub _reset() { + eval q{ + # fall back to the main API by default - backends and AnyEvent::Base + # implementations can overwrite these. -sub timer($$$) { - AnyEvent->timer (after => $_[0], interval => $_[1], cb => $_[2]) -} + sub io($$$) { + AnyEvent->io (fh => $_[0], poll => $_[1] ? "w" : "r", cb => $_[2]) + } -sub signal($$) { - AnyEvent->signal (signal => $_[0], cb => $_[1]) -} + sub timer($$$) { + AnyEvent->timer (after => $_[0], interval => $_[1], cb => $_[2]) + } -sub child($$) { - AnyEvent->child (pid => $_[0], cb => $_[1]) -} + sub signal($$) { + AnyEvent->signal (signal => $_[0], cb => $_[1]) + } -sub idle($) { - AnyEvent->idle (cb => $_[0]) -} + sub child($$) { + AnyEvent->child (pid => $_[0], cb => $_[1]) + } -sub cv(;&) { - AnyEvent->condvar (@_ ? (cb => $_[0]) : ()) -} + sub idle($) { + AnyEvent->idle (cb => $_[0]) + } -sub now() { - AnyEvent->now -} + sub cv(;&) { + AnyEvent->condvar (@_ ? (cb => $_[0]) : ()) + } -sub now_update() { - AnyEvent->now_update -} + sub now() { + AnyEvent->now + } + + sub now_update() { + AnyEvent->now_update + } -sub time() { - AnyEvent->time + sub time() { + AnyEvent->time + } + + *postpone = \&AnyEvent::postpone; + }; + die if $@; } +BEGIN { _reset } + package AnyEvent::Base; # default implementations for many methods @@ -1423,7 +1508,12 @@ sub now_update { } +sub _poll { + Carp::croak "$AnyEvent::MODEL does not support blocking waits. Caught"; +} + # default implementation for ->condvar +# in fact, the default should not be overwritten sub condvar { eval q{ # poor man's autoloading {} @@ -1603,7 +1693,7 @@ while (%SIG_EV) { for (keys %SIG_EV) { delete $SIG_EV{$_}; - $_->() for values %{ $SIG_CB{$_} || {} }; + &$_ for values %{ $SIG_CB{$_} || {} }; } } }; @@ -1640,10 +1730,10 @@ *child = sub { my (undef, %arg) = @_; - defined (my $pid = $arg{pid} + 0) - or Carp::croak "required option 'pid' is missing"; + my $pid = $arg{pid}; + my $cb = $arg{cb}; - $PID_CB{$pid}{$arg{cb}} = $arg{cb}; + $PID_CB{$pid}{$cb+0} = $cb; unless ($CHLD_W) { $CHLD_W = AE::signal CHLD => \&_sigchld; @@ -1651,13 +1741,13 @@ &_sigchld; } - bless [$pid, $arg{cb}], "AnyEvent::Base::child" + bless [$pid, $cb+0], "AnyEvent::Base::child" }; *AnyEvent::Base::child::DESTROY = sub { - my ($pid, $cb) = @{$_[0]}; + my ($pid, $icb) = @{$_[0]}; - delete $PID_CB{$pid}{$cb}; + delete $PID_CB{$pid}{$icb}; delete $PID_CB{$pid} unless keys %{ $PID_CB{$pid} }; undef $CHLD_W unless keys %PID_CB; @@ -1739,6 +1829,10 @@ # nop } +sub _wait { + AnyEvent->_poll until $_[0]{_ae_sent}; +} + sub send { my $cv = shift; $cv->{_ae_sent} = [@_]; @@ -1755,20 +1849,21 @@ $_[0]{_ae_sent} } -sub _wait { - $WAITING - and !$_[0]{_ae_sent} - and Carp::croak "AnyEvent::CondVar: recursive blocking wait detected"; +sub recv { + unless ($_[0]{_ae_sent}) { + $WAITING + and Carp::croak "AnyEvent::CondVar: recursive blocking wait attempted"; - local $WAITING = 1; - AnyEvent->one_event while !$_[0]{_ae_sent}; -} + local $WAITING = 1; + $_[0]->_wait; + } -sub recv { - $_[0]->_wait; + $_[0]{_ae_croak} + and Carp::croak $_[0]{_ae_croak}; - Carp::croak $_[0]{_ae_croak} if $_[0]{_ae_croak}; - wantarray ? @{ $_[0]{_ae_sent} } : $_[0]{_ae_sent}[0] + wantarray + ? @{ $_[0]{_ae_sent} } + : $_[0]{_ae_sent}[0] } sub cb { @@ -1794,7 +1889,7 @@ # undocumented/compatibility with pre-3.4 *broadcast = \&send; -*wait = \&_wait; +*wait = \&recv; =head1 ERROR AND EXCEPTION HANDLING @@ -1859,15 +1954,19 @@ =item C This can be used to specify the event model to be used by AnyEvent, before -auto detection and -probing kicks in. It must be a string consisting -entirely of ASCII letters. The string C gets prepended -and the resulting module name is loaded and if the load was successful, -used as event model. If it fails to load AnyEvent will proceed with +auto detection and -probing kicks in. + +It normally is a string consisting entirely of ASCII letters (e.g. C +or C). The string C gets prepended and the +resulting module name is loaded and - if the load was successful - used as +event model backend. If it fails to load then AnyEvent will proceed with auto detection and -probing. -This functionality might change in future versions. +If the string ends with C<::> instead (e.g. C) then +nothing gets prepended and the module name is used as-is (hint: C<::> at +the end of a string designates a module name and quotes it appropriately). -For example, to force the pure perl model (L) you +For example, to force the pure perl model (L) you could start your program like this: PERL_ANYEVENT_MODEL=Perl perl ... @@ -2576,7 +2675,7 @@ This module is part of perl since release 5.008. It will be used when the chosen event library does not come with a timing source of its own. The -pure-perl event loop (L) will additionally use it to +pure-perl event loop (L) will additionally load it to try to use a monotonic clock for timing stability. =back @@ -2654,8 +2753,8 @@ Utility functions: L. -Event modules: L, L, L, L, L, -L, L, L, L, L. +Event modules: L, L, L, L, +L, L, L, L, L, L, L. Implementations: L, L, L, L, L,