--- AnyEvent-MPV/MPV.pm 2023/03/19 23:37:46 1.7 +++ AnyEvent-MPV/MPV.pm 2023/03/20 13:32:52 1.11 @@ -149,34 +149,36 @@ my $mpv = AnyEvent::MPV->new ( trace => 1, args => ["--pause", "--idle=yes"], - on_event => sub { - my ($mpv, $event, $data) = @_; - - if ($event eq "start-file") { - $mpv->cmd ("set", "pause", "no"); - } elsif ($event eq "end-file") { - print "end-file<$data->{reason}>\n"; - $quit->send; - } - }, ); $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 in an C callback, which -receives an event name and the actual event object. +playing. Also, most of the logic is now implement in event handlers. -The two events we handle are C, which is emitted by F -once it has loaded a new file, and C, which signals the end -of a file. - -In the former event, we again set the C property to C so the -movie starts playing. For the latter event, we tell the main program to -quit by invoking C<$quit>. +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. @@ -211,13 +213,15 @@ use AnyEvent (); use AnyEvent::Util (); +our $VERSION = '0.2'; + +sub OBSID() { 0x10000000000000 } # 2**52 + our $JSON = eval { require JSON::XS; JSON::XS:: } || do { require JSON::PP; JSON::PP:: }; our $JSON_CODER = -our $VERSION = '0.1'; - our $mpv_path; # last mpv path used our $mpv_optionlist; # output of mpv --list-options @@ -388,7 +392,6 @@ $trace = sub { warn "$_[0] $_[1]\n" } if $trace && !ref $trace; my $buf; - my $wbuf; Scalar::Util::weaken $self; @@ -401,20 +404,35 @@ eval { my $reply = $JSON->new->latin1->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" ) { 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 (delete $reply->{event}, $reply); + 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"; @@ -444,21 +462,39 @@ } }; - $self->{_send} = sub { - $wbuf .= "$_[0]\n"; + my $wbuf; + my $reqid; + + $self->{_cmd} = sub { + my $cv = AE::cv; + + $self->{cmdcv}{++$reqid} = $cv; + + my $cmd = $JSON->new->utf8->encode ({ command => ref $_[0] ? $_[0] : \@_, 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 - $trace->(">mpv" => "$_[0]"); + $trace->(">mpv" => $cmd); + + $wbuf .= "$cmd\n"; $self->{ww} ||= AE::io $fh, 1, sub { my $len = syswrite $fh, $wbuf; substr $wbuf, 0, $len, ""; undef $self->{ww} unless length $wbuf; }; + + $cv }; 1 } +sub DESTROY { + $_[0]->stop; +} + =item $mpv->stop Ensures that F is being stopped, by killing F with a C @@ -481,7 +517,12 @@ } delete $self->{pid}; - delete $self->{cmd_cv}; + delete $self->{cmdcv}; + delete $self->{evtid}; + delete $self->{evtcb}; + delete $self->{obsid}; + delete $self->{obscb}; + delete $self->{wbuf}; } =item $mpv->on_eof @@ -579,21 +620,9 @@ =cut sub cmd { - my ($self, @cmd) = @_; + my $self = shift; - my $cv = AE::cv; - - my $reqid = ++$self->{reqid}; - $self->{cmd_cv}{$reqid} = $cv; - - my $cmd = $JSON->new->utf8->encode ({ 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 + $self->{_cmd}->(@_) } =item $result = $mpv->cmd_recv ($command => $arg, $arg...) @@ -613,9 +642,11 @@ =item $mpv->bind_key ($INPUT => $string) -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 ot the C handle when the key is proessed, e.g.: +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 { @@ -629,6 +660,9 @@ $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. @@ -641,6 +675,133 @@ $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. + +=cut + +sub AnyEvent::MPV::Unevent::DESTROY { + my ($evtcb, $evtid) = @{$_[0]}; + delete $evtcb->{$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}, $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