--- AnyEvent/lib/AnyEvent.pm 2009/07/18 05:19:09 1.245 +++ AnyEvent/lib/AnyEvent.pm 2009/07/31 20:16:29 1.269 @@ -1,9 +1,9 @@ =head1 NAME -AnyEvent - provide framework for multiple event loops +AnyEvent - the DBI of event loop programming -EV, Event, Glib, Tk, Perl, Event::Lib, Qt and POE are various supported -event loops. +EV, Event, Glib, Tk, Perl, Event::Lib, Irssi, rxvt-unicode, IO::Async, Qt +and POE are various supported event loops/environments. =head1 SYNOPSIS @@ -43,6 +43,14 @@ in a tutorial or some gentle introduction, have a look at the L manpage. +=head1 SUPPORT + +There is a mailinglist for discussing all things AnyEvent, and an IRC +channel, too. + +See the AnyEvent project page at the B, at L, for more info. + =head1 WHY YOU SHOULD USE THIS MODULE (OR NOT) Glib, POE, IO::Async, Event... CPAN offers event models by the dozen @@ -175,6 +183,12 @@ =head2 I/O WATCHERS + $w = AnyEvent->io ( + fh => , + poll => <"r" or "w">, + cb => , + ); + You can create an I/O watcher by calling the C<< AnyEvent->io >> method with the following mandatory key-value pairs as arguments: @@ -213,6 +227,14 @@ =head2 TIME WATCHERS + $w = AnyEvent->timer (after => , cb => ); + + $w = AnyEvent->timer ( + after => , + interval => , + cb => , + ); + You can create a time watcher by calling the C<< AnyEvent->timer >> method with the following mandatory arguments: @@ -349,6 +371,8 @@ =head2 SIGNAL WATCHERS + $w = AnyEvent->signal (signal => , cb => ); + You can watch for signals using a signal watcher, C is the signal I in uppercase and without any C prefix, C is the Perl callback to be invoked whenever a signal occurs. @@ -370,29 +394,41 @@ so programs overwriting those signals directly will likely not work correctly. -Also note that many event loops (e.g. Glib, Tk, Qt, IO::Async) do not -support attaching callbacks to signals, which is a pity, as you cannot do -race-free signal handling in perl. AnyEvent will try to do it's best, but -in some cases, signals will be delayed. The maximum time a signal might -be delayed is specified in C<$AnyEvent::MAX_SIGNAL_LATENCY> (default: 10 -seconds). This variable can be changed only before the first signal -watcher is created, and should be left alone otherwise. Higher values -will cause fewer spurious wake-ups, which is better for power and CPU -saving. All these problems can be avoided by installing the optional -L module. - Example: exit on SIGINT my $w = AnyEvent->signal (signal => "INT", cb => sub { exit 1 }); +=head3 Signal Races, Delays and Workarounds + +Many event loops (e.g. Glib, Tk, Qt, IO::Async) do not support attaching +callbacks to signals in a generic way, which is a pity, as you cannot +do race-free signal handling in perl, requiring C libraries for +this. AnyEvent will try to do it's best, which means in some cases, +signals will be delayed. The maximum time a signal might be delayed is +specified in C<$AnyEvent::MAX_SIGNAL_LATENCY> (default: 10 seconds). This +variable can be changed only before the first signal watcher is created, +and should be left alone otherwise. This variable determines how often +AnyEvent polls for signals (in case a wake-up was missed). Higher values +will cause fewer spurious wake-ups, which is better for power and CPU +saving. + +All these problems can be avoided by installing the optional +L module, which works with most event loops. It will not +work with inherently broken event loops such as L or L +(and not with L currently, as POE does it's own workaround with +one-second latency). For those, you just have to suffer the delays. + =head2 CHILD PROCESS WATCHERS + $w = AnyEvent->child (pid => , cb => ); + You can also watch on a child process exit and catch its exit status. -The child process is specified by the C argument (if set to C<0>, it -watches for any child process exit). The watcher will triggered only when -the child process has finished and an exit status is available, not on -any trace events (stopped/continued). +The child process is specified by the C argument (one some backends, +using C<0> watches for any child process exit, on others this will +croak). The watcher will be triggered only when the child process has +finished and an exit status is available, not on any trace events +(stopped/continued). The callback will be called with the pid and exit status (as returned by waitpid), so unlike other watcher types, you I rely on child watcher @@ -443,6 +479,8 @@ =head2 IDLE WATCHERS + $w = AnyEvent->idle (cb => ); + Sometimes there is a need to do something, but it is not so important to do it instantly, but only when there is nothing better to do. This "nothing better to do" is usually defined to be "no other events need @@ -478,6 +516,11 @@ =head2 CONDITION VARIABLES + $cv = AnyEvent->condvar; + + $cv->send (); + my @res = $cv->recv; + If you are familiar with some event loops you will know that all of them require you to run some blocking "loop", "run" or similar function that will actively watch for new events and call your callbacks. @@ -506,7 +549,8 @@ in time where multiple outstanding events have been processed. And yet another way to call them is transactions - each condition variable can be used to represent a transaction, which finishes at some point and delivers -a result. +a result. And yet some people know them as "futures" - a promise to +compute/deliver something that you can wait for. Condition variables are very useful to signal that something has finished, for example, if you write a module that does asynchronous http requests, @@ -748,10 +792,10 @@ This is a mutator function that returns the callback set and optionally replaces it before doing so. -The callback will be called when the condition becomes "true", i.e. when -C or C are called, with the only argument being the condition -variable itself. Calling C inside the callback or at any later time -is guaranteed not to block. +The callback will be called when the condition becomes (or already was) +"true", i.e. when C or C are called (or were called), with +the only argument being the condition variable itself. Calling C +inside the callback or at any later time is guaranteed not to block. =back @@ -784,6 +828,7 @@ AnyEvent::Impl::Tk based on Tk, very broken. AnyEvent::Impl::EventLib based on Event::Lib, leaks memory and worse. AnyEvent::Impl::POE based on POE, very slow, some limitations. + AnyEvent::Impl::Irssi used when running within irssi. =item Backends with special needs. @@ -867,8 +912,25 @@ avoid autodetecting the event module at load time. If called in scalar or list context, then it creates and returns an object -that automatically removes the callback again when it is destroyed. See -L for a case where this is useful. +that automatically removes the callback again when it is destroyed (or +C when the hook was immediately executed). See L for +a case where this is useful. + +Example: Create a watcher for the IO::AIO module and store it in +C<$WATCHER>. Only do so after the event loop is initialised, though. + + our WATCHER; + + my $guard = AnyEvent::post_detect { + $WATCHER = AnyEvent->io (fh => IO::AIO::poll_fileno, poll => 'r', cb => \&IO::AIO::poll_cb); + }; + + # the ||= is important in case post_detect immediately runs the block, + # as to not clobber the newly-created watcher. assigning both watcher and + # post_detect guard to the same variable has the advantage of users being + # able to just C if the watcher causes them grief. + + $WATCHER ||= $guard; =item @AnyEvent::post_detect @@ -1055,7 +1117,7 @@ use Carp (); -our $VERSION = 4.85; +our $VERSION = 4.9; our $MODEL; our $AUTOLOAD; @@ -1090,14 +1152,15 @@ } my @models = ( - [EV:: => AnyEvent::Impl::EV::], - [Event:: => AnyEvent::Impl::Event::], - [AnyEvent::Impl::Perl:: => AnyEvent::Impl::Perl::], - # everything below here will not be autoprobed + [EV:: => AnyEvent::Impl::EV:: , 1], + [Event:: => AnyEvent::Impl::Event::, 1], + [AnyEvent::Impl::Perl:: => AnyEvent::Impl::Perl:: , 1], + # everything below here will not (normally) be autoprobed # as the pureperl backend should work everywhere # and is usually faster - [Glib:: => AnyEvent::Impl::Glib::], # becomes extremely slow with many watchers + [Glib:: => AnyEvent::Impl::Glib:: , 1], # becomes extremely slow with many watchers [Event::Lib:: => AnyEvent::Impl::EventLib::], # too buggy + [Irssi:: => AnyEvent::Impl::Irssi::], # Irssi has a bogus "Event" package [Tk:: => AnyEvent::Impl::Tk::], # crashes with many handles [Qt:: => AnyEvent::Impl::Qt::], # requires special main program [POE::Kernel:: => AnyEvent::Impl::POE::], # lasciate ogni speranza @@ -1107,9 +1170,9 @@ # byzantine signal and broken child handling, among others. # IO::Async is rather hard to detect, as it doesn't have any # obvious default class. -# [IO::Async:: => AnyEvent::Impl::IOAsync::], # requires special main program -# [IO::Async::Loop:: => AnyEvent::Impl::IOAsync::], # requires special main program -# [IO::Async::Notifier:: => AnyEvent::Impl::IOAsync::], # requires special main program +# [0, IO::Async:: => AnyEvent::Impl::IOAsync::], # requires special main program +# [0, IO::Async::Loop:: => AnyEvent::Impl::IOAsync::], # requires special main program +# [0, IO::Async::Notifier:: => AnyEvent::Impl::IOAsync::], # requires special main program ); our %method = map +($_ => 1), @@ -1123,7 +1186,7 @@ if ($MODEL) { $cb->(); - 1 + undef } else { push @post_detect, $cb; @@ -1165,15 +1228,17 @@ } unless ($MODEL) { - # try to load a model - + # try to autoload a model for (@REGISTRY, @models) { - my ($package, $model) = @$_; - if (eval "require $package" - and ${"$package\::VERSION"} > 0 - and eval "require $model") { + my ($package, $model, $autoload) = @$_; + if ( + $autoload + and eval "require $package" + and ${"$package\::VERSION"} > 0 + and eval "require $model" + ) { $MODEL = $model; - warn "AnyEvent: autoprobed model '$model', using it.\n" if $VERBOSE >= 2; + warn "AnyEvent: autoloaded model '$model', using it.\n" if $VERBOSE >= 2; last; } } @@ -1255,6 +1320,15 @@ # default implementation for ->signal our $HAVE_ASYNC_INTERRUPT; + +sub _have_async_interrupt() { + $HAVE_ASYNC_INTERRUPT = 1*(!$ENV{PERL_ANYEVENT_AVOID_ASYNC_INTERRUPT} + && eval "use Async::Interrupt 1.0 (); 1") + unless defined $HAVE_ASYNC_INTERRUPT; + + $HAVE_ASYNC_INTERRUPT +} + our ($SIGPIPE_R, $SIGPIPE_W, %SIG_CB, %SIG_EV, $SIG_IO); our (%SIG_ASY, %SIG_ASY_W); our ($SIG_COUNT, $SIG_TW); @@ -1272,105 +1346,150 @@ } } -sub _signal { - my (undef, %arg) = @_; - - my $signal = uc $arg{signal} - or Carp::croak "required option 'signal' is missing"; - - $SIG_CB{$signal}{$arg{cb}} = $arg{cb}; - - if ($HAVE_ASYNC_INTERRUPT) { - # async::interrupt - - $SIG_ASY{$signal} ||= do { - my $asy = new Async::Interrupt - cb => sub { undef $SIG_EV{$signal} }, - signal => $signal, - pipe => [$SIGPIPE_R->filenos], - ; - $asy->pipe_autodrain (0); - - $asy - }; - - } else { - # pure perl - - $SIG{$signal} ||= sub { - local $!; - syswrite $SIGPIPE_W, "\x00", 1 unless %SIG_EV; - undef $SIG_EV{$signal}; - }; +# install a dummy wakeup watcher to reduce signal catching latency +sub _sig_add() { + unless ($SIG_COUNT++) { + # try to align timer on a full-second boundary, if possible + my $NOW = AnyEvent->now; - # can't do signal processing without introducing races in pure perl, - # so limit the signal latency. - ++$SIG_COUNT; - $SIG_TW ||= AnyEvent->timer ( - after => $MAX_SIGNAL_LATENCY, + $SIG_TW = AnyEvent->timer ( + after => $MAX_SIGNAL_LATENCY - ($NOW - int $NOW), interval => $MAX_SIGNAL_LATENCY, cb => sub { }, # just for the PERL_ASYNC_CHECK ); } +} - bless [$signal, $arg{cb}], "AnyEvent::Base::signal" +sub _sig_del { + undef $SIG_TW + unless --$SIG_COUNT; } -sub signal { - # probe for availability of Async::Interrupt - if (!$ENV{PERL_ANYEVENT_AVOID_ASYNC_INTERRUPT} && eval "use Async::Interrupt 0.6 (); 1") { - warn "AnyEvent: using Async::Interrupt for race-free signal handling.\n" if $VERBOSE >= 8; - - $HAVE_ASYNC_INTERRUPT = 1; - $SIGPIPE_R = new Async::Interrupt::EventPipe; - $SIG_IO = AnyEvent->io (fh => $SIGPIPE_R->fileno, poll => "r", cb => \&_signal_exec); +our $_sig_name_init; $_sig_name_init = sub { + eval q{ # poor man's autoloading + undef $_sig_name_init; + + if (_have_async_interrupt) { + *sig2num = \&Async::Interrupt::sig2num; + *sig2name = \&Async::Interrupt::sig2name; + } else { + require Config; - } else { - warn "AnyEvent: using emulated perl signal handling with latency timer.\n" if $VERBOSE >= 8; + my %signame2num; + @signame2num{ split ' ', $Config::Config{sig_name} } + = split ' ', $Config::Config{sig_num}; + + my @signum2name; + @signum2name[values %signame2num] = keys %signame2num; + + *sig2num = sub($) { + $_[0] > 0 ? shift : $signame2num{+shift} + }; + *sig2name = sub ($) { + $_[0] > 0 ? $signum2name[+shift] : shift + }; + } + }; + die if $@; +}; + +sub sig2num ($) { &$_sig_name_init; &sig2num } +sub sig2name($) { &$_sig_name_init; &sig2name } - require Fcntl; +sub signal { + eval q{ # poor man's autoloading {} + # probe for availability of Async::Interrupt + if (_have_async_interrupt) { + warn "AnyEvent: using Async::Interrupt for race-free signal handling.\n" if $VERBOSE >= 8; - if (AnyEvent::WIN32) { - require AnyEvent::Util; + $SIGPIPE_R = new Async::Interrupt::EventPipe; + $SIG_IO = AnyEvent->io (fh => $SIGPIPE_R->fileno, poll => "r", cb => \&_signal_exec); - ($SIGPIPE_R, $SIGPIPE_W) = AnyEvent::Util::portable_pipe (); - AnyEvent::Util::fh_nonblocking ($SIGPIPE_R) if $SIGPIPE_R; - AnyEvent::Util::fh_nonblocking ($SIGPIPE_W) if $SIGPIPE_W; # just in case } else { - pipe $SIGPIPE_R, $SIGPIPE_W; - fcntl $SIGPIPE_R, &Fcntl::F_SETFL, &Fcntl::O_NONBLOCK if $SIGPIPE_R; - fcntl $SIGPIPE_W, &Fcntl::F_SETFL, &Fcntl::O_NONBLOCK if $SIGPIPE_W; # just in case - - # not strictly required, as $^F is normally 2, but let's make sure... - fcntl $SIGPIPE_R, &Fcntl::F_SETFD, &Fcntl::FD_CLOEXEC; - fcntl $SIGPIPE_W, &Fcntl::F_SETFD, &Fcntl::FD_CLOEXEC; + warn "AnyEvent: using emulated perl signal handling with latency timer.\n" if $VERBOSE >= 8; + + require Fcntl; + + if (AnyEvent::WIN32) { + require AnyEvent::Util; + + ($SIGPIPE_R, $SIGPIPE_W) = AnyEvent::Util::portable_pipe (); + AnyEvent::Util::fh_nonblocking ($SIGPIPE_R, 1) if $SIGPIPE_R; + AnyEvent::Util::fh_nonblocking ($SIGPIPE_W, 1) if $SIGPIPE_W; # just in case + } else { + pipe $SIGPIPE_R, $SIGPIPE_W; + fcntl $SIGPIPE_R, &Fcntl::F_SETFL, &Fcntl::O_NONBLOCK if $SIGPIPE_R; + fcntl $SIGPIPE_W, &Fcntl::F_SETFL, &Fcntl::O_NONBLOCK if $SIGPIPE_W; # just in case + + # not strictly required, as $^F is normally 2, but let's make sure... + fcntl $SIGPIPE_R, &Fcntl::F_SETFD, &Fcntl::FD_CLOEXEC; + fcntl $SIGPIPE_W, &Fcntl::F_SETFD, &Fcntl::FD_CLOEXEC; + } + + $SIGPIPE_R + or Carp::croak "AnyEvent: unable to create a signal reporting pipe: $!\n"; + + $SIG_IO = AnyEvent->io (fh => $SIGPIPE_R, poll => "r", cb => \&_signal_exec); } - $SIGPIPE_R - or Carp::croak "AnyEvent: unable to create a signal reporting pipe: $!\n"; + *signal = sub { + my (undef, %arg) = @_; - $SIG_IO = AnyEvent->io (fh => $SIGPIPE_R, poll => "r", cb => \&_signal_exec); - } + my $signal = uc $arg{signal} + or Carp::croak "required option 'signal' is missing"; - *signal = \&_signal; - &signal -} + if ($HAVE_ASYNC_INTERRUPT) { + # async::interrupt -sub AnyEvent::Base::signal::DESTROY { - my ($signal, $cb) = @{$_[0]}; + $signal = sig2num $signal; + $SIG_CB{$signal}{$arg{cb}} = $arg{cb}; + + $SIG_ASY{$signal} ||= new Async::Interrupt + cb => sub { undef $SIG_EV{$signal} }, + signal => $signal, + pipe => [$SIGPIPE_R->filenos], + pipe_autodrain => 0, + ; - undef $SIG_TW - unless --$SIG_COUNT; + } else { + # pure perl - delete $SIG_CB{$signal}{$cb}; + # AE::Util has been loaded in signal + $signal = sig2name $signal; + $SIG_CB{$signal}{$arg{cb}} = $arg{cb}; + + $SIG{$signal} ||= sub { + local $!; + syswrite $SIGPIPE_W, "\x00", 1 unless %SIG_EV; + undef $SIG_EV{$signal}; + }; + + # can't do signal processing without introducing races in pure perl, + # so limit the signal latency. + _sig_add; + } - $HAVE_ASYNC_INTERRUPT - ? delete $SIG_ASY{$signal} - : # delete doesn't work with older perls - they then - # print weird messages, or just unconditionally exit - # instead of getting the default action. - undef $SIG{$signal} - unless keys %{ $SIG_CB{$signal} }; + bless [$signal, $arg{cb}], "AnyEvent::Base::signal" + }; + + *AnyEvent::Base::signal::DESTROY = sub { + my ($signal, $cb) = @{$_[0]}; + + _sig_del; + + delete $SIG_CB{$signal}{$cb}; + + $HAVE_ASYNC_INTERRUPT + ? delete $SIG_ASY{$signal} + : # delete doesn't work with older perls - they then + # print weird messages, or just unconditionally exit + # instead of getting the default action. + undef $SIG{$signal} + unless keys %{ $SIG_CB{$signal} }; + }; + }; + die if $@; + &signal } # default implementation for ->child @@ -1380,12 +1499,19 @@ our $CHLD_DELAY_W; our $WNOHANG; +sub _emit_childstatus($$) { + my (undef, $rpid, $rstatus) = @_; + + $_->($rpid, $rstatus) + for values %{ $PID_CB{$rpid} || {} }, + values %{ $PID_CB{0} || {} }; +} + sub _sigchld { - while (0 < (my $pid = waitpid -1, $WNOHANG)) { - $_->($pid, $?) - for values %{ $PID_CB{$pid} || {} }, - values %{ $PID_CB{0} || {} }; - } + my $pid; + + AnyEvent->_emit_childstatus ($pid, $?) + while ($pid = waitpid -1, $WNOHANG) > 0; } sub child { @@ -1510,8 +1636,13 @@ } sub cb { - $_[0]{_ae_cb} = $_[1] if @_ > 1; - $_[0]{_ae_cb} + my $cv = shift; + + @_ + and $cv->{_ae_cb} = shift + and $cv->{_ae_sent} + and (delete $cv->{_ae_cb})->($cv); + $cv->{_ae_cb} } sub begin { @@ -1528,6 +1659,48 @@ *broadcast = \&send; *wait = \&_wait; +############################################################################# +# "new" API, currently only emulation of it +############################################################################# + +package AE; + +sub io($$$) { + AnyEvent->io (fh => $_[0], poll => $_[1] ? "w" : "r", cb => $_[2]) +} + +sub timer($$$) { + AnyEvent->timer (after => $_[0], interval => $_[1], cb => $_[2]); +} + +sub signal($$) { + AnyEvent->signal (signal => $_[0], cb => $_[1]); +} + +sub child($$) { + AnyEvent->child (pid => $_[0], cb => $_[1]); +} + +sub idle($) { + AnyEvent->idle (cb => $_[0]); +} + +sub cv() { + AnyEvent->condvar +} + +sub now() { + AnyEvent->now +} + +sub now_update() { + AnyEvent->now_update +} + +sub time() { + AnyEvent->time +} + =head1 ERROR AND EXCEPTION HANDLING In general, AnyEvent does not do any error handling - it relies on the @@ -2259,7 +2432,7 @@ my knowledge, there is no way to do completely race-free and quick signal handling in pure perl. To ensure that signals still get delivered, AnyEvent will start an interval timer to wake up perl (and -catch the signals) with soemd elay (default is 10 seconds, look for +catch the signals) with some delay (default is 10 seconds, look for C<$AnyEvent::MAX_SIGNAL_LATENCY>). If this module is available, then it will be used to implement signal @@ -2270,6 +2443,11 @@ This affects not just the pure-perl event loop, but also other event loops that have no signal handling on their own (e.g. Glib, Tk, Qt). +Some event loops (POE, Event, Event::Lib) offer signal watchers natively, +and either employ their own workarounds (POE) or use AnyEvent's workaround +(using C<$AnyEvent::MAX_SIGNAL_LATENCY>). Installing L +does nothing for those backends. + =item L This module isn't really "optional", as it is simply one of the backend @@ -2292,7 +2470,7 @@ This module is required when you want to read or write JSON data via L. It is also written in pure-perl, but can take -advantage of the ulta-high-speed L module when it is installed. +advantage of the ultra-high-speed L module when it is installed. In fact, L will use L by default if it is installed. @@ -2369,7 +2547,7 @@ Implementations: L, L, L, L, L, L, L, -L, L. +L, L, L. Non-blocking file handles, sockets, TCP clients and servers: L, L, L.