--- AnyEvent/lib/AnyEvent.pm 2009/07/21 03:30:02 1.252 +++ AnyEvent/lib/AnyEvent.pm 2009/08/09 13:27:23 1.277 @@ -1,9 +1,9 @@ =head1 NAME -AnyEvent - events independent of event loop implementation +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 @@ -49,7 +49,7 @@ channel, too. See the AnyEvent project page at the B, at L, for more info. +Repository>, at L, for more info. =head1 WHY YOU SHOULD USE THIS MODULE (OR NOT) @@ -183,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: @@ -221,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: @@ -357,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. @@ -385,27 +401,34 @@ =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. 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 +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. This 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). With -those, you just have to suffer the delays. +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 @@ -456,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 @@ -491,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. @@ -762,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 @@ -778,12 +808,11 @@ =item Backends that are autoprobed when no other event loop can be found. EV is the preferred backend when no other event loop seems to be in -use. If EV is not installed, then AnyEvent will try Event, and, failing -that, will fall back to its own pure-perl implementation, which is -available everywhere as it comes with AnyEvent itself. +use. If EV is not installed, then AnyEvent will fall back to its own +pure-perl implementation, which is available everywhere as it comes with +AnyEvent itself. AnyEvent::Impl::EV based on EV (interface to libev, best choice). - AnyEvent::Impl::Event based on Event, very stable, few glitches. AnyEvent::Impl::Perl pure-perl implementation, fast and portable. =item Backends that are transparently being picked up when they are used. @@ -794,10 +823,12 @@ when the main program loads an event module before anything starts to create watchers. Nothing special needs to be done by the main program. + AnyEvent::Impl::Event based on Event, very stable, few glitches. AnyEvent::Impl::Glib based on Glib, slow but very stable. 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. @@ -1086,7 +1117,7 @@ use Carp (); -our $VERSION = 4.86; +our $VERSION = 4.92; our $MODEL; our $AUTOLOAD; @@ -1121,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], + [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 + [Event:: => AnyEvent::Impl::Event::, 1], + [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 @@ -1138,9 +1170,10 @@ # 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 + [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 + [AnyEvent::Impl::IOAsync:: => AnyEvent::Impl::IOAsync::], # requires special main program ); our %method = map +($_ => 1), @@ -1154,7 +1187,7 @@ if ($MODEL) { $cb->(); - 1 + undef } else { push @post_detect, $cb; @@ -1196,15 +1229,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 +1290,50 @@ ($fh2, $rw) } +############################################################################# +# "new" API, currently only emulation of it +############################################################################# + +package AE; + +our $VERSION = $AnyEvent::VERSION; + +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 (@_ ? (cb => $_[0]) : ()) +} + +sub now() { + AnyEvent->now +} + +sub now_update() { + AnyEvent->now_update +} + +sub time() { + AnyEvent->time +} + package AnyEvent::Base; # default implementations for many methods @@ -1286,6 +1365,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); @@ -1303,17 +1391,17 @@ } } -# install a dumym wakeupw atcher to reduce signal catching latency +# 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; + my $NOW = AE::now; - $SIG_TW = AnyEvent->timer ( - after => $MAX_SIGNAL_LATENCY - ($NOW - int $NOW), - interval => $MAX_SIGNAL_LATENCY, - cb => sub { }, # just for the PERL_ASYNC_CHECK - ); + $SIG_TW = AE::timer + $MAX_SIGNAL_LATENCY - ($NOW - int $NOW), + $MAX_SIGNAL_LATENCY, + sub { } # just for the PERL_ASYNC_CHECK + ; } } @@ -1322,99 +1410,131 @@ unless --$SIG_COUNT; } -sub _signal { - my (undef, %arg) = @_; +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; - my $signal = uc $arg{signal} - or Carp::croak "required option 'signal' is missing"; + 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 $@; +}; - $SIG_CB{$signal}{$arg{cb}} = $arg{cb}; +sub sig2num ($) { &$_sig_name_init; &sig2num } +sub sig2name($) { &$_sig_name_init; &sig2name } - if ($HAVE_ASYNC_INTERRUPT) { - # async::interrupt +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; - $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); + $SIGPIPE_R = new Async::Interrupt::EventPipe; + $SIG_IO = AE::io $SIGPIPE_R->fileno, 0, \&_signal_exec; - $asy - }; + } else { + warn "AnyEvent: using emulated perl signal handling with latency timer.\n" if $VERBOSE >= 8; - } else { - # pure perl + require Fcntl; - $SIG{$signal} ||= sub { - local $!; - syswrite $SIGPIPE_W, "\x00", 1 unless %SIG_EV; - undef $SIG_EV{$signal}; - }; + if (AnyEvent::WIN32) { + require AnyEvent::Util; - # can't do signal processing without introducing races in pure perl, - # so limit the signal latency. - _sig_add; - } + ($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; + } - bless [$signal, $arg{cb}], "AnyEvent::Base::signal" -} + $SIGPIPE_R + or Carp::croak "AnyEvent: unable to create a signal reporting pipe: $!\n"; -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); + $SIG_IO = AE::io $SIGPIPE_R, 0, \&_signal_exec; + } - } else { - warn "AnyEvent: using emulated perl signal handling with latency timer.\n" if $VERBOSE >= 8; + *signal = sub { + my (undef, %arg) = @_; - require Fcntl; + my $signal = uc $arg{signal} + or Carp::croak "required option 'signal' is missing"; - if (AnyEvent::WIN32) { - require AnyEvent::Util; + if ($HAVE_ASYNC_INTERRUPT) { + # async::interrupt - ($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; - } + $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, + ; - $SIGPIPE_R - or Carp::croak "AnyEvent: unable to create a signal reporting pipe: $!\n"; + } else { + # pure perl - $SIG_IO = AnyEvent->io (fh => $SIGPIPE_R, poll => "r", cb => \&_signal_exec); - } + # 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; + } - *signal = \&_signal; - &signal -} + bless [$signal, $arg{cb}], "AnyEvent::Base::signal" + }; -sub AnyEvent::Base::signal::DESTROY { - my ($signal, $cb) = @{$_[0]}; + *AnyEvent::Base::signal::DESTROY = sub { + my ($signal, $cb) = @{$_[0]}; - _sig_del; + _sig_del; - delete $SIG_CB{$signal}{$cb}; + 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} }; + $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 @@ -1424,12 +1544,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 { @@ -1446,7 +1573,7 @@ : eval { local $SIG{__DIE__}; require POSIX; &POSIX::WNOHANG } || 1; unless ($CHLD_W) { - $CHLD_W = AnyEvent->signal (signal => 'CHLD', cb => \&_sigchld); + $CHLD_W = AE::signal CHLD => \&_sigchld; # child could be a zombie already, so make at least one round &_sigchld; } @@ -1482,7 +1609,7 @@ $w = 0.0001 if $w < 0.0001; $w = 5 if $w > 5; - $w = AnyEvent->timer (after => $w, cb => $rcb); + $w = AE::timer $w, 0, $rcb; } else { # clean up... undef $w; @@ -1490,7 +1617,7 @@ } }; - $w = AnyEvent->timer (after => 0.05, cb => $rcb); + $w = AE::timer 0.05, 0, $rcb; bless \\$cb, "AnyEvent::Base::idle" } @@ -1554,8 +1681,14 @@ } 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 { @@ -2418,7 +2551,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.