=head1 NAME

AnyEvent::MPV - remote control mpv (https://mpv.io)

=head1 SYNOPSIS

   use AnyEvent::MPV;

=head1 DESCRIPTION

This module is an L<AnyEvent> user, you need to make sure that you use and
run a supported event loop.

=cut

package AnyEvent::MPV;

use common::sense;

use Fcntl ();
use Scalar::Util ();

use AnyEvent ();
use AnyEvent::Util ();

our $JSON = eval { require JSON::XS; JSON::XS:: }
          || do  { require JSON::PP; JSON::PP:: };

our $VERSION = '0.1';

our $mpv_path; # last mpv path used
our $mpv_optionlist; # output of mpv --list-options

sub new {
   my ($class, %kv) = @_;

   bless {
      mpv     => "mpv",
      args    => [],
      %kv,
   }, $class
}

# can be used to escape filenames
sub escape_binary {
   shift;
   local $_ = shift;
   # we escape every "illegal" octet using U+10e5df HEX. this is later undone in cmd
   s/([\x00-\x1f\x80-\xff])/sprintf "\x{10e5df}%02x", ord $1/ge;
   $_
}

sub start {
   my ($self, @extra_args) = @_;

   return 0 if $self->{fh};

   # cache optionlist for same "path"
   ($mpv_path, $mpv_optionlist) = ($self->{mpv}, scalar qx{\Q$self->{mpv}\E --list-options})
      if $self->{mpv} ne $mpv_path;

   my $options = $mpv_optionlist;

   my ($fh, $slave) = AnyEvent::Util::portable_socketpair
      or die "socketpair: $!\n";

   AnyEvent::Util::fh_nonblocking $fh, 1;

   $self->{pid} = fork;

   if ($self->{pid} eq 0) {
      AnyEvent::Util::fh_nonblocking $slave, 0;
      fcntl $slave, Fcntl::F_SETFD, 0;

      my $input_file = $options =~ /\s--input-ipc-client\s/ ? "input-ipc-client" : "input-file";

      exec $self->{mpv},
           qw(--no-input-terminal --idle=yes --pause),
           ($self->{trace} ? "--quiet" : "--really-quiet"),
           "--$input_file=fd://" . (fileno $slave),
           @{ $self->{args} },
           @extra_args;
      exit 1;
   }

   $self->{fh} = $fh;

   my $trace = delete $self->{trace} || sub { };

   $trace = sub { warn "$_[0] $_[1]\n" } if $trace && !ref $trace;

   my $buf;
   my $wbuf;

   Scalar::Util::weaken $self;

   $self->{rw} = AE::io $fh, 0, sub {
      if (sysread $fh, $buf, 8192, length $buf) {
         while ($buf =~ s/^([^\n]+)\n//) {
            $trace->("mpv>" => "$1");

            if ("{" eq substr $1, 0, 1) {
               eval {
                  my $reply = JSON::XS->new->latin1->decode ($1);

                  if (exists $reply->{event}) {
                     if (
                        $reply->{event} eq "client-message"
                        and $reply->{args}[0] eq "AnyEvent::MPV"
                     ) {
                        if ($reply->{args}[1] eq "key") {
                           (my $key = $reply->{args}[2]) =~ s/\\x(..)/chr hex $1/ge;
                           $self->on_key ($key);
                        }
                     } else {
                        $self->on_event ($reply);
                     }
                  } elsif (exists $reply->{request_id}) {
                     my $cv = delete $self->{cmd_cv}{$reply->{request_id}};

                     unless ($cv) {
                        warn "no cv found for request id <$reply->{request_id}>\n";
                        next;
                     }

                     if (exists $reply->{data}) {
                        $cv->send ($reply->{data});
                     } elsif ($reply->{error} eq "success") { # success means error... eh.. no...
                        $cv->send;
                     } else {
                        $cv->croak ($reply->{error});
                     }

                  } else {
                     warn "unexpected reply from mpv, pleasew report: <$1>\n";
                  }
               };
               warn $@ if $@;
            } else {
               $trace->("mpv>" => "$1");
            }
         }
      } else {
         $self->stop;
         $self->on_eof;
      }
   };

   $self->{_send} = sub {
      $wbuf .= "$_[0]\n";

      $trace->(">mpv" => "$_[0]");

      $self->{ww} ||= AE::io $fh, 1, sub {
         my $len = syswrite $fh, $wbuf;
         substr $wbuf, 0, $len, "";
         undef $self->{ww} unless length $wbuf;
      };
   };

   1
}

sub on_eof {
   my ($self) = @_;

   $self->{on_eof}($self) if $self->{on_eof};
}

sub on_event {
   my ($self, $key) = @_;

   $self->{on_event}($self, $key) if $self->{on_event};
}

sub on_key {
   my ($self, $key) = @_;

   $self->{on_key}($self, $key) if $self->{on_key};
}

sub cmd {
   my ($self, @cmd) = @_;

   my $cv = AE::cv;

   my $reqid = ++$self->{reqid};
   $self->{cmd_cv}{$reqid} = $cv;

   my $cmd = JSON::XS::encode_json { command => ref $cmd[0] ? $cmd[0] : \@cmd, request_id => $reqid*1 };

   # (un-)apply escape_binary hack
   $cmd =~ s/\xf4\x8e\x97\x9f(..)/sprintf sprintf "\\x%02x", hex $1/ges; # f48e979f == 10e5df in utf-8

   $self->{_send}($cmd);

   $cv
}

sub cmd_recv {
   &cmd->recv
}

sub bind_key {
   my ($self, $key, $event) = @_;

   $event =~ s/([^A-Za-z0-9\-_])/sprintf "\\x%02x", ord $1/ge;
   $self->cmd (keybind => $key => "no-osd script-message AnyEvent::MPV key $event");
}

sub stop {
   my ($self) = @_;

   if ($self->{pid}) {
      delete $self->{rw};
      delete $self->{ww};

      close delete $self->{fh}; # current mpv versions should cleanup on their own on close

      kill TERM => $self->{pid};

      delete $self->{pid};
   }
}

=head1 SEE ALSO

L<AnyEvent>.

=head1 AUTHOR

 Marc Lehmann <schmorp@schmorp.de>
 http://home.schmorp.de/

=cut

1