AnyEvent-MPV/MPV.pm

=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 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") {
                           $self->on_key ($reply->{args}[2]);
                        }
                     } 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;
      };
   };
}

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 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

Revision:	1.3
Committed:	Sun Mar 19 20:46:10 2023 UTC (13 months, 4 weeks ago) by root
Branch:	MAIN
Changes since 1.2:	+4 -3 lines
Log Message:	* empty log message *
#	User	Rev	Content
1	root	1.1	=head1 NAME
2
3			AnyEvent::MPV - remote control mpv (https://mpv.io)
4
5			=head1 SYNOPSIS
6
7			use AnyEvent::MPV;
8
9			=head1 DESCRIPTION
10
11			This module is an L<AnyEvent> user, you need to make sure that you use and
12			run a supported event loop.
13
14			=cut
15
16			package AnyEvent::MPV;
17
18			use common::sense;
19
20	root	1.2	use Fcntl ();
21			use Scalar::Util ();
22
23	root	1.1	use AnyEvent ();
24			use AnyEvent::Util ();
25
26			our $JSON = eval { require JSON::XS; JSON::XS:: }
27			\|\| do { require JSON::PP; JSON::PP:: };
28
29			our $VERSION = '0.1';
30
31			our $mpv_path; # last mpv path used
32			our $mpv_optionlist; # output of mpv --list-options
33
34			sub new {
35			my ($class, %kv) = @_;
36
37			bless {
38			mpv => "mpv",
39			args => [],
40			%kv,
41			}, $class
42			}
43
44			# can be used to escape filenames
45			sub escape_binary {
46			shift;
47			local $_ = shift;
48			# we escape every "illegal" octet using U+10e5df HEX. this is later undone in cmd
49			s/([\x00-\x1f\x80-\xff])/sprintf "\x{10e5df}%02x", ord $1/ge;
50			$_
51			}
52
53			sub start {
54			my ($self, @extra_args) = @_;
55
56			return if $self->{fh};
57
58			# cache optionlist for same "path"
59	root	1.2	($mpv_path, $mpv_optionlist) = ($self->{mpv}, scalar qx{\Q$self->{mpv}\E --list-options})
60	root	1.1	if $self->{mpv} ne $mpv_path;
61
62			my $options = $mpv_optionlist;
63
64			my ($fh, $slave) = AnyEvent::Util::portable_socketpair
65			or die "socketpair: $!\n";
66
67	root	1.2	AnyEvent::Util::fh_nonblocking $fh, 1;
68	root	1.1
69	root	1.2	$self->{pid} = fork;
70	root	1.1
71			if ($self->{pid} eq 0) {
72	root	1.2	AnyEvent::Util::fh_nonblocking $slave, 0;
73			fcntl $slave, Fcntl::F_SETFD, 0;
74
75	root	1.1	my $input_file = $options =~ /\s--input-ipc-client\s/ ? "input-ipc-client" : "input-file";
76
77			exec $self->{mpv},
78			qw(--no-input-terminal --idle=yes --pause),
79			($self->{trace} ? "--quiet" : "--really-quiet"),
80			"--$input_file=fd://" . (fileno $slave),
81			@{ $self->{args} },
82			@extra_args;
83			exit 1;
84			}
85
86			$self->{fh} = $fh;
87
88	root	1.2	my $trace = delete $self->{trace} \|\| sub { };
89	root	1.1
90			$trace = sub { warn "$_[0] $_[1]\n" } if $trace && !ref $trace;
91
92			my $buf;
93			my $wbuf;
94	root	1.2
95			Scalar::Util::weaken $self;
96	root	1.1
97			$self->{rw} = AE::io $fh, 0, sub {
98			if (sysread $fh, $buf, 8192, length $buf) {
99			while ($buf =~ s/^([^\n]+)\n//) {
100			$trace->("mpv>" => "$1");
101
102			if ("{" eq substr $1, 0, 1) {
103			eval {
104			my $reply = JSON::XS->new->latin1->decode ($1);
105
106			if (exists $reply->{event}) {
107			if (
108			$reply->{event} eq "client-message"
109			and $reply->{args}[0] eq "AnyEvent::MPV"
110			) {
111	root	1.3	if ($reply->{args}[1] eq "key") {
112			$self->on_key ($reply->{args}[2]);
113			}
114	root	1.1	} else {
115	root	1.3	$self->on_event ($reply);
116	root	1.1	}
117			} elsif (exists $reply->{request_id}) {
118			my $cv = delete $self->{cmd_cv}{$reply->{request_id}};
119
120			unless ($cv) {
121			warn "no cv found for request id <$reply->{request_id}>\n";
122			next;
123			}
124
125			if (exists $reply->{data}) {
126			$cv->send ($reply->{data});
127			} elsif ($reply->{error} eq "success") { # success means error... eh.. no...
128			$cv->send;
129			} else {
130			$cv->croak ($reply->{error});
131			}
132
133			} else {
134			warn "unexpected reply from mpv, pleasew report: <$1>\n";
135			}
136			};
137			warn $@ if $@;
138			} else {
139			$trace->("mpv>" => "$1");
140			}
141			}
142			} else {
143	root	1.2	$self->stop;
144	root	1.1	$self->on_eof;
145			}
146			};
147
148			$self->{_send} = sub {
149			$wbuf .= "$_[0]\n";
150
151			$trace->(">mpv" => "$_[0]");
152
153			$self->{ww} \|\|= AE::io $fh, 1, sub {
154			my $len = syswrite $fh, $wbuf;
155			substr $wbuf, 0, $len, "";
156			undef $self->{ww} unless length $wbuf;
157			};
158			};
159			}
160
161			sub on_eof {
162			my ($self) = @_;
163
164			$self->{on_eof}($self) if $self->{on_eof};
165			}
166
167			sub on_event {
168			my ($self, $key) = @_;
169
170			$self->{on_event}($self, $key) if $self->{on_event};
171			}
172
173	root	1.2	sub on_key {
174	root	1.1	my ($self, $key) = @_;
175
176	root	1.2	$self->{on_key}($self, $key) if $self->{on_key};
177	root	1.1	}
178
179			sub cmd {
180			my ($self, @cmd) = @_;
181
182			my $cv = AE::cv;
183
184			my $reqid = ++$self->{reqid};
185			$self->{cmd_cv}{$reqid} = $cv;
186
187			my $cmd = JSON::XS::encode_json { command => ref $cmd[0] ? $cmd[0] : \@cmd, request_id => $reqid*1 };
188
189			# (un-)apply escape_binary hack
190			$cmd =~ s/\xf4\x8e\x97\x9f(..)/sprintf sprintf "\\x%02x", hex $1/ges; # f48e979f == 10e5df in utf-8
191
192			$self->{_send}($cmd);
193
194			$cv
195			}
196
197			sub stop {
198			my ($self) = @_;
199
200			if ($self->{pid}) {
201			delete $self->{rw};
202			delete $self->{ww};
203
204			close delete $self->{fh}; # current mpv versions should cleanup on their own on close
205
206			kill TERM => $self->{pid};
207
208			delete $self->{pid};
209			}
210			}
211
212			=head1 SEE ALSO
213
214			L<AnyEvent>.
215
216			=head1 AUTHOR
217
218			Marc Lehmann <schmorp@schmorp.de>
219			http://home.schmorp.de/
220
221			=cut
222
223			1
224