--- AnyEvent-MPV/MPV.pm 2023/03/19 20:30:48 1.2 +++ AnyEvent-MPV/MPV.pm 2024/05/26 01:53:22 1.21 @@ -6,10 +6,210 @@ use AnyEvent::MPV; + my $videofile = "path/to/file.mkv"; + use AnyEvent; + my $mpv = AnyEvent::MPV->new (trace => 1); + $mpv->start ("--idle=yes"); + $mpv->cmd (loadfile => $mpv->escape_binary ($videofile)); + my $quit = AE::cv; + $mpv->register_event (end_file => $quit); + $quit->recv; + + =head1 DESCRIPTION -This module is an L user, you need to make sure that you use and -run a supported event loop. +This module allows you to remote control F (a video player). It also +is an L user, you need to make sure that you use and run a +supported event loop. + +There are other modules doing this, and I haven't looked much at them +other than to decide that they don't handle encodings correctly, and since +none of them use AnyEvent, I wrote my own. When in doubt, have a look at +them, too. + +Knowledge of the L is required to +use this module. + +Features of this module are: + +=over + +=item uses AnyEvent, so integrates well into most event-based programs + +=item supports asynchronous and synchronous operation + +=item allows you to properly pass binary filenames + +=item accepts data encoded in any way (does not crash when mpv replies with non UTF-8 data) + +=item features a simple keybind/event system + +=back + +=head2 OVERVIEW OF OPERATION + +This module forks an F process and uses F<--input-ipc-client> (or +equivalent) to create a bidirectional communication channel between it and +the F process. + +It then speaks the somewhat JSON-looking (but not really being JSON) +protocol that F implements to both send it commands, decode and +handle replies, and handle asynchronous events. + +Here is a very simple client: + + use AnyEvent; + use AnyEvent::MPV; + + my $videofile = "./xyzzy.mkv"; + + my $mpv = AnyEvent::MPV->new (trace => 1); + + $mpv->start ("--", $videofile); + + my $timer = AE::timer 2, 0, my $quit = AE::cv; + $quit->recv; + +This starts F with the two arguments C<--> and C<$videofile>, which +it should load and play. It then waits two seconds by starting a timer and +quits. The C argument to the constructor makes F more verbose +and also prints the commands and responses, so you can have an idea what +is going on. + +In my case, the above example would output something like this: + + [uosc] Disabled because original osc is enabled! + mpv> {"event":"start-file","playlist_entry_id":1} + mpv> {"event":"tracks-changed"} + (+) Video --vid=1 (*) (h264 480x480 30.000fps) + mpv> {"event":"metadata-update"} + mpv> {"event":"file-loaded"} + Using hardware decoding (nvdec). + mpv> {"event":"video-reconfig"} + VO: [gpu] 480x480 cuda[nv12] + mpv> {"event":"video-reconfig"} + mpv> {"event":"playback-restart"} + +This is not usually very useful (you could just run F as a simple +shell command), so let us load the file at runtime: + + use AnyEvent; + use AnyEvent::MPV; + + my $videofile = "./xyzzy.mkv"; + + my $mpv = AnyEvent::MPV->new ( + trace => 1, + args => ["--pause", "--idle=yes"], + ); + + $mpv->start; + $mpv->cmd_recv (loadfile => $mpv->escape_binary ($videofile)); + $mpv->cmd ("set", "pause", "no"); + + my $timer = AE::timer 2, 0, my $quit = AE::cv; + $quit->recv; + +This specifies extra arguments in the constructor - these arguments are +used every time you C<< ->start >> F, while the arguments to C<< +->start >> are only used for this specific clal to0 C. The argument +F<--pause> keeps F in pause mode (i.e. it does not play the file +after loading it), and C<--idle=yes> tells F to not quit when it does +not have a playlist - as no files are specified on the command line. + +To load a file, we then send it a C command, which accepts, as +first argument, the URL or path to a video file. To make sure F does +not misinterpret the path as a URL, it was prefixed with F<./> (similarly +to "protecting" paths in perls C). + +Since commands send I F are send in UTF-8, we need to escape the +filename (which might be in any encoding) using the C +method - this is not needed if your filenames are just ascii, or magically +get interpreted correctly, but if you accept arbitrary filenamews (e.g. +from the user), you need to do this. + +The C method then queues the command, waits for a reply and +returns the reply data (or croaks on error). F would, at this point, +load the file and, if everything was successful, show the first frame and +pause. Note that, since F is implement rather synchronously itself, +do not expect commands to fail in many circumstances - for example, fit +he file does not exit, you will likely get an event, but the C +command itself will run successfully. + +To unpause, we send another command, C, to set the C property +to C, this time using the C method, which queues the command, but +instead of waiting for a reply, it immediately returns a condvar that cna +be used to receive results. + +This should then cause F to start playing the video. + +It then again waits two seconds and quits. + +Now, just waiting two seconds is rather, eh, unuseful, so let's look at +receiving events (using a somewhat embellished example): + + use AnyEvent; + use AnyEvent::MPV; + + my $videofile = "xyzzy.mkv"; + + my $quit = AE::cv; + + my $mpv = AnyEvent::MPV->new ( + trace => 1, + args => ["--pause", "--idle=yes"], + ); + + $mpv->start; + + $mpv->register_event (start_file => sub { + $mpv->cmd ("set", "pause", "no"); + }); + + $mpv->register_event (end_file => sub { + my ($mpv, $event, $data) = @_; + + print "end-file<$data->{reason}>\n"; + $quit->send; + }); + + $mpv->cmd (loadfile => $mpv->escape_binary ($videofile)); + + $quit->recv; + +This example uses a global condvar C<$quit> to wait for the file to finish +playing. Also, most of the logic is now implement in event handlers. + +The two events handlers we register are C, which is emitted by +F once it has loaded a new file, and C, which signals the +end of a file (underscores are internally replaced by minus signs, so you +cna speicfy event names with either). + +In the C event, we again set the C property to C +so the movie starts playing. For the C event, we tell the main +program to quit by invoking C<$quit>. + +This should conclude the basics of operation. There are a few more +examples later in the documentation. + +=head2 ENCODING CONVENTIONS + +As a rule of thumb, all data you pass to this module to be sent to F +is expected to be in unicode. To pass something that isn't, you need to +escape it using C. + +Data received from F, however, is I decoded to unicode, as data +returned by F is not generally encoded in unicode, and the encoding +is usually unspecified. So if you receive data and expect it to be in +unicode, you need to first decode it from UTF-8, but note that this might +fail. This is not a limitation of this module - F simply does not +specify nor guarantee a specific encoding, or any encoding at all, in its +protocol. + +=head2 METHODS + +=over =cut @@ -23,14 +223,68 @@ use AnyEvent (); use AnyEvent::Util (); +our $VERSION = '1.04'; + +sub OBSID() { 2**52 } + our $JSON = eval { require JSON::XS; JSON::XS:: } || do { require JSON::PP; JSON::PP:: }; -our $VERSION = '0.1'; +our $JSON_ENCODER = $JSON->new->utf8; +our $JSON_DECODER = $JSON->new->latin1; our $mpv_path; # last mpv path used our $mpv_optionlist; # output of mpv --list-options +=item $mpv = AnyEvent::MPV->new (key => value...) + +Creates a new C object, but does not yet do anything. The support key-value pairs are: + +=over + +=item mpv => $path + +The path to the F binary to use - by default, C is used and +therefore, uses your C to find it. + +=item args => [...] + +Arguments to pass to F. These arguments are passed after the +hardcoded arguments used by this module, but before the arguments passed +ot C. It does not matter whether you specify your arguments using +this key, or in the C call, but when you invoke F multiple +times, typically the arguments used for all invocations go here, while +arguments used for specific invocations (e..g filenames) are passed to +C. + +=item trace => false|true|coderef + +Enables tracing if true. In trace mode, output from F is printed to +standard error using a C<< mpv> >> prefix, and commands sent to F +are printed with a C<< >mpv >> prefix. + +If a code reference is passed, then instead of printing to standard +errort, this coderef is invoked with a first arfgument being either +C<< mpv> >> or C<< >mpv >>, and the second argument being a string to +display. The default implementation simply does this: + + sub { + warn "$_[0] $_[1]\n"; + } + +=item on_eof => $coderef->($mpv) + +=item on_event => $coderef->($mpv, $event, $data) + +=item on_key => $coderef->($mpv, $string) + +These are invoked by the default method implementation of the same name - +see below. + +=back + +=cut + sub new { my ($class, %kv) = @_; @@ -41,6 +295,18 @@ }, $class } +=item $string = $mpv->escape_binary ($string) + +This module excects all command data sent to F to be in unicode. Some +things are not, such as filenames. To pass binary data such as filenames +through a comamnd, you need to escape it using this method. + +The simplest example is a C command: + + $mpv->cmd_recv (loadfile => $mpv->escape_binary ($path)); + +=cut + # can be used to escape filenames sub escape_binary { shift; @@ -50,10 +316,57 @@ $_ } +=item $started = $mpv->start (argument...) + +Starts F, passing the given arguemnts as extra arguments to +F. If F is already running, it returns false, otherwise it +returns a true value, so you can easily start F on demand by calling +C just before using it, and if it is already running, it will not +be started again. + +The arguments passwd to F are a set of hardcoded built-in arguments, +followed by the arguments specified in the constructor, followed by the +arguments passwd to this method. The built-in arguments currently are +F<--no-input-terminal>, F<--really-quiet> (or F<--quiet> in C +mode), and C<--input-ipc-client> (or equivalent). + +Some commonly used and/or even useful arguments you might want to pass are: + +=over + +=item F<--idle=yes> or F<--idle=once> to keep F from quitting when you +don't specify a file to play. + +=item F<--pause>, to keep F from instantly starting to play a file, in case you want to +inspect/change properties first. + +=item F<--force-window=no> (or similar), to keep F from instantly opening a window, or to force it to do so. + +=item F<--audio-client-name=yourappname>, to make sure audio streams are associated witht eh right program. + +=item F<--wid=id>, to embed F into another application. + +=item F<--no-terminal>, F<--no-input-default-bindings>, F<--no-input-cursor>, F<--input-conf=/dev/null>, F<--input-vo-keyboard=no> - to ensure only you control input. + +=back + +The return value can be used to decide whether F needs initializing: + + if ($mpv->start) { + $mpv->bind_key (...); + $mpv->cmd (set => property => value); + ... + } + +You can immediately starting sending commands when this method returns, +even if F has not yet started. + +=cut + sub start { my ($self, @extra_args) = @_; - return if $self->{fh}; + return 0 if $self->{fh}; # cache optionlist for same "path" ($mpv_path, $mpv_optionlist) = ($self->{mpv}, scalar qx{\Q$self->{mpv}\E --list-options}) @@ -75,7 +388,7 @@ my $input_file = $options =~ /\s--input-ipc-client\s/ ? "input-ipc-client" : "input-file"; exec $self->{mpv}, - qw(--no-input-terminal --idle=yes --pause), + qw(--no-input-terminal), ($self->{trace} ? "--quiet" : "--really-quiet"), "--$input_file=fd://" . (fileno $slave), @{ $self->{args} }, @@ -85,12 +398,11 @@ $self->{fh} = $fh; - my $trace = delete $self->{trace} || sub { }; + my $trace = $self->{trace} || sub { }; $trace = sub { warn "$_[0] $_[1]\n" } if $trace && !ref $trace; my $buf; - my $wbuf; Scalar::Util::weaken $self; @@ -101,20 +413,37 @@ if ("{" eq substr $1, 0, 1) { eval { - my $reply = JSON::XS->new->latin1->decode ($1); + my $reply = $JSON_DECODER->decode ($1); - if (exists $reply->{event}) { + if (defined (my $event = delete $reply->{event})) { if ( - $reply->{event} eq "client-message" + $event eq "client-message" and $reply->{args}[0] eq "AnyEvent::MPV" - and $reply->{args}[1] eq "keyhack" ) { - $self->on_key ($reply->{args}[2]); + if ($reply->{args}[1] eq "key") { + (my $key = $reply->{args}[2]) =~ s/\\x(..)/chr hex $1/ge; + $self->on_key ($key); + } + } elsif ( + $event eq "property-change" + and OBSID <= $reply->{id} + ) { + if (my $cb = $self->{obscb}{$reply->{id}}) { + $cb->($self, $event, $reply->{data}); + } } else { - $self->on_event ($reply->{event}); + if (my $cbs = $self->{evtcb}{$event}) { + for my $evtid (keys %$cbs) { + my $cb = $cbs->{$evtid} + or next; + $cb->($self, $event, $reply); + } + } + + $self->on_event ($event, $reply); } } elsif (exists $reply->{request_id}) { - my $cv = delete $self->{cmd_cv}{$reply->{request_id}}; + my $cv = delete $self->{cmdcv}{$reply->{request_id}}; unless ($cv) { warn "no cv found for request id <$reply->{request_id}>\n"; @@ -144,73 +473,852 @@ } }; - $self->{_send} = sub { - $wbuf .= "$_[0]\n"; + my $wbuf; + my $reqid; + + $self->{_cmd} = sub { + my $cv = AE::cv; + + $self->{cmdcv}{++$reqid} = $cv; - $trace->(">mpv" => "$_[0]"); + my $cmd = $JSON_ENCODER->encode ({ command => ref $_[0] ? $_[0] : \@_, request_id => $reqid*1 }); - $self->{ww} ||= AE::io $fh, 1, sub { + # (un-)apply escape_binary hack + $cmd =~ s/\xf4\x8e\x97\x9f(..)/sprintf sprintf "\\x%02x", hex $1/ges; # f48e979f == 10e5df in utf-8 + + $trace->(">mpv" => $cmd); + + $wbuf .= "$cmd\n"; + + my $wcb = sub { my $len = syswrite $fh, $wbuf; substr $wbuf, 0, $len, ""; undef $self->{ww} unless length $wbuf; }; + + $wcb->(); + $self->{ww} ||= AE::io $fh, 1, $wcb if length $wbuf; + + $cv }; + + 1 +} + +sub DESTROY { + $_[0]->stop; } +=item $mpv->stop + +Ensures that F is being stopped, by killing F with a C +signal if needed. After this, you can C<< ->start >> a new instance again. + +=cut + +sub stop { + my ($self) = @_; + + delete $self->{rw}; + delete $self->{ww}; + + if ($self->{pid}) { + + close delete $self->{fh}; # current mpv versions should cleanup on their own on close + + # clean up zombies, or die trying + my $cw; $cw = AE::child $self->{pid}, sub { undef $cw }; + + kill TERM => $self->{pid}; + + } + + delete $self->{pid}; + delete $self->{cmdcv}; + delete $self->{evtid}; + delete $self->{evtcb}; + delete $self->{obsid}; + delete $self->{obscb}; + delete $self->{wbuf}; +} + +=item $mpv->on_eof + +This method is called when F quits - usually unexpectedly. The +default implementation will call the C code reference specified in +the constructor, or do nothing if none was given. + +For subclassing, see I, below. + +=cut + sub on_eof { my ($self) = @_; $self->{on_eof}($self) if $self->{on_eof}; } +=item $mpv->on_event ($event, $data) + +This method is called when F sends an asynchronous event. The default +implementation will call the C code reference specified in the +constructor, or do nothing if none was given. + +The first/implicit argument is the C<$mpv> object, the second is the +event name (same as C<< $data->{event} >>, purely for convenience), and +the third argument is the event object as sent by F (sans C +key). See L +in its documentation. + +For subclassing, see I, below. + +=cut + sub on_event { - my ($self, $key) = @_; + my ($self, $event, $data) = @_; - $self->{on_event}($self, $key) if $self->{on_event}; + $self->{on_event}($self, $event, $data) if $self->{on_event}; } +=item $mpv->on_key ($string) + +Invoked when a key declared by C<< ->bind_key >> is pressed. The default +invokes the C code reference specified in the constructor with the +C<$mpv> object and the key name as arguments, or do nothing if none was +given. + +For more details and examples, see the C method. + +For subclassing, see I, below. + +=cut + sub on_key { my ($self, $key) = @_; $self->{on_key}($self, $key) if $self->{on_key}; } +=item $mpv->cmd ($command => $arg, $arg...) + +Queues a command to be sent to F, using the given arguments, and +immediately return a condvar. + +See L for +details on individual commands. + +The condvar can be ignored: + + $mpv->cmd (set_property => "deinterlace", "yes"); + +Or it can be used to synchronously wait for the command results: + + $cv = $mpv->cmd (get_property => "video-format"); + $format = $cv->recv; + + # or simpler: + + $format = $mpv->cmd (get_property => "video-format")->recv; + + # or even simpler: + + $format = $mpv->cmd_recv (get_property => "video-format"); + +Or you can set a callback: + + $cv = $mpv->cmd (get_property => "video-format"); + $cv->cb (sub { + my $format = $_[0]->recv; + }); + +On error, the condvar will croak when C is called. + +=cut + sub cmd { - my ($self, @cmd) = @_; + my $self = shift; - my $cv = AE::cv; + $self->{_cmd}->(@_) +} - my $reqid = ++$self->{reqid}; - $self->{cmd_cv}{$reqid} = $cv; +=item $result = $mpv->cmd_recv ($command => $arg, $arg...) - my $cmd = JSON::XS::encode_json { command => ref $cmd[0] ? $cmd[0] : \@cmd, request_id => $reqid*1 }; +The same as calling C and immediately C on its return +value. Useful when you don't want to mess with F asynchronously or +simply needs to have the result: - # (un-)apply escape_binary hack - $cmd =~ s/\xf4\x8e\x97\x9f(..)/sprintf sprintf "\\x%02x", hex $1/ges; # f48e979f == 10e5df in utf-8 + $mpv->cmd_recv ("stop"); + $position = $mpv->cmd_recv ("get_property", "playback-time"); - $self->{_send}($cmd); +=cut - $cv +sub cmd_recv { + &cmd->recv } -sub stop { - my ($self) = @_; +=item $mpv->bind_key ($INPUT => $string) - if ($self->{pid}) { - delete $self->{rw}; - delete $self->{ww}; +This is an extension implement by this module to make it easy to get key +events. The way this is implemented is to bind a C witha +first argument of C and the C<$string> you passed. This +C<$string> is then passed to the C handle when the key is +proessed, e.g.: + + my $mpv = AnyEvent::MPV->new ( + on_key => sub { + my ($mpv, $key) = @_; - close delete $self->{fh}; # current mpv versions should cleanup on their own on close + if ($key eq "letmeout") { + print "user pressed escape\n"; + } + }, + ); - kill TERM => $self->{pid}; + $mpv_>bind_key (ESC => "letmeout"); + +You cna find a list of key names L. + +The key configuration is lost when F is stopped and must be (re-)done +after every C. + +=cut + +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"); +} + +=item [$guard] = $mpv->register_event ($event => $coderef->($mpv, $event, $data)) + +This method registers a callback to be invoked for a specific +event. Whenever the event occurs, it calls the coderef with the C<$mpv> +object, the C<$event> name and the event object, just like the C +method. + +For a lst of events, see L. Any +underscore in the event name is replaced by a minus sign, so you can +specify event names using underscores for easier quoting in Perl. + +In void context, the handler stays registered until C is called. In +any other context, it returns a guard object that, when destroyed, will +unregister the handler. + +You can register multiple handlers for the same event, and this method +does not interfere with the C mechanism. That is, you can +completely ignore this method and handle events in a C handler, +or mix both approaches as you see fit. + +Note that unlike commands, event handlers are registered immediately, that +is, you can issue a command, then register an event handler and then get +an event for this handler I the command is even sent to F. If +this kind of race is an issue, you can issue a dummy command such as +C and register the handler when the reply is received. + +=cut - delete $self->{pid}; +sub AnyEvent::MPV::Unevent::DESTROY { + my ($evtcb, $event, $evtid) = @{$_[0]}; + delete $evtcb->{$event}{$evtid}; +} + +sub register_event { + my ($self, $event, $cb) = @_; + + $event =~ y/_/-/; + + my $evtid = ++$self->{evtid}; + $self->{evtcb}{$event}{$evtid} = $cb; + + defined wantarray + and bless [$self->{evtcb}, $event, $evtid], AnyEvent::MPV::Unevent:: +} + +=item [$guard] = $mpv->observe_property ($name => $coderef->($mpv, $name, $value)) + +=item [$guard] = $mpv->observe_property_string ($name => $coderef->($mpv, $name, $value)) + +These methods wrap a registry system around F's C +and C commands - every time the named property +changes, the coderef is invoked with the C<$mpv> object, the name of the +property and the new value. + +For a list of properties that you can observe, see L. + +Due to the (sane :) way F handles these requests, you will always +get a property cxhange event right after registering an observer (meaning +you don't have to query the current value), and it is also possible to +register multiple observers for the same property - they will all be +handled properly. + +When called in void context, the observer stays in place until F +is stopped. In any otrher context, these methods return a guard +object that, when it goes out of scope, unregisters the observe using +C. + +Internally, this method uses observer ids of 2**52 (0x10000000000000) or +higher - it will not interfere with lower ovserver ids, so it is possible +to completely ignore this system and execute C commands +yourself, whilst listening to C events - as long as your +ids stay below 2**52. + +Example: register observers for changtes in C and C. Note that +a dummy statement is added to make sure the method is called in void +context. + + sub register_observers { + my ($mpv) = @_; + + $mpv->observe_property (aid => sub { + my ($mpv, $name, $value) = @_; + print "property aid (=$name) has changed to $value\n"; + }); + + $mpv->observe_property (sid => sub { + my ($mpv, $name, $value) = @_; + print "property sid (=$name) has changed to $value\n"; + }); + + () # ensure the above method is called in void context + } + +=cut + +sub AnyEvent::MPV::Unobserve::DESTROY { + my ($mpv, $obscb, $obsid) = @{$_[0]}; + + delete $obscb->{$obsid}; + + if ($obscb == $mpv->{obscb}) { + $mpv->cmd (unobserve_property => $obsid+0); } } +sub _observe_property { + my ($self, $type, $property, $cb) = @_; + + my $obsid = OBSID + ++$self->{obsid}; + $self->cmd ($type => $obsid+0, $property); + $self->{obscb}{$obsid} = $cb; + + defined wantarray and do { + my $unobserve = bless [$self, $self->{obscb}, $obsid], AnyEvent::MPV::Unobserve::; + Scalar::Util::weaken $unobserve->[0]; + $unobserve + } +} + +sub observe_property { + my ($self, $property, $cb) = @_; + + $self->_observe_property (observe_property => $property, $cb) +} + +sub observe_property_string { + my ($self, $property, $cb) = @_; + + $self->_observe_property (observe_property_string => $property, $cb) +} + +=back + +=head2 SUBCLASSING + +Like most perl objects, C objects are implemented as +hashes, with the constructor simply storing all passed key-value pairs in +the object. If you want to subclass to provide your own C methods, +be my guest and rummage around in the internals as much as you wish - the +only guarantee that this module dcoes is that it will not use keys with +double colons in the name, so youc an use those, or chose to simply not +care and deal with the breakage. + +If you don't want to go to the effort of subclassing this module, you can +also specify all event handlers as constructor keys. + +=head1 EXAMPLES + +Here are some real-world code snippets, thrown in here mainly to give you +some example code to copy. + +=head2 doomfrontend + +At one point I replaced mythtv-frontend by my own terminal-based video +player (based on rxvt-unicode). I toyed with the diea of using F's +subtitle engine to create the user interface, but that is hard to use +since you don't know how big your letters are. It is also where most of +this modules code has originally been developed in. + +It uses a unified input queue to handle various remote controls, so its +event handling needs are very simple - it simply feeds all events into the +input queue: + + my $mpv = AnyEvent::MPV->new ( + mpv => $MPV, + args => \@MPV_ARGS, + on_event => sub { + input_feed "mpv/$_[1]", $_[2]; + }, + on_key => sub { + input_feed $_[1]; + }, + on_eof => sub { + input_feed "mpv/quit"; + }, + ); + + ... + + $mpv->start ("--idle=yes", "--pause", "--force-window=no"); + +It also doesn't use complicated command line arguments - the file search +options have the most impact, as they prevent F from scanning +directories with tens of thousands of files for subtitles and more: + + --audio-client-name=doomfrontend + --osd-on-seek=msg-bar --osd-bar-align-y=-0.85 --osd-bar-w=95 + --sub-auto=exact --audio-file-auto=exact + +Since it runs on a TV without a desktop environemnt, it tries to keep complications such as dbus +away and the screensaver happy: + + # prevent xscreensaver from doing something stupid, such as starting dbus + $ENV{DBUS_SESSION_BUS_ADDRESS} = "/"; # prevent dbus autostart for sure + $ENV{XDG_CURRENT_DESKTOP} = "generic"; + +It does bind a number of keys to internal (to doomfrontend) commands: + + for ( + List::Util::pairs qw( + ESC return + q return + ENTER enter + SPACE pause + [ steprev + ] stepfwd + j subtitle + BS red + i green + o yellow + b blue + D triangle + UP up + DOWN down + RIGHT right + LEFT left + ), + (map { ("KP$_" => "num$_") } 0..9), + KP_INS => 0, # KP0, but different + ) { + $mpv->bind_key ($_->[0] => $_->[1]); + } + +It also reacts to sponsorblock chapters, so it needs to know when vidoe +chapters change. Preadting C, it handles observers +manually: + + $mpv->cmd (observe_property => 1, "chapter-metadata"); + +It also tries to apply an F profile, if it exists: + + eval { + # the profile is optional + $mpv->cmd ("apply-profile" => "doomfrontend"); + }; + +Most of the complicated parts deal with saving and restoring per-video +data, such as bookmarks, playing position, selected audio and subtitle +tracks and so on. However, since it uses L, it can conveniently +block and wait for replies, which is n ot possible in purely event based +programs, as you are not allowed to block inside event callbacks in most +event loops. This simplifies the code quite a bit. + +When the file to be played is a Tv recording done by mythtv, it uses the +C protocol and deinterlacing: + + if (is_myth $mpv_path) { + $mpv_path = "appending://$mpv_path"; + $initial_deinterlace = 1; + } + +Otherwise, it sets some defaults and loads the file (I forgot what the +C argument is for, but I am sure it is needed by some F +version): + + $mpv->cmd ("script-message", "osc-visibility", "never", "dummy"); + $mpv->cmd ("set", "vid", "auto"); + $mpv->cmd ("set", "aid", "auto"); + $mpv->cmd ("set", "sid", "no"); + $mpv->cmd ("set", "file-local-options/chapters-file", $mpv->escape_binary ("$mpv_path.chapters")); + $mpv->cmd ("loadfile", $mpv->escape_binary ($mpv_path)); + $mpv->cmd ("script-message", "osc-visibility", "auto", "dummy"); + +Handling events makes the main bulk of video playback code. For example, +various ways of ending playback: + + if ($INPUT eq "mpv/quit") { # should not happen, but allows user to kill etc. without consequence + $status = 1; + mpv_init; # try reinit + last; + + } elsif ($INPUT eq "mpv/idle") { # normal end-of-file + last; + + } elsif ($INPUT eq "return") { + $status = 1; + last; + +Or the code that actually starts playback, once the file is loaded: + + our %SAVE_PROPERTY = (aid => 1, sid => 1, "audio-delay" => 1); + + ... + + my $oid = 100; + + } elsif ($INPUT eq "mpv/file-loaded") { # start playing, configure video + $mpv->cmd ("seek", $playback_start, "absolute+exact") if $playback_start > 0; + + my $target_fps = eval { $mpv->cmd_recv ("get_property", "container-fps") } || 60; + $target_fps *= play_video_speed_mult; + set_fps $target_fps; + + unless (eval { $mpv->cmd_recv ("get_property", "video-format") }) { + $mpv->cmd ("set", "file-local-options/lavfi-complex", "[aid1] asplit [ao], showcqt=..., format=yuv420p [vo]"); + }; + + for my $prop (keys %SAVE_PROPERTY) { + if (exists $PLAYING_STATE->{"mpv_$prop"}) { + $mpv->cmd ("set", "$prop", $PLAYING_STATE->{"mpv_$prop"} . ""); + } + + $mpv->cmd ("observe_property", ++$oid, $prop); + } + + play_video_set_speed; + $mpv->cmd ("set", "osd-level", "$OSD_LEVEL"); + $mpv->cmd ("observe_property", ++$oid, "osd-level"); + $mpv->cmd ("set", "pause", "no"); + + $mpv->cmd ("set_property", "deinterlace", "yes") + if $initial_deinterlace; + +There is a lot going on here. First it seeks to the actual playback +position, if it is not at the start of the file (it would probaby be more +efficient to set the starting position before loading the file, though, +but this is good enough). + +Then it plays with the display fps, to set it to something harmonious +w.r.t. the video framerate. + +If the file does not have a video part, it assumes it is an audio file and +sets a visualizer. + +Also, a number of properties are not global, but per-file. At the moment, +this is C, and the current audio/subtitle track, which it +sets, and also creates an observer. Again, this doesn'T use the observe +functionality of this module, but handles it itself, assigning obsevrer +ids 100+ to temporary/per-file observers. + +Lastly, it sets some global (or per-youtube-uploader) parameters, such as +speed, and unpauses. Property changes are handled like other input events: + + } elsif ($INPUT eq "mpv/property-change") { + my $prop = $INPUT_DATA->{name}; + + if ($prop eq "chapter-metadata") { + if ($INPUT_DATA->{data}{TITLE} =~ /^\[SponsorBlock\]: (.*)/) { + my $section = $1; + my $skip; + + $skip ||= $SPONSOR_SKIP{$_} + for split /\s*,\s*/, $section; + + if (defined $skip) { + if ($skip) { + # delay a bit, in case we get two metadata changes in quick succession, e.g. + # because we have a skip at file load time. + $skip_delay = AE::timer 2/50, 0, sub { + $mpv->cmd ("no-osd", "add", "chapter", 1); + $mpv->cmd ("show-text", "skipped sponsorblock section \"$section\"", 3000); + }; + } else { + undef $skip_delay; + $mpv->cmd ("show-text", "NOT skipping sponsorblock section \"$section\"", 3000); + } + } else { + $mpv->cmd ("show-text", "UNRECOGNIZED sponsorblock section \"$section\"", 60000); + } + } else { + # cancel a queued skip + undef $skip_delay; + } + + } elsif (exists $SAVE_PROPERTY{$prop}) { + $PLAYING_STATE->{"mpv_$prop"} = $INPUT_DATA->{data}; + ::state_save; + } + +This saves back the per-file properties, and also handles chapter changes +in a hacky way. + +Most of the handlers are very simple, though. For example: + + } elsif ($INPUT eq "pause") { + $mpv->cmd ("cycle", "pause"); + $PLAYING_STATE->{curpos} = $mpv->cmd_recv ("get_property", "playback-time"); + } elsif ($INPUT eq "right") { + $mpv->cmd ("osd-msg-bar", "seek", 30, "relative+exact"); + } elsif ($INPUT eq "left") { + $mpv->cmd ("osd-msg-bar", "seek", -5, "relative+exact"); + } elsif ($INPUT eq "up") { + $mpv->cmd ("osd-msg-bar", "seek", +600, "relative+exact"); + } elsif ($INPUT eq "down") { + $mpv->cmd ("osd-msg-bar", "seek", -600, "relative+exact"); + } elsif ($INPUT eq "select") { + $mpv->cmd ("osd-msg-bar", "add", "audio-delay", "-0.100"); + } elsif ($INPUT eq "start") { + $mpv->cmd ("osd-msg-bar", "add", "audio-delay", "0.100"); + } elsif ($INPUT eq "intfwd") { + $mpv->cmd ("no-osd", "frame-step"); + } elsif ($INPUT eq "audio") { + $mpv->cmd ("osd-auto", "cycle", "audio"); + } elsif ($INPUT eq "subtitle") { + $mpv->cmd ("osd-auto", "cycle", "sub"); + } elsif ($INPUT eq "triangle") { + $mpv->cmd ("osd-auto", "cycle", "deinterlace"); + +Once a file has finished playing (or the user strops playback), it pauses, +unobserves the per-file observers, and saves the current position for to +be able to resume: + + $mpv->cmd ("set", "pause", "yes"); + + while ($oid > 100) { + $mpv->cmd ("unobserve_property", $oid--); + } + + $PLAYING_STATE->{curpos} = $mpv->cmd_recv ("get_property", "playback-time"); + +And thats most of the F-related code. + +=head2 F + +F is low-feature image viewer that I use many times daily +because it can handle directories with millions of files without falling +over. It also had the ability to play videos for ages, but it used an +older, crappier protocol to talk to F and used F before +playing each file instead of letting F handle format/size detection. + +After writing this module, I decided to upgprade Gtk2::CV by making use +of it, with the goal of getting rid of F and being ablew to +reuse F processes, which would have a multitude of speed benefits +(for example, fork+exec of F caused the kernel to close all file +descriptors, which could take minutes if a large file was being copied via +NFS, as the kernel waited for thr buffers to be flushed on close - not +having to start F gets rid of this issue). + +Setting up is only complicated by the fact that F needs to be +embedded into an existing window. To keep control of all inputs, +F puts an eventbox in front of F, so F receives no +input events: + + $self->{mpv} = AnyEvent::MPV->new ( + trace => $ENV{CV_MPV_TRACE}, + ); + + # create an eventbox, so we receive all input events + my $box = $self->{mpv_eventbox} = new Gtk2::EventBox; + $box->set_above_child (1); + $box->set_visible_window (0); + $box->set_events ([]); + $box->can_focus (0); + + # create a drawingarea that mpv can display into + my $window = $self->{mpv_window} = new Gtk2::DrawingArea; + $box->add ($window); + + # put the drawingarea intot he eventbox, and the eventbox into our display window + $self->add ($box); + + # we need to pass the window id to F, which means we need to realise + # the drawingarea, so an X window is allocated for it. + $self->show_all; + $window->realize; + my $xid = $window->window->get_xid; + +Then it starts F using this setup: + + local $ENV{LC_ALL} = "POSIX"; + $self->{mpv}->start ( + "--no-terminal", + "--no-input-terminal", + "--no-input-default-bindings", + "--no-input-cursor", + "--input-conf=/dev/null", + "--input-vo-keyboard=no", + + "--loop-file=inf", + "--force-window=yes", + "--idle=yes", + + "--audio-client-name=CV", + + "--osc=yes", # --osc=no displays fading play/pause buttons instead + + "--wid=$xid", + ); + + $self->{mpv}->cmd ("script-message" => "osc-visibility" => "never", "dummy"); + $self->{mpv}->cmd ("osc-idlescreen" => "no"); + +It also prepares a hack to force a ConfigureNotify event on every vidoe +reconfig: + + # force a configurenotify on every video-reconfig + $self->{mpv_reconfig} = $self->{mpv}->register_event (video_reconfig => sub { + my ($mpv, $event, $data) = @_; + + $self->mpv_window_update; + }); + +The way this is done is by doing a "dummy" resize to 1x1 and back: + + $self->{mpv_window}->window->resize (1, 1), + $self->{mpv_window}->window->resize ($self->{w}, $self->{h}); + +Without this, F often doesn't "get" the correct window size. Doing +it this way is not nice, but I didn't fine a nicer way to do it. + +When no file is being played, F is hidden and prepared: + + $self->{mpv_eventbox}->hide; + + $self->{mpv}->cmd (set_property => "pause" => "yes"); + $self->{mpv}->cmd ("playlist_remove", "current"); + $self->{mpv}->cmd (set_property => "video-rotate" => 0); + $self->{mpv}->cmd (set_property => "lavfi-complex" => ""); + +Loading a file is a bit more complicated, as bluray and DVD rips are +supported: + + if ($moviedir) { + if ($moviedir eq "br") { + $mpv->cmd (set => "bluray-device" => $path); + $mpv->cmd (loadfile => "bd://"); + } elsif ($moviedir eq "dvd") { + $mpv->cmd (set => "dvd-device" => $path); + $mpv->cmd (loadfile => "dvd://"); + } + } elsif ($type eq "video/iso-bluray") { + $mpv->cmd (set => "bluray-device" => $path); + $mpv->cmd (loadfile => "bd://"); + } else { + $mpv->cmd (loadfile => $mpv->escape_binary ($path)); + } + +After this, C waits for the file to be loaded, video to be +configured, and then queries the video size (to resize its own window) +and video format (to decide whether an audio visualizer is needed for +audio playback). The problematic word here is "wait", as this needs to be +imploemented using callbacks. + +This made the code much harder to write, as the whole setup is very +asynchronous (C talks to the command interface in F, which +talks to the decode and playback parts, all of which run asynchronously +w.r.t. each other. In practise, this can mean that C waits for +a file to be loaded by F while the command interface of F still +deals with the previous file and the decoder still handles an even older +file). Adding to this fact is that Gtk2::CV is bound by the glib event +loop, which means we cannot wait for replies form F anywhere, so +everything has to be chained callbacks. + +The way this is handled is by creating a new empty hash ref that is unique +for each loaded file, and use it to detect whether the event is old or +not, and also store C guard objects in it: + + # every time we loaded a file, we create a new hash + my $guards = $self->{mpv_guards} = { }; + +Then, when we wait for an event to occur, delete the handler, and, if the +C object has changed, we ignore it. Something like this: + + $guards->{file_loaded} = $mpv->register_event (file_loaded => sub { + delete $guards->{file_loaded}; + return if $guards != $self->{mpv_guards}; + +Commands do not have guards since they cnanot be cancelled, so we don't +have to do this for commands. But what prevents us form misinterpreting +an old event? Since F (by default) handles commands synchronously, +we can queue a dummy command, whose only purpose is to tell us when all +previous commands are done. We use C for this. + +The simplified code looks like this: + + Scalar::Util::weaken $self; + + $mpv->cmd ("get_version")->cb (sub { + + $guards->{file_loaded} = $mpv->register_event (file_loaded => sub { + delete $guards->{file_loaded}; + return if $guards != $self->{mpv_guards}; + + $mpv->cmd (get_property => "video-format")->cb (sub { + return if $guards != $self->{mpv_guards}; + + # video-format handling + return if eval { $_[0]->recv; 1 }; + + # no video? assume audio and visualize, cpu usage be damned + $mpv->cmd (set => "lavfi-complex" => ..."); + }); + + $guards->{show} = $mpv->register_event (video_reconfig => sub { + delete $guards->{show}; + return if $guards != $self->{mpv_guards}; + + $self->{mpv_eventbox}->show_all; + + $w = $mpv->cmd (get_property => "dwidth"); + $h = $mpv->cmd (get_property => "dheight"); + + $h->cb (sub { + $w = eval { $w->recv }; + $h = eval { $h->recv }; + + $mpv->cmd (set_property => "pause" => "no"); + + if ($w && $h) { + # resize our window + } + + }); + }); + + }); + + }); + +Most of the rest of the code is much simpler and just deals with forwarding user commands: + + } elsif ($key == $Gtk2::Gdk::Keysyms{Right}) { $mpv->cmd ("osd-msg-bar" => seek => "+10"); + } elsif ($key == $Gtk2::Gdk::Keysyms{Left} ) { $mpv->cmd ("osd-msg-bar" => seek => "-10"); + } elsif ($key == $Gtk2::Gdk::Keysyms{Up} ) { $mpv->cmd ("osd-msg-bar" => seek => "+60"); + } elsif ($key == $Gtk2::Gdk::Keysyms{Down} ) { $mpv->cmd ("osd-msg-bar" => seek => "-60"); + } elsif ($key == $Gtk2::Gdk::Keysyms{a}) ) { $mpv->cmd ("osd-msg-msg" => cycle => "audio"); + } elsif ($key == $Gtk2::Gdk::Keysyms{j} ) { $mpv->cmd ("osd-msg-msg" => cycle => "sub"); + } elsif ($key == $Gtk2::Gdk::Keysyms{o} ) { $mpv->cmd ("no-osd" => "cycle-values", "osd-level", "2", "3", "0", "2"); + } elsif ($key == $Gtk2::Gdk::Keysyms{p} ) { $mpv->cmd ("no-osd" => cycle => "pause"); + } elsif ($key == $Gtk2::Gdk::Keysyms{9} ) { $mpv->cmd ("osd-msg-bar" => add => "ao-volume", "-2"); + } elsif ($key == $Gtk2::Gdk::Keysyms{0} ) { $mpv->cmd ("osd-msg-bar" => add => "ao-volume", "+2"); + =head1 SEE ALSO -L. +L, L. =head1 AUTHOR