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.8 by root, Mon Mar 20 11:12:40 2023 UTC vs.
Revision 1.9 by root, Mon Mar 20 12:23:21 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.1';
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
… …
407 ) { 411 ) {
408 if ($reply->{args}[1] eq "key") { 412 if ($reply->{args}[1] eq "key") {
409 (my $key = $reply->{args}[2]) =~ s/\\x(..)/chr hex $1/ge; 413 (my $key = $reply->{args}[2]) =~ s/\\x(..)/chr hex $1/ge;
410 $self->on_key ($key); 414 $self->on_key ($key);
411 } 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 }
412 } else { 423 } else {
413 $self->on_event (delete $reply->{event}, $reply); 424 $self->on_event (delete $reply->{event}, $reply);
414 } 425 }
415 } elsif (exists $reply->{request_id}) { 426 } elsif (exists $reply->{request_id}) {
416 my $cv = delete $self->{cmd_cv}{$reply->{request_id}}; 427 my $cv = delete $self->{cmdcv}{$reply->{request_id}};
417 428
418 unless ($cv) { 429 unless ($cv) {
419 warn "no cv found for request id <$reply->{request_id}>\n"; 430 warn "no cv found for request id <$reply->{request_id}>\n";
420 next; 431 next;
421 } 432 }
… …
447 my $reqid; 458 my $reqid;
448 459
449 $self->{_cmd} = sub { 460 $self->{_cmd} = sub {
450 my $cv = AE::cv; 461 my $cv = AE::cv;
451 462
452 $self->{cmd_cv}{++$reqid} = $cv; 463 $self->{cmdcv}{++$reqid} = $cv;
453 464
454 my $cmd = $JSON->new->utf8->encode ({ command => ref $_[0] ? $_[0] : \@_, request_id => $reqid*1 }); 465 my $cmd = $JSON->new->utf8->encode ({ command => ref $_[0] ? $_[0] : \@_, request_id => $reqid*1 });
455 466
456 # (un-)apply escape_binary hack 467 # (un-)apply escape_binary hack
457 $cmd =~ s/\xf4\x8e\x97\x9f(..)/sprintf sprintf "\\x%02x", hex $1/ges; # f48e979f == 10e5df in utf-8 468 $cmd =~ s/\xf4\x8e\x97\x9f(..)/sprintf sprintf "\\x%02x", hex $1/ges; # f48e979f == 10e5df in utf-8
458 469
470 $trace->(">mpv" => $cmd);
471
459 $wbuf .= "$cmd\n"; 472 $wbuf .= "$cmd\n";
460
461 $trace->(">mpv" => "$_[0]");
462 473
463 $self->{ww} ||= AE::io $fh, 1, sub { 474 $self->{ww} ||= AE::io $fh, 1, sub {
464 my $len = syswrite $fh, $wbuf; 475 my $len = syswrite $fh, $wbuf;
465 substr $wbuf, 0, $len, ""; 476 substr $wbuf, 0, $len, "";
466 undef $self->{ww} unless length $wbuf; 477 undef $self->{ww} unless length $wbuf;
… …
496 kill TERM => $self->{pid}; 507 kill TERM => $self->{pid};
497 508
498 } 509 }
499 510
500 delete $self->{pid}; 511 delete $self->{pid};
501 delete $self->{cmd_cv}; 512 delete $self->{cmdcv};
502 delete $self->{obsid}; 513 delete $self->{obsid};
514 delete $self->{obscb};
503 delete $self->{wbuf}; 515 delete $self->{wbuf};
504} 516}
505 517
506=item $mpv->on_eof 518=item $mpv->on_eof
507 519
… …
620 632
621=item $mpv->bind_key ($INPUT => $string) 633=item $mpv->bind_key ($INPUT => $string)
622 634
623This 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
624is 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
625passed 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.:
626 638
627 my $mpv = AnyEvent::MPV->new ( 639 my $mpv = AnyEvent::MPV->new (
628 on_key => sub { 640 on_key => sub {
629 my ($mpv, $key) = @_; 641 my ($mpv, $key) = @_;
630 642
… …
644sub bind_key { 656sub bind_key {
645 my ($self, $key, $event) = @_; 657 my ($self, $key, $event) = @_;
646 658
647 $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;
648 $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
696Example: register observers for changtes in C<aid> and C<sid>. Note that
697a dummy statement is added to make sure the method is called in void
698context.
699
700 sub register_observers {
701 my ($mpv) = @_;
702
703 $mpv->observe_property (aid => sub {
704 my ($mpv, $name, $value) = @_;
705 print "property aid (=$name) has changed to $value\n";
706 });
707
708 $mpv->observe_property (sid => sub {
709 my ($mpv, $name, $value) = @_;
710 print "property sid (=$name) has changed to $value\n";
711 });
712
713 () # ensure the above method is called in void context
714 }
715
716=cut
717
718sub _observe_property {
719 my ($self, $type, $property, $cb) = @_;
720
721 my $obsid = OBSID + ++$self->{obsid};
722 $self->cmd ($type => $obsid+0, $property);
723 $self->{obscb}{$obsid} = $cb;
724
725 defined wantarray and do {
726 my $unobserve = bless [$self, $self->{obscb}, $obsid], AnyEvent::MPV::Unobserve::;
727 Scalar::Util::weaken $unobserve->[0];
728 $unobserve
729 }
730}
731
732sub observe_property {
733 my ($self, $property, $cb) = @_;
734
735 $self->_observe_property (observe_property => $property, $cb)
736}
737
738sub observe_property_string {
739 my ($self, $property, $cb) = @_;
740
741 $self->_observe_property (observe_property_string => $property, $cb)
649} 742}
650 743
651=back 744=back
652 745
653=head2 SUBCLASSING 746=head2 SUBCLASSING

Diff Legend

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