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