view release on metacpan or  search on metacpan

lib/AnyEvent/Loop.pm  view on Meta::CPAN

sub now       () { $NOW          }
sub now_update() { _update_clock }

# fds[0] is for read, fds[1] is for write watchers
# fds[poll][V] is the bitmask for select
# fds[poll][W][fd] contains a list of i/o watchers
# an I/O watcher is a blessed arrayref containing [fh, poll(0/1), callback, queue-index]
# the queue-index is simply the index in the [W] array, which is only used to improve
# benchmark results in the synthetic "many watchers on one fd" benchmark.
my @fds = ([], []);
sub V() { 0 }
sub W() { 1 }

my $need_sort = 1e300; # when to re-sort timer list
my @timer; # list of [ abs-timeout, Timer::[callback] ]
my @idle;  # list of idle callbacks

# the pure perl mainloop
sub one_event {
   _update_clock;

   # first sort timers if required (slow)
   if ($MNOW >= $need_sort) {
      $need_sort = 1e300;
      @timer = sort { $a->[0] <=> $b->[0] } @timer;
   }

   # handle all pending timers
   if (@timer && $timer[0][0] <= $MNOW) {
      do {
         my $timer = shift @timer;
         $timer->[1] && $timer->[1]($timer);
      } while @timer && $timer[0][0] <= $MNOW;

   } else {
      # poll for I/O events, we do not do this when there
      # were any pending timers to ensure that one_event returns
      # quickly when some timers have been handled
      my ($wait, @vec, $fds)
         = (@timer && $timer[0][0] < $need_sort ? $timer[0][0] : $need_sort) - $MNOW;

      $wait = $wait < MAXWAIT ? $wait + ROUNDUP : MAXWAIT;
      $wait = 0 if @idle;

      $fds = CORE::select
        $vec[0] = $fds[0][V],
        $vec[1] = $fds[1][V],
        AnyEvent::WIN32 ? $vec[2] = $fds[1][V] : undef,
        $wait;

      _update_clock;

      if ($fds > 0) {
         # buggy microshit windows errornously sets exceptfds instead of writefds
         $vec[1] |= $vec[2] if AnyEvent::WIN32;

         # prefer write watchers, because they might reduce memory pressure.
         for (1, 0) {
            my $fds = $fds[$_];

            # we parse the bitmask by first expanding it into
            # a string of bits
            for (unpack "b*", $vec[$_]) {
               # and then repeatedly matching a regex against it
               while (/1/g) {
                  # and use the resulting string position as fd
                  $_ && $_->[2]()
                     for @{ $fds->[W][(pos) - 1] || [] };
               }
            }
         }
      } elsif (AnyEvent::WIN32 && $fds && $! == AnyEvent::Util::WSAEINVAL) {
         # buggy microshit windoze asks us to route around it
         CORE::select undef, undef, undef, $wait if $wait;
      } elsif (!@timer || $timer[0][0] > $MNOW && !$fds) {
         $$$_ && $$$_->() for @idle = grep $$$_, @idle;
      }
   }
}

sub run {
   one_event while 1;
}

sub io($$$) {
   my ($fd, $write, $cb) = @_;

   defined ($fd = fileno $fd)
      or $fd = $_[0];

   my $self = bless [
      $fd,
      $write,
      $cb,
      # q-idx
   ], "AnyEvent::Loop::io";

   my $fds = $fds[$self->[1]];

   # add watcher to fds structure
   my $q = $fds->[W][$fd] ||= [];

   (vec $fds->[V], $fd, 1) = 1;

   $self->[3] = @$q;
   push @$q, $self;
   weaken $q->[-1];

   $self
}

sub AnyEvent::Loop::io::DESTROY {
   my ($self) = @_;

   my $fds = $fds[$self->[1]];

   # remove watcher from fds structure
   my $fd = $self->[0];

   if (@{ $fds->[W][$fd] } == 1) {
      delete $fds->[W][$fd];