#  You may distribute under the terms of either the GNU General Public License
#  or the Artistic License (the same terms as Perl itself)
#
#  (C) Paul Evans, 2011-2020 -- leonerd@leonerd.org.uk

package IO::Async::Loop::AnyEvent;

use strict;
use warnings;

our $VERSION = '0.04';
use constant API_VERSION => '0.76';

# Force AnyEvent to detect a suitable model now, before we load
# IO::Async::Loop. Otherwise, AnyEvent will use AnyEvent::Impl::IOAsync
# which causes a circular dependency at runtime, leading to such problems as:
#
#   Deep recursion on subroutine "AnyEvent::Impl::IOAsync::io" at ...

use AnyEvent;
BEGIN { AnyEvent::detect() }

# use base qw( IO::Async::Loop );
# Except, 'use base' breaks here if IO::Async::Loop is already loaded, causing
# SUPER:: lookups not to work properly.
BEGIN { require IO::Async::Loop; unshift our @ISA, qw( IO::Async::Loop ); }
IO::Async::Loop->VERSION( '0.49' );

use Carp;

use constant ANYEVENT_6 => $AnyEvent::VERSION >= 6;

=head1 NAME

C<IO::Async::Loop::AnyEvent> - use C<IO::Async> with C<AnyEvent>

=head1 SYNOPSIS

   use IO::Async::Loop::AnyEvent;

   my $loop = IO::Async::Loop::AnyEvent->new();

   $loop->add( ... );

   $loop->add( IO::Async::Signal->new(
         name => 'HUP',
         on_receipt => sub { ... },
   ) );

   $loop->run;

=head1 DESCRIPTION

This subclass of L<IO::Async::Loop> uses L<AnyEvent> to perform its work.

=head1 CONSTRUCTOR

=cut

=head2 new

   $loop = IO::Async::Loop::AnyEvent->new

This function returns a new instance of a C<IO::Async::Loop::AnyEvent> object.

=cut

sub new
{
   my $class = shift;
   my ( %args ) = @_;

   my $self = $class->SUPER::__new( %args );

   $self->{$_} = {} for qw( watch_r watch_w watch_time watch_signal watch_idle watch_child );

   return $self;
}

sub loop_once
{
   my $self = shift;
   my ( $timeout ) = @_;

   my $cv = AnyEvent->condvar;
   my $w;

   if( defined $timeout ) {
      $w = AnyEvent->timer( after => $timeout, cb => sub { $cv->send } );
   }

   if( ANYEVENT_6 ) {
      # This method isn't technically documented by AnyEvent
      AnyEvent->_poll;
   }
   else {
      # This method isn't technically documented by AnyEvent
      AnyEvent->one_event;
   }
}

sub loop_forever
{
   my $self = shift;

   ( local $self->{loop_forever_cv} = AnyEvent->condvar )->recv;
}

sub loop_stop
{
   my $self = shift;

   $self->{loop_forever_cv}->send;
}

sub watch_io
{
   my $self = shift;
   my %params = @_;

   my $handle = $params{handle} or die "Need a handle";

   if( my $on_read_ready = $params{on_read_ready} ) {
      $self->{watch_r}{$handle} = AnyEvent->io(
         fh   => $handle,
         poll => "r",
         cb   => $on_read_ready,
      );
   }

   if( my $on_write_ready = $params{on_write_ready} ) {
      $self->{watch_w}{$handle} = AnyEvent->io(
         fh   => $handle,
         poll => "w",
         cb   => $on_write_ready,
      );
   }
}

sub unwatch_io
{
   my $self = shift;
   my %params = @_;

   my $handle = $params{handle} or die "Need a handle";

   if( $params{on_read_ready} ) {
      delete $self->{watch_r}{$handle};
   }

   if( $params{on_write_ready} ) {
      delete $self->{watch_w}{$handle};
   }
}

sub watch_time
{
   my $self = shift;
   my %params = @_;

   my $code = $params{code} or croak "Expected 'code' as CODE ref";

   my $w;
   if( defined $params{at} ) {
      $w = AnyEvent->timer( after => $params{at} - $self->time, cb => $code );
   }
   elsif( defined $params{after} ) {
      $w = AnyEvent->timer( after => $params{after}, cb => $code );
   }
   else {
      croak "Expected one of 'at' or 'after'";
   }

   return $self->{watch_time}{$w} = $w;
}

sub unwatch_time
{
   my $self = shift;
   my ( $id ) = @_;

   delete $self->{watch_time}{$id};
}

sub watch_signal
{
   my $self = shift;
   my ( $signal, $code ) = @_;

   $self->{watch_signal}{$signal} = AnyEvent->signal(
      signal => $signal,
      cb     => $code,
   );
}

sub unwatch_signal
{
   my $self = shift;
   my ( $signal ) = @_;

   delete $self->{watch_signal}{$signal};
}

sub watch_idle
{
   my $self = shift;
   my %params = @_;

   my $when = delete $params{when} or croak "Expected 'when'";

   my $code = delete $params{code} or croak "Expected 'code' as a CODE ref";

   $when eq "later" or croak "Expected 'when' to be 'later'";

   my $key;
   my $w = AnyEvent->timer(
      after => 0,
      cb    => sub {
         delete $self->{watch_idle}{$key};
         goto &$code;
      },
   );

   $key = "$w";
   $self->{watch_idle}{$key} = $w;
   return $key;
}

sub unwatch_idle
{
   my $self = shift;
   my ( $id ) = @_;

   delete $self->{watch_idle}{$id};
}

sub watch_process
{
   my $self = shift;
   my ( $pid, $code ) = @_;

   $self->{watch_child}{$pid} = AnyEvent->child( pid => $pid, cb => $code );
}

sub unwatch_process
{
   my $self = shift;
   my ( $pid ) = @_;

   delete $self->{watch_child}{$pid};
}

=head1 BUGS

=over 4

=item *

C<watch_idle> and C<unwatch_idle> don't work properly against
C<AnyEvent::Impl::IOAsync>. At least, the unit tests fail, and some scheduled
CODErefs never get executed, and sit in the internal queue of the inner-nested
C<IO::Async::Loop> that C<AnyEvent::Impl::IOAsync> itself constructed. An easy
workaround here is simply to pick another AnyEvent model, by using the
C<PERL_ANYEVENT_MODEL> environment variable.

That all said, I am honestly surprised this is the only thing that breaks,
when C<IO::Async> is nested upon C<AnyEvent> itself running atop another
C<IO::Async>.

=item *

The implementation of the C<loop_once> method requires the use of an
undocumented C<AnyEvent> method (C<one_event> before version 6, C<_poll>
thereafter). This happens to work at the time of writing, but as it is
undocumented it may be subject to change.

The C<loop_forever> method does not rely on this undocumented method, so
should be safe from upstream changes. Furthremore, if C<AnyEvent> rather than
C<IO::Async> remains ultimately in control of the runtime, by waiting on
condvars, this should not be problematic.

=back

=cut

=head1 AUTHOR

Paul Evans <leonerd@leonerd.org.uk>

=cut

0x55AA;
