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.10 by root, Mon Mar 20 12:31:03 2023 UTC

209use Scalar::Util (); 209use Scalar::Util ();
210 210
211use AnyEvent (); 211use AnyEvent ();
212use AnyEvent::Util (); 212use AnyEvent::Util ();
213 213
214our $VERSION = '0.2';
215
216sub OBSID() { 0x10000000000000 } # 2**52
217
214our $JSON = eval { require JSON::XS; JSON::XS:: } 218our $JSON = eval { require JSON::XS; JSON::XS:: }
215 || do { require JSON::PP; JSON::PP:: }; 219 || do { require JSON::PP; JSON::PP:: };
216 220
217our $JSON_CODER = 221our $JSON_CODER =
218
219our $VERSION = '0.1';
220 222
221our $mpv_path; # last mpv path used 223our $mpv_path; # last mpv path used
222our $mpv_optionlist; # output of mpv --list-options 224our $mpv_optionlist; # output of mpv --list-options
223 225
224=item $mpv = AnyEvent::MPV->new (key => value...) 226=item $mpv = AnyEvent::MPV->new (key => value...)
350 352
351sub start { 353sub start {
352 my ($self, @extra_args) = @_; 354 my ($self, @extra_args) = @_;
353 355
354 return 0 if $self->{fh}; 356 return 0 if $self->{fh};
357
358 $self->{obscb} = {};
355 359
356 # cache optionlist for same "path" 360 # cache optionlist for same "path"
357 ($mpv_path, $mpv_optionlist) = ($self->{mpv}, scalar qx{\Q$self->{mpv}\E --list-options}) 361 ($mpv_path, $mpv_optionlist) = ($self->{mpv}, scalar qx{\Q$self->{mpv}\E --list-options})
358 if $self->{mpv} ne $mpv_path; 362 if $self->{mpv} ne $mpv_path;
359 363
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) {
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 $reply->{event} eq "property-change"
418 and OBSID <= $reply->{id}
419 ) {
420 if (my $cb = $self->{obscb}{$reply->{id}}) {
421 $cb->($self, $reply->{name}, $reply->{data});
422 }
413 } else { 423 } else {
414 $self->on_event ($reply->{event}, $reply); 424 $self->on_event (delete $reply->{event}, $reply);
415 } 425 }
416 } elsif (exists $reply->{request_id}) { 426 } elsif (exists $reply->{request_id}) {
417 my $cv = delete $self->{cmd_cv}{$reply->{request_id}}; 427 my $cv = delete $self->{cmdcv}{$reply->{request_id}};
418 428
419 unless ($cv) { 429 unless ($cv) {
420 warn "no cv found for request id <$reply->{request_id}>\n"; 430 warn "no cv found for request id <$reply->{request_id}>\n";
421 next; 431 next;
422 } 432 }
442 $self->stop; 452 $self->stop;
443 $self->on_eof; 453 $self->on_eof;
444 } 454 }
445 }; 455 };
446 456
457 my $wbuf;
458 my $reqid;
459
447 $self->{_send} = sub { 460 $self->{_cmd} = sub {
448 $wbuf .= "$_[0]\n"; 461 my $cv = AE::cv;
449 462
463 $self->{cmdcv}{++$reqid} = $cv;
464
465 my $cmd = $JSON->new->utf8->encode ({ command => ref $_[0] ? $_[0] : \@_, request_id => $reqid*1 });
466
467 # (un-)apply escape_binary hack
468 $cmd =~ s/\xf4\x8e\x97\x9f(..)/sprintf sprintf "\\x%02x", hex $1/ges; # f48e979f == 10e5df in utf-8
469
450 $trace->(">mpv" => "$_[0]"); 470 $trace->(">mpv" => $cmd);
471
472 $wbuf .= "$cmd\n";
451 473
452 $self->{ww} ||= AE::io $fh, 1, sub { 474 $self->{ww} ||= AE::io $fh, 1, sub {
453 my $len = syswrite $fh, $wbuf; 475 my $len = syswrite $fh, $wbuf;
454 substr $wbuf, 0, $len, ""; 476 substr $wbuf, 0, $len, "";
455 undef $self->{ww} unless length $wbuf; 477 undef $self->{ww} unless length $wbuf;
456 }; 478 };
479
480 $cv
457 }; 481 };
458 482
459 1 483 1
484}
485
486sub DESTROY {
487 $_[0]->stop;
460} 488}
461 489
462=item $mpv->stop 490=item $mpv->stop
463 491
464Ensures that F<mpv> is being stopped, by killing F<mpv> with a C<TERM> 492Ensures that F<mpv> is being stopped, by killing F<mpv> with a C<TERM>
479 kill TERM => $self->{pid}; 507 kill TERM => $self->{pid};
480 508
481 } 509 }
482 510
483 delete $self->{pid}; 511 delete $self->{pid};
484 delete $self->{cmd_cv}; 512 delete $self->{cmdcv};
513 delete $self->{obsid};
514 delete $self->{obscb};
515 delete $self->{wbuf};
485} 516}
486 517
487=item $mpv->on_eof 518=item $mpv->on_eof
488 519
489This method is called when F<mpv> quits - usually unexpectedly. The 520This method is called when F<mpv> quits - usually unexpectedly. The
504 535
505This method is called when F<mpv> sends an asynchronous event. The default 536This method is called when F<mpv> sends an asynchronous event. The default
506implementation will call the C<on_event> code reference specified in the 537implementation will call the C<on_event> code reference specified in the
507constructor, or do nothing if none was given. 538constructor, or do nothing if none was given.
508 539
509The first/implicit argument is the C<$mpv> object, the second is the event 540The first/implicit argument is the C<$mpv> object, the second is the
510name (same as C<< $data->{event} >>, purely for convenience), and the 541event 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 542the 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. 543key). See L<List of events|https://mpv.io/manual/stable/#list-of-events>
544in its documentation.
513 545
514For subclassing, see I<SUBCLASSING>, below. 546For subclassing, see I<SUBCLASSING>, below.
515 547
516=cut 548=cut
517 549
576On error, the condvar will croak when C<recv> is called. 608On error, the condvar will croak when C<recv> is called.
577 609
578=cut 610=cut
579 611
580sub cmd { 612sub cmd {
581 my ($self, @cmd) = @_; 613 my $self = shift;
582 614
583 my $cv = AE::cv; 615 $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} 616}
597 617
598=item $result = $mpv->cmd_recv ($command => $arg, $arg...) 618=item $result = $mpv->cmd_recv ($command => $arg, $arg...)
599 619
600The same as calling C<cmd> and immediately C<recv> on its return 620The same as calling C<cmd> and immediately C<recv> on its return
612 632
613=item $mpv->bind_key ($INPUT => $string) 633=item $mpv->bind_key ($INPUT => $string)
614 634
615This is an extension implement by this module to make it easy to get key events. The way this is implemented 635This is an extension implement by this module to make it easy to get key events. The way this is implemented
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 636is to bind a C<client-message> witha first argument of C<AnyEvent::MPV> and the C<$string> you passed. This C<$string> is then
617passed ot the C<on_key> handle when the key is proessed, e.g.: 637passed to the C<on_key> handle when the key is proessed, e.g.:
618 638
619 my $mpv = AnyEvent::MPV->new ( 639 my $mpv = AnyEvent::MPV->new (
620 on_key => sub { 640 on_key => sub {
621 my ($mpv, $key) = @_; 641 my ($mpv, $key) = @_;
622 642
636sub bind_key { 656sub bind_key {
637 my ($self, $key, $event) = @_; 657 my ($self, $key, $event) = @_;
638 658
639 $event =~ s/([^A-Za-z0-9\-_])/sprintf "\\x%02x", ord $1/ge; 659 $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"); 660 $self->cmd (keybind => $key => "no-osd script-message AnyEvent::MPV key $event");
661}
662
663sub AnyEvent::MPV::Unobserve::DESTROY {
664 my ($mpv, $obscb, $obsid) = @{$_[0]};
665
666 delete $obscb->{$obsid};
667
668 if ($obscb == $mpv->{obscb}) {
669 $mpv->cmd (unobserve_property => $obsid+0);
670 }
671}
672
673=item [$guard] = $mpv->observe_property ($name => $coderef->($mpv, $name, $value))
674
675=item [$guard] = $mpv->observe_property_string ($name => $coderef->($mpv, $name, $value))
676
677These methods wrap a registry system around F<mpv>'s C<observe_property>
678and C<observe_property_string> commands - every time the named property
679changes, the coderef is invoked with the C<$mpv> object, the name of the
680property and the new value.
681
682For a list of properties that you can observe, see L<the mpv
683documentation|https://mpv.io/manual/stable/#property-list>.
684
685Due to the (sane :) way F<mpv> handles these requests, you will always
686get a property cxhange event right after registering an observer (meaning
687you don't have to query the current value), and it is also possible to
688register multiple observers for the same property - they will all be
689handled properly.
690
691When called in void context, the observer stays in place until F<mpv>
692is stopped. In any otrher context, these methods return a guard
693object that, when it goes out of scope, unregisters the observe using
694C<unobserve_property>.
695
696Internally, this method uses observer ids of 2**52 (0x10000000000000) or
697higher - it will not interfere with lower ovserver ids, so it is possible
698to completely ignore this system and execute C<observe_property> commands
699yourself, whilst listening to C<property-change> events - as long as your
700ids stay below 2**52.
701
702Example: register observers for changtes in C<aid> and C<sid>. Note that
703a dummy statement is added to make sure the method is called in void
704context.
705
706 sub register_observers {
707 my ($mpv) = @_;
708
709 $mpv->observe_property (aid => sub {
710 my ($mpv, $name, $value) = @_;
711 print "property aid (=$name) has changed to $value\n";
712 });
713
714 $mpv->observe_property (sid => sub {
715 my ($mpv, $name, $value) = @_;
716 print "property sid (=$name) has changed to $value\n";
717 });
718
719 () # ensure the above method is called in void context
720 }
721
722=cut
723
724sub _observe_property {
725 my ($self, $type, $property, $cb) = @_;
726
727 my $obsid = OBSID + ++$self->{obsid};
728 $self->cmd ($type => $obsid+0, $property);
729 $self->{obscb}{$obsid} = $cb;
730
731 defined wantarray and do {
732 my $unobserve = bless [$self, $self->{obscb}, $obsid], AnyEvent::MPV::Unobserve::;
733 Scalar::Util::weaken $unobserve->[0];
734 $unobserve
735 }
736}
737
738sub observe_property {
739 my ($self, $property, $cb) = @_;
740
741 $self->_observe_property (observe_property => $property, $cb)
742}
743
744sub observe_property_string {
745 my ($self, $property, $cb) = @_;
746
747 $self->_observe_property (observe_property_string => $property, $cb)
641} 748}
642 749
643=back 750=back
644 751
645=head2 SUBCLASSING 752=head2 SUBCLASSING

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines