ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/AnyEvent-MPV/MPV.pm
(Generate patch)

Comparing AnyEvent-MPV/MPV.pm (file contents):
Revision 1.5 by root, Sun Mar 19 23:13:25 2023 UTC vs.
Revision 1.15 by root, Wed Mar 22 01:00:36 2023 UTC

… …
62 $quit->recv; 62 $quit->recv;
63 63
64This starts F<mpv> with the two arguments C<--> and C<$videofile>, which 64This starts F<mpv> with the two arguments C<--> and C<$videofile>, which
65it should load and play. It then waits two seconds by starting a timer and 65it should load and play. It then waits two seconds by starting a timer and
66quits. The C<trace> argument to the constructor makes F<mpv> more verbose 66quits. The C<trace> argument to the constructor makes F<mpv> more verbose
67and also prints the commands and responses, so you cna have an idea what 67and also prints the commands and responses, so you can have an idea what
68is going on. 68is going on.
69
70In my case, the above example would output something like this:
71
72 [uosc] Disabled because original osc is enabled!
73 mpv> {"event":"start-file","playlist_entry_id":1}
74 mpv> {"event":"tracks-changed"}
75 (+) Video --vid=1 (*) (h264 480x480 30.000fps)
76 mpv> {"event":"metadata-update"}
77 mpv> {"event":"file-loaded"}
78 Using hardware decoding (nvdec).
79 mpv> {"event":"video-reconfig"}
80 VO: [gpu] 480x480 cuda[nv12]
81 mpv> {"event":"video-reconfig"}
82 mpv> {"event":"playback-restart"}
69 83
70This is not usually very useful (you could just run F<mpv> as a simple 84This is not usually very useful (you could just run F<mpv> as a simple
71shell command), so let us load the file at runtime: 85shell command), so let us load the file at runtime:
72 86
73 use AnyEvent; 87 use AnyEvent;
… …
133 my $quit = AE::cv; 147 my $quit = AE::cv;
134 148
135 my $mpv = AnyEvent::MPV->new ( 149 my $mpv = AnyEvent::MPV->new (
136 trace => 1, 150 trace => 1,
137 args => ["--pause", "--idle=yes"], 151 args => ["--pause", "--idle=yes"],
138 on_event => sub {
139 my ($mpv, $event, $data) = @_;
140
141 if ($event eq "start-file") {
142 $mpv->cmd ("set", "pause", "no");
143 } elsif ($event eq "end-file") {
144 print "end-file<$data->{reason}>\n";
145 $quit->send;
146 }
147 },
148 ); 152 );
149 153
150 $mpv->start; 154 $mpv->start;
155
156 $mpv->register_event (start_file => sub {
157 $mpv->cmd ("set", "pause", "no");
158 });
159
160 $mpv->register_event (end_file => sub {
161 my ($mpv, $event, $data) = @_;
162
163 print "end-file<$data->{reason}>\n";
164 $quit->send;
165 });
166
151 $mpv->cmd (loadfile => $mpv->escape_binary ($videofile)); 167 $mpv->cmd (loadfile => $mpv->escape_binary ($videofile));
152 168
153 $quit->recv; 169 $quit->recv;
154 170
155This example uses a global condvar C<$quit> to wait for the file to finish 171This example uses a global condvar C<$quit> to wait for the file to finish
156playing. Also, most of the logic is now in an C<on_event> callback, which 172playing. Also, most of the logic is now implement in event handlers.
157receives an event name and the actual event object.
158 173
159The two events we handle are C<start-file>, which is emitted by F<mpv> 174The two events handlers we register are C<start-file>, which is emitted by
160once it has loaded a new file, and C<end-file>, which signals the end 175F<mpv> once it has loaded a new file, and C<end-file>, which signals the
161of a file. 176end of a file (underscores are internally replaced by minus signs, so you
177cna speicfy event names with either).
162 178
163In the former event, we again set the C<pause> property to C<no> so the 179In the C<start-file> event, we again set the C<pause> property to C<no>
164movie starts playing. For the latter event, we tell the main program to 180so the movie starts playing. For the C<end-file> event, we tell the main
165quit by invoking C<$quit>. 181program to quit by invoking C<$quit>.
166 182
167This should conclude the basics of operation. There are a few more 183This should conclude the basics of operation. There are a few more
168examples later in the documentation. 184examples later in the documentation.
169 185
170=head2 ENCODING CONVENTIONS 186=head2 ENCODING CONVENTIONS
171 187
172As a rule of thumb, all data you pass to this module to be sent to F<mpv> 188As a rule of thumb, all data you pass to this module to be sent to F<mpv>
173is expected to be in unicode. To pass something that isn't, you need to 189is expected to be in unicode. To pass something that isn't, you need to
174escape it using C<escape_binary>. 190escape it using C<escape_binary>.
175 191
176Data received from C<$mpv>, however, is I<not> decoded to unicode, as data 192Data received from F<mpv>, however, is I<not> decoded to unicode, as data
177returned by F<mpv> is not generally encoded in unicode, and the encoding 193returned by F<mpv> is not generally encoded in unicode, and the encoding
178is usually unspecified. So if you receive data and expect it to be in 194is usually unspecified. So if you receive data and expect it to be in
179unicode, you need to first decode it from UTF-8, but note that this might 195unicode, you need to first decode it from UTF-8, but note that this might
180fail. This is not a limitation of this module - F<mpv> simply does not 196fail. This is not a limitation of this module - F<mpv> simply does not
181specify nor guarantee a specific encoding, or any encoding at all, in its 197specify nor guarantee a specific encoding, or any encoding at all, in its
… …
195use Scalar::Util (); 211use Scalar::Util ();
196 212
197use AnyEvent (); 213use AnyEvent ();
198use AnyEvent::Util (); 214use AnyEvent::Util ();
199 215
216our $VERSION = '0.2';
217
218sub OBSID() { 0x10000000000000 } # 2**52
219
200our $JSON = eval { require JSON::XS; JSON::XS:: } 220our $JSON = eval { require JSON::XS; JSON::XS:: }
201 || do { require JSON::PP; JSON::PP:: }; 221 || do { require JSON::PP; JSON::PP:: };
202 222
203our $JSON_CODER = 223our $JSON_ENCODER = $JSON->new->utf8;
204 224our $JSON_DECODER = $JSON->new->latin1;
205our $VERSION = '0.1';
206 225
207our $mpv_path; # last mpv path used 226our $mpv_path; # last mpv path used
208our $mpv_optionlist; # output of mpv --list-options 227our $mpv_optionlist; # output of mpv --list-options
209 228
210=item $mpv = AnyEvent::MPV->new (key => value...) 229=item $mpv = AnyEvent::MPV->new (key => value...)
… …
372 my $trace = delete $self->{trace} || sub { }; 391 my $trace = delete $self->{trace} || sub { };
373 392
374 $trace = sub { warn "$_[0] $_[1]\n" } if $trace && !ref $trace; 393 $trace = sub { warn "$_[0] $_[1]\n" } if $trace && !ref $trace;
375 394
376 my $buf; 395 my $buf;
377 my $wbuf;
378 396
379 Scalar::Util::weaken $self; 397 Scalar::Util::weaken $self;
380 398
381 $self->{rw} = AE::io $fh, 0, sub { 399 $self->{rw} = AE::io $fh, 0, sub {
382 if (sysread $fh, $buf, 8192, length $buf) { 400 if (sysread $fh, $buf, 8192, length $buf) {
383 while ($buf =~ s/^([^\n]+)\n//) { 401 while ($buf =~ s/^([^\n]+)\n//) {
384 $trace->("mpv>" => "$1"); 402 $trace->("mpv>" => "$1");
385 403
386 if ("{" eq substr $1, 0, 1) { 404 if ("{" eq substr $1, 0, 1) {
387 eval { 405 eval {
388 my $reply = $JSON->new->latin1->decode ($1); 406 my $reply = $JSON_DECODER->decode ($1);
389 407
390 if (exists $reply->{event}) { 408 if (defined (my $event = delete $reply->{event})) {
391 if ( 409 if (
392 $reply->{event} eq "client-message" 410 $event eq "client-message"
393 and $reply->{args}[0] eq "AnyEvent::MPV" 411 and $reply->{args}[0] eq "AnyEvent::MPV"
394 ) { 412 ) {
395 if ($reply->{args}[1] eq "key") { 413 if ($reply->{args}[1] eq "key") {
396 (my $key = $reply->{args}[2]) =~ s/\\x(..)/chr hex $1/ge; 414 (my $key = $reply->{args}[2]) =~ s/\\x(..)/chr hex $1/ge;
397 $self->on_key ($key); 415 $self->on_key ($key);
398 } 416 }
417 } elsif (
418 $event eq "property-change"
419 and OBSID <= $reply->{id}
420 ) {
421 if (my $cb = $self->{obscb}{$reply->{id}}) {
422 $cb->($self, $event, $reply->{data});
423 }
399 } else { 424 } else {
425 if (my $cbs = $self->{evtcb}{$event}) {
426 for my $evtid (keys %$cbs) {
427 my $cb = $cbs->{$evtid}
428 or next;
429 $cb->($self, $event, $reply);
430 }
431 }
432
400 $self->on_event ($reply->{event}, $reply); 433 $self->on_event ($event, $reply);
401 } 434 }
402 } elsif (exists $reply->{request_id}) { 435 } elsif (exists $reply->{request_id}) {
403 my $cv = delete $self->{cmd_cv}{$reply->{request_id}}; 436 my $cv = delete $self->{cmdcv}{$reply->{request_id}};
404 437
405 unless ($cv) { 438 unless ($cv) {
406 warn "no cv found for request id <$reply->{request_id}>\n"; 439 warn "no cv found for request id <$reply->{request_id}>\n";
407 next; 440 next;
408 } 441 }
… …
428 $self->stop; 461 $self->stop;
429 $self->on_eof; 462 $self->on_eof;
430 } 463 }
431 }; 464 };
432 465
466 my $wbuf;
467 my $reqid;
468
433 $self->{_send} = sub { 469 $self->{_cmd} = sub {
434 $wbuf .= "$_[0]\n"; 470 my $cv = AE::cv;
435 471
472 $self->{cmdcv}{++$reqid} = $cv;
473
474 my $cmd = $JSON_ENCODER->encode ({ command => ref $_[0] ? $_[0] : \@_, request_id => $reqid*1 });
475
476 # (un-)apply escape_binary hack
477 $cmd =~ s/\xf4\x8e\x97\x9f(..)/sprintf sprintf "\\x%02x", hex $1/ges; # f48e979f == 10e5df in utf-8
478
436 $trace->(">mpv" => "$_[0]"); 479 $trace->(">mpv" => $cmd);
480
481 $wbuf .= "$cmd\n";
437 482
438 $self->{ww} ||= AE::io $fh, 1, sub { 483 $self->{ww} ||= AE::io $fh, 1, sub {
439 my $len = syswrite $fh, $wbuf; 484 my $len = syswrite $fh, $wbuf;
440 substr $wbuf, 0, $len, ""; 485 substr $wbuf, 0, $len, "";
441 undef $self->{ww} unless length $wbuf; 486 undef $self->{ww} unless length $wbuf;
442 }; 487 };
488
489 $cv
443 }; 490 };
444 491
445 1 492 1
493}
494
495sub DESTROY {
496 $_[0]->stop;
446} 497}
447 498
448=item $mpv->stop 499=item $mpv->stop
449 500
450Ensures that F<mpv> is being stopped, by killing F<mpv> with a C<TERM> 501Ensures that F<mpv> is being stopped, by killing F<mpv> with a C<TERM>
… …
465 kill TERM => $self->{pid}; 516 kill TERM => $self->{pid};
466 517
467 } 518 }
468 519
469 delete $self->{pid}; 520 delete $self->{pid};
470 delete $self->{cmd_cv}; 521 delete $self->{cmdcv};
522 delete $self->{evtid};
523 delete $self->{evtcb};
524 delete $self->{obsid};
525 delete $self->{obscb};
526 delete $self->{wbuf};
471} 527}
472 528
473=item $mpv->on_eof 529=item $mpv->on_eof
474 530
475This method is called when F<mpv> quits - usually unexpectedly. The 531This method is called when F<mpv> quits - usually unexpectedly. The
… …
490 546
491This method is called when F<mpv> sends an asynchronous event. The default 547This method is called when F<mpv> sends an asynchronous event. The default
492implementation will call the C<on_event> code reference specified in the 548implementation will call the C<on_event> code reference specified in the
493constructor, or do nothing if none was given. 549constructor, or do nothing if none was given.
494 550
495The first/implicit argument is the C<$mpv> object, the second is the event 551The first/implicit argument is the C<$mpv> object, the second is the
496name (same as C<< $data->{event} >>, purely for convenience), and the 552event name (same as C<< $data->{event} >>, purely for convenience), and
497third argument is the full event object as sent by F<mpv>. See L<List of 553the third argument is the event object as sent by F<mpv> (sans C<event>
498events|https://mpv.io/manual/stable/#list-of-events> in its documentation. 554key). See L<List of events|https://mpv.io/manual/stable/#list-of-events>
555in its documentation.
499 556
500For subclassing, see I<SUBCLASSING>, below. 557For subclassing, see I<SUBCLASSING>, below.
501 558
502=cut 559=cut
503 560
… …
562On error, the condvar will croak when C<recv> is called. 619On error, the condvar will croak when C<recv> is called.
563 620
564=cut 621=cut
565 622
566sub cmd { 623sub cmd {
567 my ($self, @cmd) = @_; 624 my $self = shift;
568 625
569 my $cv = AE::cv; 626 $self->{_cmd}->(@_)
570
571 my $reqid = ++$self->{reqid};
572 $self->{cmd_cv}{$reqid} = $cv;
573
574 my $cmd = $JSON->new->utf8->encode ({ command => ref $cmd[0] ? $cmd[0] : \@cmd, request_id => $reqid*1 });
575
576 # (un-)apply escape_binary hack
577 $cmd =~ s/\xf4\x8e\x97\x9f(..)/sprintf sprintf "\\x%02x", hex $1/ges; # f48e979f == 10e5df in utf-8
578
579 $self->{_send}($cmd);
580
581 $cv
582} 627}
583 628
584=item $result = $mpv->cmd_recv ($command => $arg, $arg...) 629=item $result = $mpv->cmd_recv ($command => $arg, $arg...)
585 630
586The same as calling C<cmd> and immediately C<recv> on its return 631The same as calling C<cmd> and immediately C<recv> on its return
… …
596 &cmd->recv 641 &cmd->recv
597} 642}
598 643
599=item $mpv->bind_key ($INPUT => $string) 644=item $mpv->bind_key ($INPUT => $string)
600 645
601This is an extension implement by this module to make it easy to get key events. The way this is implemented 646This is an extension implement by this module to make it easy to get key
602is to bind a C<client-message> witha first argument of C<AnyEvent::MPV> and the C<$string> you passed. This C<$string> is then 647events. The way this is implemented is to bind a C<client-message> witha
603passed ot the C<on_key> handle when the key is proessed, e.g.: 648first argument of C<AnyEvent::MPV> and the C<$string> you passed. This
649C<$string> is then passed to the C<on_key> handle when the key is
650proessed, e.g.:
604 651
605 my $mpv = AnyEvent::MPV->new ( 652 my $mpv = AnyEvent::MPV->new (
606 on_key => sub { 653 on_key => sub {
607 my ($mpv, $key) = @_; 654 my ($mpv, $key) = @_;
608 655
… …
612 }, 659 },
613 ); 660 );
614 661
615 $mpv_>bind_key (ESC => "letmeout"); 662 $mpv_>bind_key (ESC => "letmeout");
616 663
664You cna find a list of key names L<in the mpv
665documentation|https://mpv.io/manual/stable/#key-names>.
666
617The key configuration is lost when F<mpv> is stopped and must be (re-)done 667The key configuration is lost when F<mpv> is stopped and must be (re-)done
618after every C<start>. 668after every C<start>.
619 669
620=cut 670=cut
621 671
622sub bind_key { 672sub bind_key {
623 my ($self, $key, $event) = @_; 673 my ($self, $key, $event) = @_;
624 674
625 $event =~ s/([^A-Za-z0-9\-_])/sprintf "\\x%02x", ord $1/ge; 675 $event =~ s/([^A-Za-z0-9\-_])/sprintf "\\x%02x", ord $1/ge;
626 $self->cmd (keybind => $key => "no-osd script-message AnyEvent::MPV key $event"); 676 $self->cmd (keybind => $key => "no-osd script-message AnyEvent::MPV key $event");
677}
678
679=item [$guard] = $mpv->register_event ($event => $coderef->($mpv, $event, $data))
680
681This method registers a callback to be invoked for a specific
682event. Whenever the event occurs, it calls the coderef with the C<$mpv>
683object, the C<$event> name and the event object, just like the C<on_event>
684method.
685
686For a lst of events, see L<the mpv
687documentation|https://mpv.io/manual/stable/#list-of-events>. Any
688underscore in the event name is replaced by a minus sign, so you can
689specify event names using underscores for easier quoting in Perl.
690
691In void context, the handler stays registered until C<stop> is called. In
692any other context, it returns a guard object that, when destroyed, will
693unregister the handler.
694
695You can register multiple handlers for the same event, and this method
696does not interfere with the C<on_event> mechanism. That is, you can
697completely ignore this method and handle events in a C<on_event> handler,
698or mix both approaches as you see fit.
699
700Note that unlike commands, event handlers are registered immediately, that
701is, you can issue a command, then register an event handler and then get
702an event for this handler I<before> the command is even sent to F<mpv>. If
703this kind of race is an issue, you can issue a dummy command such as
704C<get_version> and register the handler when the reply is received.
705
706=cut
707
708sub AnyEvent::MPV::Unevent::DESTROY {
709 my ($evtcb, $event, $evtid) = @{$_[0]};
710 delete $evtcb->{$event}{$evtid};
711}
712
713sub register_event {
714 my ($self, $event, $cb) = @_;
715
716 $event =~ y/_/-/;
717
718 my $evtid = ++$self->{evtid};
719 $self->{evtcb}{$event}{$evtid} = $cb;
720
721 defined wantarray
722 and bless [$self->{evtcb}, $event, $evtid], AnyEvent::MPV::Unevent::
723}
724
725=item [$guard] = $mpv->observe_property ($name => $coderef->($mpv, $name, $value))
726
727=item [$guard] = $mpv->observe_property_string ($name => $coderef->($mpv, $name, $value))
728
729These methods wrap a registry system around F<mpv>'s C<observe_property>
730and C<observe_property_string> commands - every time the named property
731changes, the coderef is invoked with the C<$mpv> object, the name of the
732property and the new value.
733
734For a list of properties that you can observe, see L<the mpv
735documentation|https://mpv.io/manual/stable/#property-list>.
736
737Due to the (sane :) way F<mpv> handles these requests, you will always
738get a property cxhange event right after registering an observer (meaning
739you don't have to query the current value), and it is also possible to
740register multiple observers for the same property - they will all be
741handled properly.
742
743When called in void context, the observer stays in place until F<mpv>
744is stopped. In any otrher context, these methods return a guard
745object that, when it goes out of scope, unregisters the observe using
746C<unobserve_property>.
747
748Internally, this method uses observer ids of 2**52 (0x10000000000000) or
749higher - it will not interfere with lower ovserver ids, so it is possible
750to completely ignore this system and execute C<observe_property> commands
751yourself, whilst listening to C<property-change> events - as long as your
752ids stay below 2**52.
753
754Example: register observers for changtes in C<aid> and C<sid>. Note that
755a dummy statement is added to make sure the method is called in void
756context.
757
758 sub register_observers {
759 my ($mpv) = @_;
760
761 $mpv->observe_property (aid => sub {
762 my ($mpv, $name, $value) = @_;
763 print "property aid (=$name) has changed to $value\n";
764 });
765
766 $mpv->observe_property (sid => sub {
767 my ($mpv, $name, $value) = @_;
768 print "property sid (=$name) has changed to $value\n";
769 });
770
771 () # ensure the above method is called in void context
772 }
773
774=cut
775
776sub AnyEvent::MPV::Unobserve::DESTROY {
777 my ($mpv, $obscb, $obsid) = @{$_[0]};
778
779 delete $obscb->{$obsid};
780
781 if ($obscb == $mpv->{obscb}) {
782 $mpv->cmd (unobserve_property => $obsid+0);
783 }
784}
785
786sub _observe_property {
787 my ($self, $type, $property, $cb) = @_;
788
789 my $obsid = OBSID + ++$self->{obsid};
790 $self->cmd ($type => $obsid+0, $property);
791 $self->{obscb}{$obsid} = $cb;
792
793 defined wantarray and do {
794 my $unobserve = bless [$self, $self->{obscb}, $obsid], AnyEvent::MPV::Unobserve::;
795 Scalar::Util::weaken $unobserve->[0];
796 $unobserve
797 }
798}
799
800sub observe_property {
801 my ($self, $property, $cb) = @_;
802
803 $self->_observe_property (observe_property => $property, $cb)
804}
805
806sub observe_property_string {
807 my ($self, $property, $cb) = @_;
808
809 $self->_observe_property (observe_property_string => $property, $cb)
627} 810}
628 811
629=back 812=back
630 813
631=head2 SUBCLASSING 814=head2 SUBCLASSING

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines