| … | |
… | |
| 386 | my $trace = delete $self->{trace} || sub { }; |
386 | my $trace = delete $self->{trace} || sub { }; |
| 387 | |
387 | |
| 388 | $trace = sub { warn "$_[0] $_[1]\n" } if $trace && !ref $trace; |
388 | $trace = sub { warn "$_[0] $_[1]\n" } if $trace && !ref $trace; |
| 389 | |
389 | |
| 390 | my $buf; |
390 | my $buf; |
| 391 | my $wbuf; |
|
|
| 392 | |
391 | |
| 393 | Scalar::Util::weaken $self; |
392 | Scalar::Util::weaken $self; |
| 394 | |
393 | |
| 395 | $self->{rw} = AE::io $fh, 0, sub { |
394 | $self->{rw} = AE::io $fh, 0, sub { |
| 396 | if (sysread $fh, $buf, 8192, length $buf) { |
395 | if (sysread $fh, $buf, 8192, length $buf) { |
| … | |
… | |
| 442 | $self->stop; |
441 | $self->stop; |
| 443 | $self->on_eof; |
442 | $self->on_eof; |
| 444 | } |
443 | } |
| 445 | }; |
444 | }; |
| 446 | |
445 | |
|
|
446 | my $wbuf; |
|
|
447 | my $reqid; |
|
|
448 | |
| 447 | $self->{_send} = sub { |
449 | $self->{_cmd} = sub { |
|
|
450 | my $cv = AE::cv; |
|
|
451 | |
|
|
452 | $self->{cmd_cv}{++$reqid} = $cv; |
|
|
453 | |
|
|
454 | my $cmd = $JSON->new->utf8->encode ({ command => ref $_[0] ? $_[0] : \@_, request_id => $reqid*1 }); |
|
|
455 | |
|
|
456 | # (un-)apply escape_binary hack |
|
|
457 | $cmd =~ s/\xf4\x8e\x97\x9f(..)/sprintf sprintf "\\x%02x", hex $1/ges; # f48e979f == 10e5df in utf-8 |
|
|
458 | |
| 448 | $wbuf .= "$_[0]\n"; |
459 | $wbuf .= "$cmd\n"; |
| 449 | |
460 | |
| 450 | $trace->(">mpv" => "$_[0]"); |
461 | $trace->(">mpv" => "$_[0]"); |
| 451 | |
462 | |
| 452 | $self->{ww} ||= AE::io $fh, 1, sub { |
463 | $self->{ww} ||= AE::io $fh, 1, sub { |
| 453 | my $len = syswrite $fh, $wbuf; |
464 | my $len = syswrite $fh, $wbuf; |
| 454 | substr $wbuf, 0, $len, ""; |
465 | substr $wbuf, 0, $len, ""; |
| 455 | undef $self->{ww} unless length $wbuf; |
466 | undef $self->{ww} unless length $wbuf; |
| 456 | }; |
467 | }; |
|
|
468 | |
|
|
469 | $cv |
| 457 | }; |
470 | }; |
| 458 | |
471 | |
| 459 | 1 |
472 | 1 |
|
|
473 | } |
|
|
474 | |
|
|
475 | sub DESTROY { |
|
|
476 | $_[0]->stop; |
| 460 | } |
477 | } |
| 461 | |
478 | |
| 462 | =item $mpv->stop |
479 | =item $mpv->stop |
| 463 | |
480 | |
| 464 | Ensures that F<mpv> is being stopped, by killing F<mpv> with a C<TERM> |
481 | Ensures that F<mpv> is being stopped, by killing F<mpv> with a C<TERM> |
| … | |
… | |
| 480 | |
497 | |
| 481 | } |
498 | } |
| 482 | |
499 | |
| 483 | delete $self->{pid}; |
500 | delete $self->{pid}; |
| 484 | delete $self->{cmd_cv}; |
501 | delete $self->{cmd_cv}; |
|
|
502 | delete $self->{obsid}; |
|
|
503 | delete $self->{wbuf}; |
| 485 | } |
504 | } |
| 486 | |
505 | |
| 487 | =item $mpv->on_eof |
506 | =item $mpv->on_eof |
| 488 | |
507 | |
| 489 | This method is called when F<mpv> quits - usually unexpectedly. The |
508 | This method is called when F<mpv> quits - usually unexpectedly. The |
| … | |
… | |
| 577 | On error, the condvar will croak when C<recv> is called. |
596 | On error, the condvar will croak when C<recv> is called. |
| 578 | |
597 | |
| 579 | =cut |
598 | =cut |
| 580 | |
599 | |
| 581 | sub cmd { |
600 | sub cmd { |
| 582 | my ($self, @cmd) = @_; |
601 | my $self = shift; |
| 583 | |
602 | |
| 584 | my $cv = AE::cv; |
603 | $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 | } |
604 | } |
| 598 | |
605 | |
| 599 | =item $result = $mpv->cmd_recv ($command => $arg, $arg...) |
606 | =item $result = $mpv->cmd_recv ($command => $arg, $arg...) |
| 600 | |
607 | |
| 601 | The same as calling C<cmd> and immediately C<recv> on its return |
608 | The same as calling C<cmd> and immediately C<recv> on its return |
