[ViewVC] Diff of: cvs/AnyEvent/lib/AnyEvent.pm

Comparing AnyEvent/lib/AnyEvent.pm (file contents):
Revision 1.241 by root, Fri Jul 17 18:08:35 2009 UTC vs.
Revision 1.243 by root, Fri Jul 17 23:12:20 2009 UTC

 invocation, and callback invocation will be synchronous. Synchronous means
 that it might take a while until the signal gets handled by the process,
 but it is guaranteed not to interrupt any other callbacks.
 The main advantage of using these watchers is that you can share a signal
-between multiple watchers.
+between multiple watchers, and AnyEvent will ensure that signals will not
+interrupt your program at bad times.
-This watcher might use C<%SIG>, so programs overwriting those signals
+This watcher might use C<%SIG> (depending on the event loop used),
-directly will likely not work correctly.
+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<Async::Interrupt> module.
 Example: exit on SIGINT
    my $w = AnyEvent->signal (signal => "INT", cb => sub { exit 1 });
 This means you cannot create a child watcher as the very first
 thing in an AnyEvent program, you I<have> to create at least one
 watcher before you C<fork> the child (alternatively, you can call
 C<AnyEvent::detect>).
+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.
 Example: fork a process and wait for it
    my $done = AnyEvent->condvar;
 =cut
 package AnyEvent;
+# basically a tuned-down version of common::sense
+sub common_sense {
-no warnings;
+   # no warnings
+   ${^WARNING_BITS} ^= ${^WARNING_BITS};
-use strict qw(vars subs);
+   # use strict vars subs
+   $^H |= 0x00000600;
+}
+BEGIN { AnyEvent::common_sense }
 use Carp ();
 our $VERSION = 4.83;
 our $MODEL;
 our @ISA;
 our @REGISTRY;
 our $WIN32;
+our $VERBOSE;
 BEGIN {
    eval "sub WIN32(){ " . (($^O =~ /mswin32/i)*1) ." }";
    eval "sub TAINT(){ " . (${^TAINT}*1) . " }";
    delete @ENV{grep /^PERL_ANYEVENT_/, keys %ENV}
       if ${^TAINT};
-}
-our $verbose = $ENV{PERL_ANYEVENT_VERBOSE}*1;
+   $VERBOSE = $ENV{PERL_ANYEVENT_VERBOSE}*1;
+}
+our $MAX_SIGNAL_LATENCY = 10;
 our %PROTOCOL; # (ipv4|ipv6) => (1|2), higher numbers are preferred
 {
    my $idx;
    @post_detect = grep $_ != ${$_[0]}, @post_detect;
 }
 sub detect() {
    unless ($MODEL) {
-      no strict 'refs';
       local $SIG{__DIE__};
       if ($ENV{PERL_ANYEVENT_MODEL} =~ /^([a-zA-Z]+)$/) {
          my $model = "AnyEvent::Impl::$1";
          if (eval "require $model") {
             $MODEL = $model;
-            warn "AnyEvent: loaded model '$model' (forced by \$ENV{PERL_ANYEVENT_MODEL}), using it.\n" if $verbose > 1;
+            warn "AnyEvent: loaded model '$model' (forced by \$ENV{PERL_ANYEVENT_MODEL}), using it.\n" if $VERBOSE >= 2;
          } else {
-            warn "AnyEvent: unable to load model '$model' (from \$ENV{PERL_ANYEVENT_MODEL}):\n$@" if $verbose;
+            warn "AnyEvent: unable to load model '$model' (from \$ENV{PERL_ANYEVENT_MODEL}):\n$@" if $VERBOSE;
          }
       }
       # check for already loaded models
       unless ($MODEL) {
          for (@REGISTRY, @models) {
             my ($package, $model) = @$_;
             if (${"$package\::VERSION"} > 0) {
                if (eval "require $model") {
                   $MODEL = $model;
-                  warn "AnyEvent: autodetected model '$model', using it.\n" if $verbose > 1;
+                  warn "AnyEvent: autodetected model '$model', using it.\n" if $VERBOSE >= 2;
                   last;
                }
             }
          }
                my ($package, $model) = @$_;
                if (eval "require $package"
                    and ${"$package\::VERSION"} > 0
                    and eval "require $model") {
                   $MODEL = $model;
-                  warn "AnyEvent: autoprobed model '$model', using it.\n" if $verbose > 1;
+                  warn "AnyEvent: autoprobed model '$model', using it.\n" if $VERBOSE >= 2;
                   last;
                }
             }
             $MODEL
 package AnyEvent::Base;
 # default implementations for many methods
-BEGIN {
+sub _time {
+   # probe for availability of Time::HiRes
    if (eval "use Time::HiRes (); Time::HiRes::time (); 1") {
+      warn "AnyEvent: using Time::HiRes for sub-second timing accuracy.\n" if $VERBOSE >= 8;
       *_time = \&Time::HiRes::time;
       # if (eval "use POSIX (); (POSIX::times())...
    } else {
+      warn "AnyEvent: using built-in time(), WARNING, no sub-second resolution!\n" if $VERBOSE;
       *_time = sub { time }; # epic fail
    }
+   &_time
 }
 sub time { _time }
 sub now  { _time }
 sub now_update { }
    bless { @_ == 3 ? (_ae_cb => $_[2]) : () }, "AnyEvent::CondVar"
 }
 # default implementation for ->signal
+our $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);
 sub _signal_exec {
+   $HAVE_ASYNC_INTERRUPT
+      ? $SIGPIPE_R->drain
-   sysread $SIGPIPE_R, my $dummy, 4;
+      : sysread $SIGPIPE_R, my $dummy, 9;
    while (%SIG_EV) {
       for (keys %SIG_EV) {
          delete $SIG_EV{$_};
          $_->() for values %{ $SIG_CB{$_} || {} };
       }
    }
 }
+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};
+      };
+      # 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,
+         interval => $MAX_SIGNAL_LATENCY,
+         cb       => sub { }, # just for the PERL_ASYNC_CHECK
+      );
+   }
+   bless [$signal, $arg{cb}], "AnyEvent::Base::signal"
+}
 sub signal {
-   my (undef, %arg) = @_;
+   # 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;
-   unless ($SIGPIPE_R) {
+      $HAVE_ASYNC_INTERRUPT = 1;
+      $SIGPIPE_R = new Async::Interrupt::EventPipe;
+      $SIG_IO = AnyEvent->io (fh => $SIGPIPE_R->fileno, poll => "r", cb => \&_signal_exec);
+   } else {
+      warn "AnyEvent: using emulated perl signal handling with latency timer.\n" if $VERBOSE >= 8;
       require Fcntl;
       if (AnyEvent::WIN32) {
          require AnyEvent::Util;
          or Carp::croak "AnyEvent: unable to create a signal reporting pipe: $!\n";
       $SIG_IO = AnyEvent->io (fh => $SIGPIPE_R, poll => "r", cb => \&_signal_exec);
    }
-   my $signal = uc $arg{signal}
+   *signal = \&_signal;
-      or Carp::croak "required option 'signal' is missing";
+   &signal
-   $SIG_CB{$signal}{$arg{cb}} = $arg{cb};
-   $SIG{$signal} ||= sub {
-      local $!;
-      syswrite $SIGPIPE_W, "\x00", 1 unless %SIG_EV;
-      undef $SIG_EV{$signal};
-   };
-   bless [$signal, $arg{cb}], "AnyEvent::Base::signal"
 }
 sub AnyEvent::Base::signal::DESTROY {
    my ($signal, $cb) = @{$_[0]};
+   undef $SIG_TW
+      unless --$SIG_COUNT;
    delete $SIG_CB{$signal}{$cb};
    # 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}
-   undef $SIG{$signal} unless keys %{ $SIG_CB{$signal} };
+      unless keys %{ $SIG_CB{$signal} };
 }
 # default implementation for ->child
 our %PID_CB;
 our $CHLD_DELAY_W;
 our $WNOHANG;
 sub _sigchld {
    while (0 < (my $pid = waitpid -1, $WNOHANG)) {
+      $_->($pid, $?)
-      $_->($pid, $?) for (values %{ $PID_CB{$pid} || {} }),
+         for values %{ $PID_CB{$pid} || {} },
-                         (values %{ $PID_CB{0}    || {} });
+             values %{ $PID_CB{0}    || {} };
    }
 }
 sub child {
    my (undef, %arg) = @_;
    defined (my $pid = $arg{pid} + 0)
       or Carp::croak "required option 'pid' is missing";
    $PID_CB{$pid}{$arg{cb}} = $arg{cb};
+   # WNOHANG is almost cetrainly 1 everywhere
+   $WNOHANG ||= $^O =~ /^(?:openbsd|netbsd|linux|freebsd|cygwin|MSWin32)$/
+                ? 1
-   $WNOHANG ||= eval { local $SIG{__DIE__}; require POSIX; &POSIX::WNOHANG } || 1;
+                : eval { local $SIG{__DIE__}; require POSIX; &POSIX::WNOHANG } || 1;
    unless ($CHLD_W) {
       $CHLD_W = AnyEvent->signal (signal => 'CHLD', cb => \&_sigchld);
       # child could be a zombie already, so make at least one round
       &_sigchld;
 our @ISA = AnyEvent::CondVar::Base::;
 package AnyEvent::CondVar::Base;
-use overload
+#use overload
-   '&{}'    => sub { my $self = shift; sub { $self->send (@_) } },
+#   '&{}'    => sub { my $self = shift; sub { $self->send (@_) } },
-   fallback => 1;
+#   fallback => 1;
+# save 300+ kilobytes by dirtily hardcoding overloading
+${"AnyEvent::CondVar::Base::OVERLOAD"}{dummy}++; # Register with magic by touching.
+*{'AnyEvent::CondVar::Base::()'}   = sub { }; # "Make it findable via fetchmethod."
+*{'AnyEvent::CondVar::Base::(&{}'} = sub { my $self = shift; sub { $self->send (@_) } }; # &{}
+${'AnyEvent::CondVar::Base::()'}   = 1; # fallback
 our $WAITING;
 sub _send {
    # nop
 check the arguments passed to most method calls. If it finds any problems,
 it will croak.
 In other words, enables "strict" mode.
-Unlike C<use strict>, it is definitely recommended to keep it off in
+Unlike C<use strict> (or it's modern cousin, C<< use L<common::sense>
-production. Keeping C<PERL_ANYEVENT_STRICT=1> in your environment while
+>>, it is definitely recommended to keep it off in production. Keeping
-developing programs can be very useful, however.
+C<PERL_ANYEVENT_STRICT=1> in your environment while developing programs
+can be very useful, however.
 =item C<PERL_ANYEVENT_MODEL>
 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
    if $SIG{CHLD} eq 'IGNORE';
 $SIG{PIPE} = sub { }
    unless defined $SIG{PIPE};
+=head1 RECOMMENDED/OPTIONAL MODULES
+One of AnyEvent's main goals is to be 100% Pure-Perl(tm): only perl (and
+it's built-in modules) are required to use it.
+That does not mean that AnyEvent won't take advantage of some additional
+modules if they are installed.
+This section epxlains which additional modules will be used, and how they
+affect AnyEvent's operetion.
+=over 4
+=item L<Async::Interrupt>
+This slightly arcane module is used to implement fast signal handling: To
+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
+C<$AnyEvent::MAX_SIGNAL_LATENCY>).
+If this module is available, then it will be used to implement signal
+catching, which means that signals will not be delayed, and the event loop
+will not be interrupted regularly, which is more efficient (And good for
+battery life on laptops).
+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).
+=item L<EV>
+This module isn't really "optional", as it is simply one of the backend
+event loops that AnyEvent can use. However, it is simply the best event
+loop available in terms of features, speed and stability: It supports
+the AnyEvent API optimally, implements all the watcher types in XS, does
+automatic timer adjustments even when no monotonic clock is available,
+can take avdantage of advanced kernel interfaces such as C<epoll> and
+C<kqueue>, and is the fastest backend I<by far>. You can even embed
+L<Glib>/L<Gtk2> in it (or vice versa, see L<EV::Glib> and L<Glib::EV>).
+=item L<Guard>
+The guard module, when used, will be used to implement
+C<AnyEvent::Util::guard>. This speeds up guards considerably (and uses a
+lot less memory), but otherwise doesn't affect guard operation much. It is
+purely used for performance.
+=item L<JSON> and L<JSON::XS>
+This module is required when you want to read or write JSON data via
+L<AnyEvent::Handle>. It is also written in pure-perl, but can take
+advantage of the ulta-high-speed L<JSON::XS> module when it is installed.
+In fact, L<AnyEvent::Handle> will use L<JSON::XS> by default if it is
+installed.
+=item L<Net::SSLeay>
+Implementing TLS/SSL in Perl is certainly interesting, but not very
+worthwhile: If this module is installed, then L<AnyEvent::Handle> (with
+the help of L<AnyEvent::TLS>), gains the ability to do TLS/SSL.
+=item L<Time::HiRes>
+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 on it's own. The
+pure-perl event loop (L<AnyEvent::Impl::Perl>) will additionally use it to
+try to use a monotonic clock for timing stability.
+=back
 =head1 FORK
 Most event libraries are not fork-safe. The ones who are usually are
 because they rely on inefficient but fork-safe C<select> or C<poll>
 calls. Only L<EV> is fully fork-aware.
 If you have to fork, you must either do so I<before> creating your first
-watcher OR you must not use AnyEvent at all in the child.
+watcher OR you must not use AnyEvent at all in the child OR you must do
+something completely out of the scope of AnyEvent.
 =head1 SECURITY CONSIDERATIONS
 AnyEvent can be forced to load any event model via

Diff Legend

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

Comparing AnyEvent/lib/AnyEvent.pm (file contents): Revision 1.241 by root, Fri Jul 17 18:08:35 2009 UTC vs. Revision 1.243 by root, Fri Jul 17 23:12:20 2009 UTC

Diff Legend

Comparing AnyEvent/lib/AnyEvent.pm (file contents):
Revision 1.241 by root, Fri Jul 17 18:08:35 2009 UTC vs.
Revision 1.243 by root, Fri Jul 17 23:12:20 2009 UTC