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.6 by root, Sun Mar 19 23:24:20 2023 UTC vs.
Revision 1.15 by root, Wed Mar 22 01:00:36 2023 UTC

… …
147 my $quit = AE::cv; 147 my $quit = AE::cv;
148 148
149 my $mpv = AnyEvent::MPV->new ( 149 my $mpv = AnyEvent::MPV->new (
150 trace => 1, 150 trace => 1,
151 args => ["--pause", "--idle=yes"], 151 args => ["--pause", "--idle=yes"],
152 on_event => sub {
153 my ($mpv, $event, $data) = @_;
154
155 if ($event eq "start-file") {
156 $mpv->cmd ("set", "pause", "no");
157 } elsif ($event eq "end-file") {
158 print "end-file<$data->{reason}>\n";
159 $quit->send;
160 }
161 },
162 ); 152 );
163 153
164 $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
165 $mpv->cmd (loadfile => $mpv->escape_binary ($videofile)); 167 $mpv->cmd (loadfile => $mpv->escape_binary ($videofile));
166 168
167 $quit->recv; 169 $quit->recv;
168 170
169This 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
170playing. 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.
171receives an event name and the actual event object.
172 173
173The 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
174once 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
175of a file. 176end of a file (underscores are internally replaced by minus signs, so you
177cna speicfy event names with either).
176 178
177In 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>
178movie 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
179quit by invoking C<$quit>. 181program to quit by invoking C<$quit>.
180 182
181This should conclude the basics of operation. There are a few more 183This should conclude the basics of operation. There are a few more
182examples later in the documentation. 184examples later in the documentation.
183 185
184=head2 ENCODING CONVENTIONS 186=head2 ENCODING CONVENTIONS
185 187
186As 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>
187is 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
188escape it using C<escape_binary>. 190escape it using C<escape_binary>.
189 191
190Data 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
191returned 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
192is 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
193unicode, 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
194fail. 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
195specify 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
… …
209use Scalar::Util (); 211use Scalar::Util ();
210 212
211use AnyEvent (); 213use AnyEvent ();
212use AnyEvent::Util (); 214use AnyEvent::Util ();
213 215
216our $VERSION = '0.2';
217
218sub OBSID() { 0x10000000000000 } # 2**52
219
214our $JSON = eval { require JSON::XS; JSON::XS:: } 220our $JSON = eval { require JSON::XS; JSON::XS:: }
215 || do { require JSON::PP; JSON::PP:: }; 221 || do { require JSON::PP; JSON::PP:: };
216 222
217our $JSON_CODER = 223our $JSON_ENCODER = $JSON->new->utf8;
218 224our $JSON_DECODER = $JSON->new->latin1;
219our $VERSION = '0.1';
220 225
221our $mpv_path; # last mpv path used 226our $mpv_path; # last mpv path used
222our $mpv_optionlist; # output of mpv --list-options 227our $mpv_optionlist; # output of mpv --list-options
223 228
224=item $mpv = AnyEvent::MPV->new (key => value...) 229=item $mpv = AnyEvent::MPV->new (key => value...)
… …
386 my $trace = delete $self->{trace} || sub { }; 391 my $trace = delete $self->{trace} || sub { };
387 392
388 $trace = sub { warn "$_[0] $_[1]\n" } if $trace && !ref $trace; 393 $trace = sub { warn "$_[0] $_[1]\n" } if $trace && !ref $trace;
389 394
390 my $buf; 395 my $buf;
391 my $wbuf;
392 396
393 Scalar::Util::weaken $self; 397 Scalar::Util::weaken $self;
394 398
395 $self->{rw} = AE::io $fh, 0, sub { 399 $self->{rw} = AE::io $fh, 0, sub {
396 if (sysread $fh, $buf, 8192, length $buf) { 400 if (sysread $fh, $buf, 8192, length $buf) {
397 while ($buf =~ s/^([^\n]+)\n//) { 401 while ($buf =~ s/^([^\n]+)\n//) {
398 $trace->("mpv>" => "$1"); 402 $trace->("mpv>" => "$1");
399 403
400 if ("{" eq substr $1, 0, 1) { 404 if ("{" eq substr $1, 0, 1) {
401 eval { 405 eval {
402 my $reply = $JSON->new->latin1->decode ($1); 406 my $reply = $JSON_DECODER->decode ($1);
403 407
404 if (exists $reply->{event}) { 408 if (defined (my $event = delete $reply->{event})) {
405 if ( 409 if (
406 $reply->{event} eq "client-message" 410 $event eq "client-message"
407 and $reply->{args}[0] eq "AnyEvent::MPV" 411 and $reply->{args}[0] eq "AnyEvent::MPV"
408 ) { 412 ) {
409 if ($reply->{args}[1] eq "key") { 413 if ($reply->{args}[1] eq "key") {
410 (my $key = $reply->{args}[2]) =~ s/\\x(..)/chr hex $1/ge; 414 (my $key = $reply->{args}[2]) =~ s/\\x(..)/chr hex $1/ge;
411 $self->on_key ($key); 415 $self->on_key ($key);
412 } 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 }
413 } 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
414 $self->on_event ($reply->{event}, $reply); 433 $self->on_event ($event, $reply);
415 } 434 }
416 } elsif (exists $reply->{request_id}) { 435 } elsif (exists $reply->{request_id}) {
417 my $cv = delete $self->{cmd_cv}{$reply->{request_id}}; 436 my $cv = delete $self->{cmdcv}{$reply->{request_id}};
418 437
419 unless ($cv) { 438 unless ($cv) {
420 warn "no cv found for request id <$reply->{request_id}>\n"; 439 warn "no cv found for request id <$reply->{request_id}>\n";
421 next; 440 next;
422 } 441 }
… …
442 $self->stop; 461 $self->stop;
443 $self->on_eof; 462 $self->on_eof;
444 } 463 }
445 }; 464 };
446 465
466 my $wbuf;
467 my $reqid;
468
447 $self->{_send} = sub { 469 $self->{_cmd} = sub {
448 $wbuf .= "$_[0]\n"; 470 my $cv = AE::cv;
449 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
450 $trace->(">mpv" => "$_[0]"); 479 $trace->(">mpv" => $cmd);
480
481 $wbuf .= "$cmd\n";
451 482
452 $self->{ww} ||= AE::io $fh, 1, sub { 483 $self->{ww} ||= AE::io $fh, 1, sub {
453 my $len = syswrite $fh, $wbuf; 484 my $len = syswrite $fh, $wbuf;
454 substr $wbuf, 0, $len, ""; 485 substr $wbuf, 0, $len, "";
455 undef $self->{ww} unless length $wbuf; 486 undef $self->{ww} unless length $wbuf;
456 }; 487 };
488
489 $cv
457 }; 490 };
458 491
459 1 492 1
493}
494
495sub DESTROY {
496 $_[0]->stop;
460} 497}
461 498
462=item $mpv->stop 499=item $mpv->stop
463 500
464Ensures 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>
… …
479 kill TERM => $self->{pid}; 516 kill TERM => $self->{pid};
480 517
481 } 518 }
482 519
483 delete $self->{pid}; 520 delete $self->{pid};
484 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};
485} 527}
486 528
487=item $mpv->on_eof 529=item $mpv->on_eof
488 530
489This method is called when F<mpv> quits - usually unexpectedly. The 531This method is called when F<mpv> quits - usually unexpectedly. The
… …
504 546
505This 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
506implementation will call the C<on_event> code reference specified in the 548implementation will call the C<on_event> code reference specified in the
507constructor, or do nothing if none was given. 549constructor, or do nothing if none was given.
508 550
509The 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
510name (same as C<< $data->{event} >>, purely for convenience), and the 552event name (same as C<< $data->{event} >>, purely for convenience), and
511third 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>
512events|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.
513 556
514For subclassing, see I<SUBCLASSING>, below. 557For subclassing, see I<SUBCLASSING>, below.
515 558
516=cut 559=cut
517 560
… …
576On error, the condvar will croak when C<recv> is called. 619On error, the condvar will croak when C<recv> is called.
577 620
578=cut 621=cut
579 622
580sub cmd { 623sub cmd {
581 my ($self, @cmd) = @_; 624 my $self = shift;
582 625
583 my $cv = AE::cv; 626 $self->{_cmd}->(@_)
584
585 my $reqid = ++$self->{reqid};
586 $self->{cmd_cv}{$reqid} = $cv;
587
588 my $cmd = $JSON->new->utf8->encode ({ command => ref $cmd[0] ? $cmd[0] : \@cmd, request_id => $reqid*1 });
589
590 # (un-)apply escape_binary hack
591 $cmd =~ s/\xf4\x8e\x97\x9f(..)/sprintf sprintf "\\x%02x", hex $1/ges; # f48e979f == 10e5df in utf-8
592
593 $self->{_send}($cmd);
594
595 $cv
596} 627}
597 628
598=item $result = $mpv->cmd_recv ($command => $arg, $arg...) 629=item $result = $mpv->cmd_recv ($command => $arg, $arg...)
599 630
600The 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
… …
610 &cmd->recv 641 &cmd->recv
611} 642}
612 643
613=item $mpv->bind_key ($INPUT => $string) 644=item $mpv->bind_key ($INPUT => $string)
614 645
615This 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
616is 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
617passed 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.:
618 651
619 my $mpv = AnyEvent::MPV->new ( 652 my $mpv = AnyEvent::MPV->new (
620 on_key => sub { 653 on_key => sub {
621 my ($mpv, $key) = @_; 654 my ($mpv, $key) = @_;
622 655
… …
626 }, 659 },
627 ); 660 );
628 661
629 $mpv_>bind_key (ESC => "letmeout"); 662 $mpv_>bind_key (ESC => "letmeout");
630 663
664You cna find a list of key names L<in the mpv
665documentation|https://mpv.io/manual/stable/#key-names>.
666
631The 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
632after every C<start>. 668after every C<start>.
633 669
634=cut 670=cut
635 671
636sub bind_key { 672sub bind_key {
637 my ($self, $key, $event) = @_; 673 my ($self, $key, $event) = @_;
638 674
639 $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;
640 $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)
641} 810}
642 811
643=back 812=back
644 813
645=head2 SUBCLASSING 814=head2 SUBCLASSING

Diff Legend

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