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 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}, qx{\Q$self->{$mpv_path}\E --list-options})
      if $self->{mpv} ne $mpv_path;

   my $options = $mpv_optionlist;

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

   fh_nonblocking $fh   , 1;
   fh_nonblocking $slave, 0;

   my $self->{pid} = fork;

   if ($self->{pid} eq 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 = $self->{trace} || sub { };

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

   my $buf;
   my $rw;
   my $ww;
   my $wbuf;
   my $reqid;

   $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"
                        and $reply->{args}[1] eq "keyhack"
                     ) {
                        $self->on_key_event ($reply->{args}[2]);
                     } else {
                        $self->on_event ($reply->{event});
                     }
                  } 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->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_event {
   my ($self, $key) = @_;

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

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