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.7 by root, Sun Mar 19 23:37:46 2023 UTC vs.
Revision 1.13 by root, Mon Mar 20 14:42:40 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
… …
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 (delete $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
… …
577On error, the condvar will croak when C<recv> is called. 619On error, the condvar will croak when C<recv> is called.
578 620
579=cut 621=cut
580 622
581sub cmd { 623sub cmd {
582 my ($self, @cmd) = @_; 624 my $self = shift;
583 625
584 my $cv = AE::cv; 626 $self->{_cmd}->(@_)
585
586 my $reqid = ++$self->{reqid};
587 $self->{cmd_cv}{$reqid} = $cv;
588
589 my $cmd = $JSON->new->utf8->encode ({ command => ref $cmd[0] ? $cmd[0] : \@cmd, request_id => $reqid*1 });
590
591 # (un-)apply escape_binary hack
592 $cmd =~ s/\xf4\x8e\x97\x9f(..)/sprintf sprintf "\\x%02x", hex $1/ges; # f48e979f == 10e5df in utf-8
593
594 $self->{_send}($cmd);
595
596 $cv
597} 627}
598 628
599=item $result = $mpv->cmd_recv ($command => $arg, $arg...) 629=item $result = $mpv->cmd_recv ($command => $arg, $arg...)
600 630
601The 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
… …
611 &cmd->recv 641 &cmd->recv
612} 642}
613 643
614=item $mpv->bind_key ($INPUT => $string) 644=item $mpv->bind_key ($INPUT => $string)
615 645
616This 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
617is 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
618passed 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.:
619 651
620 my $mpv = AnyEvent::MPV->new ( 652 my $mpv = AnyEvent::MPV->new (
621 on_key => sub { 653 on_key => sub {
622 my ($mpv, $key) = @_; 654 my ($mpv, $key) = @_;
623 655
… …
627 }, 659 },
628 ); 660 );
629 661
630 $mpv_>bind_key (ESC => "letmeout"); 662 $mpv_>bind_key (ESC => "letmeout");
631 663
664You cna find a list of key names L<in the mpv
665documentation|https://mpv.io/manual/stable/#key-names>.
666
632The 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
633after every C<start>. 668after every C<start>.
634 669
635=cut 670=cut
636 671
637sub bind_key { 672sub bind_key {
638 my ($self, $key, $event) = @_; 673 my ($self, $key, $event) = @_;
639 674
640 $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;
641 $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
700=cut
701
702sub AnyEvent::MPV::Unevent::DESTROY {
703 my ($evtcb, $event, $evtid) = @{$_[0]};
704 delete $evtcb->{$event}{$evtid};
705}
706
707sub register_event {
708 my ($self, $event, $cb) = @_;
709
710 $event =~ y/_/-/;
711
712 my $evtid = ++$self->{evtid};
713 $self->{evtcb}{$event}{$evtid} = $cb;
714
715 defined wantarray
716 and bless [$self->{evtcb}, $event, $evtid], AnyEvent::MPV::Unevent::
717}
718
719=item [$guard] = $mpv->observe_property ($name => $coderef->($mpv, $name, $value))
720
721=item [$guard] = $mpv->observe_property_string ($name => $coderef->($mpv, $name, $value))
722
723These methods wrap a registry system around F<mpv>'s C<observe_property>
724and C<observe_property_string> commands - every time the named property
725changes, the coderef is invoked with the C<$mpv> object, the name of the
726property and the new value.
727
728For a list of properties that you can observe, see L<the mpv
729documentation|https://mpv.io/manual/stable/#property-list>.
730
731Due to the (sane :) way F<mpv> handles these requests, you will always
732get a property cxhange event right after registering an observer (meaning
733you don't have to query the current value), and it is also possible to
734register multiple observers for the same property - they will all be
735handled properly.
736
737When called in void context, the observer stays in place until F<mpv>
738is stopped. In any otrher context, these methods return a guard
739object that, when it goes out of scope, unregisters the observe using
740C<unobserve_property>.
741
742Internally, this method uses observer ids of 2**52 (0x10000000000000) or
743higher - it will not interfere with lower ovserver ids, so it is possible
744to completely ignore this system and execute C<observe_property> commands
745yourself, whilst listening to C<property-change> events - as long as your
746ids stay below 2**52.
747
748Example: register observers for changtes in C<aid> and C<sid>. Note that
749a dummy statement is added to make sure the method is called in void
750context.
751
752 sub register_observers {
753 my ($mpv) = @_;
754
755 $mpv->observe_property (aid => sub {
756 my ($mpv, $name, $value) = @_;
757 print "property aid (=$name) has changed to $value\n";
758 });
759
760 $mpv->observe_property (sid => sub {
761 my ($mpv, $name, $value) = @_;
762 print "property sid (=$name) has changed to $value\n";
763 });
764
765 () # ensure the above method is called in void context
766 }
767
768=cut
769
770sub AnyEvent::MPV::Unobserve::DESTROY {
771 my ($mpv, $obscb, $obsid) = @{$_[0]};
772
773 delete $obscb->{$obsid};
774
775 if ($obscb == $mpv->{obscb}) {
776 $mpv->cmd (unobserve_property => $obsid+0);
777 }
778}
779
780sub _observe_property {
781 my ($self, $type, $property, $cb) = @_;
782
783 my $obsid = OBSID + ++$self->{obsid};
784 $self->cmd ($type => $obsid+0, $property);
785 $self->{obscb}{$obsid} = $cb;
786
787 defined wantarray and do {
788 my $unobserve = bless [$self, $self->{obscb}, $obsid], AnyEvent::MPV::Unobserve::;
789 Scalar::Util::weaken $unobserve->[0];
790 $unobserve
791 }
792}
793
794sub observe_property {
795 my ($self, $property, $cb) = @_;
796
797 $self->_observe_property (observe_property => $property, $cb)
798}
799
800sub observe_property_string {
801 my ($self, $property, $cb) = @_;
802
803 $self->_observe_property (observe_property_string => $property, $cb)
642} 804}
643 805
644=back 806=back
645 807
646=head2 SUBCLASSING 808=head2 SUBCLASSING

Diff Legend

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