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.11 by root, Mon Mar 20 13:32:52 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_CODER =
218
219our $VERSION = '0.1';
220 224
221our $mpv_path; # last mpv path used 225our $mpv_path; # last mpv path used
222our $mpv_optionlist; # output of mpv --list-options 226our $mpv_optionlist; # output of mpv --list-options
223 227
224=item $mpv = AnyEvent::MPV->new (key => value...) 228=item $mpv = AnyEvent::MPV->new (key => value...)
… …
386 my $trace = delete $self->{trace} || sub { }; 390 my $trace = delete $self->{trace} || sub { };
387 391
388 $trace = sub { warn "$_[0] $_[1]\n" } if $trace && !ref $trace; 392 $trace = sub { warn "$_[0] $_[1]\n" } if $trace && !ref $trace;
389 393
390 my $buf; 394 my $buf;
391 my $wbuf;
392 395
393 Scalar::Util::weaken $self; 396 Scalar::Util::weaken $self;
394 397
395 $self->{rw} = AE::io $fh, 0, sub { 398 $self->{rw} = AE::io $fh, 0, sub {
396 if (sysread $fh, $buf, 8192, length $buf) { 399 if (sysread $fh, $buf, 8192, length $buf) {
… …
399 402
400 if ("{" eq substr $1, 0, 1) { 403 if ("{" eq substr $1, 0, 1) {
401 eval { 404 eval {
402 my $reply = $JSON->new->latin1->decode ($1); 405 my $reply = $JSON->new->latin1->decode ($1);
403 406
404 if (exists $reply->{event}) { 407 if (defined (my $event = delete $reply->{event})) {
405 if ( 408 if (
406 $reply->{event} eq "client-message" 409 $event eq "client-message"
407 and $reply->{args}[0] eq "AnyEvent::MPV" 410 and $reply->{args}[0] eq "AnyEvent::MPV"
408 ) { 411 ) {
409 if ($reply->{args}[1] eq "key") { 412 if ($reply->{args}[1] eq "key") {
410 (my $key = $reply->{args}[2]) =~ s/\\x(..)/chr hex $1/ge; 413 (my $key = $reply->{args}[2]) =~ s/\\x(..)/chr hex $1/ge;
411 $self->on_key ($key); 414 $self->on_key ($key);
412 } 415 }
416 } elsif (
417 $event eq "property-change"
418 and OBSID <= $reply->{id}
419 ) {
420 if (my $cb = $self->{obscb}{$reply->{id}}) {
421 $cb->($self, $event, $reply->{data});
422 }
413 } else { 423 } else {
424 if (my $cbs = $self->{evtcb}{$event}) {
425 for my $evtid (keys %$cbs) {
426 my $cb = $cbs->{$evtid}
427 or next;
428 $cb->($self, $event, $reply);
429 }
430 }
431
414 $self->on_event ($reply->{event}, $reply); 432 $self->on_event ($event, $reply);
415 } 433 }
416 } elsif (exists $reply->{request_id}) { 434 } elsif (exists $reply->{request_id}) {
417 my $cv = delete $self->{cmd_cv}{$reply->{request_id}}; 435 my $cv = delete $self->{cmdcv}{$reply->{request_id}};
418 436
419 unless ($cv) { 437 unless ($cv) {
420 warn "no cv found for request id <$reply->{request_id}>\n"; 438 warn "no cv found for request id <$reply->{request_id}>\n";
421 next; 439 next;
422 } 440 }
… …
442 $self->stop; 460 $self->stop;
443 $self->on_eof; 461 $self->on_eof;
444 } 462 }
445 }; 463 };
446 464
465 my $wbuf;
466 my $reqid;
467
447 $self->{_send} = sub { 468 $self->{_cmd} = sub {
448 $wbuf .= "$_[0]\n"; 469 my $cv = AE::cv;
449 470
471 $self->{cmdcv}{++$reqid} = $cv;
472
473 my $cmd = $JSON->new->utf8->encode ({ command => ref $_[0] ? $_[0] : \@_, request_id => $reqid*1 });
474
475 # (un-)apply escape_binary hack
476 $cmd =~ s/\xf4\x8e\x97\x9f(..)/sprintf sprintf "\\x%02x", hex $1/ges; # f48e979f == 10e5df in utf-8
477
450 $trace->(">mpv" => "$_[0]"); 478 $trace->(">mpv" => $cmd);
479
480 $wbuf .= "$cmd\n";
451 481
452 $self->{ww} ||= AE::io $fh, 1, sub { 482 $self->{ww} ||= AE::io $fh, 1, sub {
453 my $len = syswrite $fh, $wbuf; 483 my $len = syswrite $fh, $wbuf;
454 substr $wbuf, 0, $len, ""; 484 substr $wbuf, 0, $len, "";
455 undef $self->{ww} unless length $wbuf; 485 undef $self->{ww} unless length $wbuf;
456 }; 486 };
487
488 $cv
457 }; 489 };
458 490
459 1 491 1
492}
493
494sub DESTROY {
495 $_[0]->stop;
460} 496}
461 497
462=item $mpv->stop 498=item $mpv->stop
463 499
464Ensures that F<mpv> is being stopped, by killing F<mpv> with a C<TERM> 500Ensures that F<mpv> is being stopped, by killing F<mpv> with a C<TERM>
… …
479 kill TERM => $self->{pid}; 515 kill TERM => $self->{pid};
480 516
481 } 517 }
482 518
483 delete $self->{pid}; 519 delete $self->{pid};
484 delete $self->{cmd_cv}; 520 delete $self->{cmdcv};
521 delete $self->{evtid};
522 delete $self->{evtcb};
523 delete $self->{obsid};
524 delete $self->{obscb};
525 delete $self->{wbuf};
485} 526}
486 527
487=item $mpv->on_eof 528=item $mpv->on_eof
488 529
489This method is called when F<mpv> quits - usually unexpectedly. The 530This method is called when F<mpv> quits - usually unexpectedly. The
… …
504 545
505This method is called when F<mpv> sends an asynchronous event. The default 546This method is called when F<mpv> sends an asynchronous event. The default
506implementation will call the C<on_event> code reference specified in the 547implementation will call the C<on_event> code reference specified in the
507constructor, or do nothing if none was given. 548constructor, or do nothing if none was given.
508 549
509The first/implicit argument is the C<$mpv> object, the second is the event 550The first/implicit argument is the C<$mpv> object, the second is the
510name (same as C<< $data->{event} >>, purely for convenience), and the 551event 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 552the 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. 553key). See L<List of events|https://mpv.io/manual/stable/#list-of-events>
554in its documentation.
513 555
514For subclassing, see I<SUBCLASSING>, below. 556For subclassing, see I<SUBCLASSING>, below.
515 557
516=cut 558=cut
517 559
… …
576On error, the condvar will croak when C<recv> is called. 618On error, the condvar will croak when C<recv> is called.
577 619
578=cut 620=cut
579 621
580sub cmd { 622sub cmd {
581 my ($self, @cmd) = @_; 623 my $self = shift;
582 624
583 my $cv = AE::cv; 625 $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} 626}
597 627
598=item $result = $mpv->cmd_recv ($command => $arg, $arg...) 628=item $result = $mpv->cmd_recv ($command => $arg, $arg...)
599 629
600The same as calling C<cmd> and immediately C<recv> on its return 630The same as calling C<cmd> and immediately C<recv> on its return
… …
610 &cmd->recv 640 &cmd->recv
611} 641}
612 642
613=item $mpv->bind_key ($INPUT => $string) 643=item $mpv->bind_key ($INPUT => $string)
614 644
615This is an extension implement by this module to make it easy to get key events. The way this is implemented 645This 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 646events. 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.: 647first argument of C<AnyEvent::MPV> and the C<$string> you passed. This
648C<$string> is then passed to the C<on_key> handle when the key is
649proessed, e.g.:
618 650
619 my $mpv = AnyEvent::MPV->new ( 651 my $mpv = AnyEvent::MPV->new (
620 on_key => sub { 652 on_key => sub {
621 my ($mpv, $key) = @_; 653 my ($mpv, $key) = @_;
622 654
… …
626 }, 658 },
627 ); 659 );
628 660
629 $mpv_>bind_key (ESC => "letmeout"); 661 $mpv_>bind_key (ESC => "letmeout");
630 662
663You cna find a list of key names L<in the mpv
664documentation|https://mpv.io/manual/stable/#key-names>.
665
631The key configuration is lost when F<mpv> is stopped and must be (re-)done 666The key configuration is lost when F<mpv> is stopped and must be (re-)done
632after every C<start>. 667after every C<start>.
633 668
634=cut 669=cut
635 670
636sub bind_key { 671sub bind_key {
637 my ($self, $key, $event) = @_; 672 my ($self, $key, $event) = @_;
638 673
639 $event =~ s/([^A-Za-z0-9\-_])/sprintf "\\x%02x", ord $1/ge; 674 $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"); 675 $self->cmd (keybind => $key => "no-osd script-message AnyEvent::MPV key $event");
676}
677
678=item [$guard] = $mpv->register_event ($event => $coderef->($mpv, $event, $data))
679
680This method registers a callback to be invoked for a specific
681event. Whenever the event occurs, it calls the coderef with the C<$mpv>
682object, the C<$event> name and the event object, just like the C<on_event>
683method.
684
685For a lst of events, see L<the mpv
686documentation|https://mpv.io/manual/stable/#list-of-events>. Any
687underscore in the event name is replaced by a minus sign, so you can
688specify event names using underscores for easier quoting in Perl.
689
690In void context, the handler stays registered until C<stop> is called. In
691any other context, it returns a guard object that, when destroyed, will
692unregister the handler.
693
694You can register multiple handlers for the same event, and this method
695does not interfere with the C<on_event> mechanism. That is, you can
696completely ignore this method and handle events in a C<on_event> handler,
697or mix both approaches as you see fit.
698
699=cut
700
701sub AnyEvent::MPV::Unevent::DESTROY {
702 my ($evtcb, $evtid) = @{$_[0]};
703 delete $evtcb->{$evtid};
704}
705
706sub register_event {
707 my ($self, $event, $cb) = @_;
708
709 $event =~ y/_/-/;
710
711 my $evtid = ++$self->{evtid};
712 $self->{evtcb}{$event}{$evtid} = $cb;
713
714 defined wantarray
715 and bless [$self->{evtcb}, $evtid], AnyEvent::MPV::Unevent::
716}
717
718=item [$guard] = $mpv->observe_property ($name => $coderef->($mpv, $name, $value))
719
720=item [$guard] = $mpv->observe_property_string ($name => $coderef->($mpv, $name, $value))
721
722These methods wrap a registry system around F<mpv>'s C<observe_property>
723and C<observe_property_string> commands - every time the named property
724changes, the coderef is invoked with the C<$mpv> object, the name of the
725property and the new value.
726
727For a list of properties that you can observe, see L<the mpv
728documentation|https://mpv.io/manual/stable/#property-list>.
729
730Due to the (sane :) way F<mpv> handles these requests, you will always
731get a property cxhange event right after registering an observer (meaning
732you don't have to query the current value), and it is also possible to
733register multiple observers for the same property - they will all be
734handled properly.
735
736When called in void context, the observer stays in place until F<mpv>
737is stopped. In any otrher context, these methods return a guard
738object that, when it goes out of scope, unregisters the observe using
739C<unobserve_property>.
740
741Internally, this method uses observer ids of 2**52 (0x10000000000000) or
742higher - it will not interfere with lower ovserver ids, so it is possible
743to completely ignore this system and execute C<observe_property> commands
744yourself, whilst listening to C<property-change> events - as long as your
745ids stay below 2**52.
746
747Example: register observers for changtes in C<aid> and C<sid>. Note that
748a dummy statement is added to make sure the method is called in void
749context.
750
751 sub register_observers {
752 my ($mpv) = @_;
753
754 $mpv->observe_property (aid => sub {
755 my ($mpv, $name, $value) = @_;
756 print "property aid (=$name) has changed to $value\n";
757 });
758
759 $mpv->observe_property (sid => sub {
760 my ($mpv, $name, $value) = @_;
761 print "property sid (=$name) has changed to $value\n";
762 });
763
764 () # ensure the above method is called in void context
765 }
766
767=cut
768
769sub AnyEvent::MPV::Unobserve::DESTROY {
770 my ($mpv, $obscb, $obsid) = @{$_[0]};
771
772 delete $obscb->{$obsid};
773
774 if ($obscb == $mpv->{obscb}) {
775 $mpv->cmd (unobserve_property => $obsid+0);
776 }
777}
778
779sub _observe_property {
780 my ($self, $type, $property, $cb) = @_;
781
782 my $obsid = OBSID + ++$self->{obsid};
783 $self->cmd ($type => $obsid+0, $property);
784 $self->{obscb}{$obsid} = $cb;
785
786 defined wantarray and do {
787 my $unobserve = bless [$self, $self->{obscb}, $obsid], AnyEvent::MPV::Unobserve::;
788 Scalar::Util::weaken $unobserve->[0];
789 $unobserve
790 }
791}
792
793sub observe_property {
794 my ($self, $property, $cb) = @_;
795
796 $self->_observe_property (observe_property => $property, $cb)
797}
798
799sub observe_property_string {
800 my ($self, $property, $cb) = @_;
801
802 $self->_observe_property (observe_property_string => $property, $cb)
641} 803}
642 804
643=back 805=back
644 806
645=head2 SUBCLASSING 807=head2 SUBCLASSING

Diff Legend

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