view release on metacpan or  search on metacpan

lib/AnyEvent/Onkyo.pm  view on Meta::CPAN

use strict;
use warnings;
package AnyEvent::Onkyo;
{
  $AnyEvent::Onkyo::VERSION = '1.130220';
}
use base 'Device::Onkyo';
use AnyEvent::Handle;
use AnyEvent::SerialPort;
use Carp qw/croak carp/;
use Sub::Name;
use Scalar::Util qw/weaken/;

use constant {
  DEBUG => $ENV{ANYEVENT_ONKYO_DEBUG},
};


# ABSTRACT: AnyEvent module for controlling Onkyo/Integra AV equipment


sub new {
  my ($pkg, %p) = @_;
  croak $pkg.'->new: callback parameter is required' unless ($p{callback});
  my $self = $pkg->SUPER::new(device => 'discover', %p);
  $self;
}


sub command {
  my $self = shift;
  my $cv = AnyEvent->condvar;
  my $weak_cv = $cv;
  weaken $weak_cv;
  $self->SUPER::command(@_, subname 'command_cb' => sub {
                          $weak_cv->send() if ($weak_cv);
                        });
  return $cv;
}

sub _open {
  my $self = shift;
  $self->SUPER::_open($self->_open_condvar);
  return 1;
}

sub _open_tcp_port {
  my ($self, $cv) = @_;
  my $dev = $self->{device};
  print STDERR "Opening $dev as tcp socket\n" if DEBUG;
  my ($host, $port) = split /:/, $dev, 2;
  $port = $self->{port} unless (defined $port);
  $self->{handle} =
    AnyEvent::Handle->new(connect => [$host, $port],
                          on_connect => subname('tcp_connect_cb' => sub {
                            my ($hdl, $h, $p) = @_;
                            warn ref $self, " connected to $h:$p\n" if DEBUG;
                            $cv->send();
                          }),
                          on_connect_error =>
                          subname('tcp_connect_error_cb' => sub {
                            my ($hdl, $msg) = @_;
                            my $err =
                              (ref $self).": Can't connect to $dev: $msg";
                            warn "Connect error: $err\n" if DEBUG;
                            $self->cleanup($err);
                            $cv->croak;
                          }));
  return $cv;
}

sub _open_serial_port {
  my ($self, $cv) = @_;
  $self->{handle} =
    AnyEvent::SerialPort->new(serial_port =>
                              [ $self->device,
                                [ baudrate => $self->baud ] ]);
  $cv->send();
  return $cv;
}

sub _handle_setup {
  my $self = shift;
  my $handle = $self->{handle};
  my $weak_self = $self;
  weaken $weak_self;

  $handle->on_error(subname('on_error' => sub {
                              my ($hdl, $fatal, $msg) = @_;
                              print STDERR $hdl.": error $msg\n" if DEBUG;
                              $hdl->destroy;
                              if ($fatal) {
                                $weak_self->cleanup($msg);
                              }
                            }));

  $handle->on_eof(subname('on_eof' => sub {
                            my ($hdl) = @_;
                            print STDERR $hdl.": eof\n" if DEBUG;
                            $weak_self->cleanup('connection closed');
                          }));

  $handle->on_read(subname 'on_read_cb' => sub {