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

Revision:	1.4
Committed:	Sun Mar 19 20:56:59 2023 UTC (13 months, 4 weeks ago) by root
Branch:	MAIN
Changes since 1.3:	+16 -2 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	root	1.4	return 0 if $self->{fh};
57	root	1.1
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	root	1.4	(my $key = $reply->{args}[2]) =~ s/\\x(..)/chr hex $1/ge;
113			$self->on_key ($key);
114	root	1.3	}
115	root	1.1	} else {
116	root	1.3	$self->on_event ($reply);
117	root	1.1	}
118			} elsif (exists $reply->{request_id}) {
119			my $cv = delete $self->{cmd_cv}{$reply->{request_id}};
120
121			unless ($cv) {
122			warn "no cv found for request id <$reply->{request_id}>\n";
123			next;
124			}
125
126			if (exists $reply->{data}) {
127			$cv->send ($reply->{data});
128			} elsif ($reply->{error} eq "success") { # success means error... eh.. no...
129			$cv->send;
130			} else {
131			$cv->croak ($reply->{error});
132			}
133
134			} else {
135			warn "unexpected reply from mpv, pleasew report: <$1>\n";
136			}
137			};
138			warn $@ if $@;
139			} else {
140			$trace->("mpv>" => "$1");
141			}
142			}
143			} else {
144	root	1.2	$self->stop;
145	root	1.1	$self->on_eof;
146			}
147			};
148
149			$self->{_send} = sub {
150			$wbuf .= "$_[0]\n";
151
152			$trace->(">mpv" => "$_[0]");
153
154			$self->{ww} \|\|= AE::io $fh, 1, sub {
155			my $len = syswrite $fh, $wbuf;
156			substr $wbuf, 0, $len, "";
157			undef $self->{ww} unless length $wbuf;
158			};
159			};
160	root	1.4
161			1
162	root	1.1	}
163
164			sub on_eof {
165			my ($self) = @_;
166
167			$self->{on_eof}($self) if $self->{on_eof};
168			}
169
170			sub on_event {
171			my ($self, $key) = @_;
172
173			$self->{on_event}($self, $key) if $self->{on_event};
174			}
175
176	root	1.2	sub on_key {
177	root	1.1	my ($self, $key) = @_;
178
179	root	1.2	$self->{on_key}($self, $key) if $self->{on_key};
180	root	1.1	}
181
182			sub cmd {
183			my ($self, @cmd) = @_;
184
185			my $cv = AE::cv;
186
187			my $reqid = ++$self->{reqid};
188			$self->{cmd_cv}{$reqid} = $cv;
189
190			my $cmd = JSON::XS::encode_json { command => ref $cmd[0] ? $cmd[0] : \@cmd, request_id => $reqid*1 };
191
192			# (un-)apply escape_binary hack
193			$cmd =~ s/\xf4\x8e\x97\x9f(..)/sprintf sprintf "\\x%02x", hex $1/ges; # f48e979f == 10e5df in utf-8
194
195			$self->{_send}($cmd);
196
197			$cv
198			}
199
200	root	1.4	sub cmd_recv {
201			&cmd->recv
202			}
203
204			sub bind_key {
205			my ($self, $key, $event) = @_;
206
207			$event =~ s/([^A-Za-z0-9\-_])/sprintf "\\x%02x", ord $1/ge;
208			$self->cmd (keybind => $key => "no-osd script-message AnyEvent::MPV key $event");
209			}
210
211	root	1.1	sub stop {
212			my ($self) = @_;
213
214			if ($self->{pid}) {
215			delete $self->{rw};
216			delete $self->{ww};
217
218			close delete $self->{fh}; # current mpv versions should cleanup on their own on close
219
220			kill TERM => $self->{pid};
221
222			delete $self->{pid};
223			}
224			}
225
226			=head1 SEE ALSO
227
228			L<AnyEvent>.
229
230			=head1 AUTHOR
231
232			Marc Lehmann <schmorp@schmorp.de>
233			http://home.schmorp.de/
234
235			=cut
236
237			1
238