#!/usr/bin/perl -w
# Copyright © 2006-2013 Jamie Zawinski <jwz@jwz.org>
#
# Permission to use, copy, modify, distribute, and sell this software and its
# documentation for any purpose is hereby granted without fee, provided that
# the above copyright notice appear in all copies and that both that
# copyright notice and this permission notice appear in supporting
# documentation.  No representations are made about the suitability of this
# software for any purpose.  It is provided "as is" without express or 
# implied warranty.
#
# Speaks the Denon AVR/AVC control protocol language, over either serial
# or ethernet.  Lets you switch inputs, volume, etc. remotely.
#
# Examples:
#
#	tuner power=off
#	tuner input=dvr
#	tuner mute=on
#	tuner mute=off
#	tuner input=query			; to see what it is
#	tuner volume=query			; to see what it is
#	tuner volume='-40.5 dB'			; set to absolute value
#	tuner volume=up				; change by +0.5dB
#	tuner volume=down			; change by -0.5dB
#	tuner volume=up6			; change by +3dB (6 x 0.5)
#	tuner power=on input=tv volume=up	; multiple commands
#
#
# If you have an older model Denon with only a serial port, this code
# can talk to it over a serial cable.  Alternately, you can put a
# serial-to-ethernet adapter on it (e.g., a Lantronix UDS-10) and
# talk to it over the network.
#
# Tested with:
#  - Denon AVR-2805 tuner, which has only a serial port.
#  - Denon AVR-2313CI tuner, which has ethernet.
#
# http://usa.denon.com/DocumentMaster/US/AVR-3808CISerialProtocol_Ver5.2.0a.pdf
#
# Created: 19-Nov-2006.

require 5;
use diagnostics;
use strict;

use POSIX;
use Socket;
use IO::Handle;
use Fcntl;
use Fcntl ':flock'; # import LOCK_* constants

my $progname = $0; $progname =~ s@.*/@@g;
my $version = q{ $Revision: 1.8 $ }; $version =~ s/^[^0-9]+([0-9.]+).*$/$1/;

my $verbose = 0;
my $debug   = 0;

#my $device = "/dev/ttyS0";	# serial port
my $device = "tuner:23";	# or hostname and tcp port
my $speed = B9600;

my $native_ethernet_p = 1;	# Set this if Denon has built-in ethernet.
				# We insert more delays on older models.


my $http_proxy = undef;

# The manual says that after sending a command, "the response should be
# sent within 200 milliseconds of receiving the command."
#
# What it doesn't say is that after reading the response for one command,
# you have to wait nearly a FULL SECOND before sending a second command,
# and if you don't, BOTH commands are ignored!
#
my $command_delay = 0.95;


my $CONN;
my $first_open_p = 1;

sub open_serial() {

  if ($debug) {
    open ($CONN, '+<', "/dev/null");
    print STDERR "$progname: opened /dev/null (debug mode)\n"
      if ($verbose);
    return;
  }

  if ($device =~ m@^([^:/]+):([^:/.]+)$@) {   # host:port, not local serial

    my $host = $1;
    my $port = $2;

    my $host2 = $host;
    my $port2 = $port;
    if ($http_proxy) {
      $device = $http_proxy if $http_proxy;
      ($host2,$port2) = split(/:/, $device);
      $port2 = 80 unless $port2;
    }

    my ($remote, $iaddr, $paddr, $proto, $line);
    $remote = $host2;
    if ($port2 =~ /\D/) { $port2 = getservbyname($port2, 'tcp') }
    error ("unrecognised port: $port2") unless ($port2);
    $iaddr   = inet_aton($remote);
    error ("host not found: $remote") unless ($iaddr);
    $paddr = sockaddr_in($port2, $iaddr);
    $proto = getprotobyname('tcp');

    print STDERR "$progname: connecting to $device\n" if ($verbose);

    {
      my $secs = 2;		# If we're reconnecting, busy-wait trying to
      my $count = 0;		# connect for this many seconds.  But on the
      my $start = time();	# first connection attempt, only try once.

      local $SIG{ALRM} = sub { error ("connect: $device: timed out"); };
      alarm ($secs + 1);

      while (1) {
        $count++;
        error ("socket: $!")
          unless socket ($CONN, PF_INET, SOCK_STREAM, $proto);
        last if (connect($CONN, $paddr));
        error ("connect: $device: $! (on first connect)")
          if ($first_open_p);
        error ("connect: $device: $! (after $count tries)")
          if (time() >= $start + $secs);
      }
      $first_open_p = 0;

      print STDERR "$progname: connected to $device (after $count tries)\n"
        if ($verbose);
    }

    # Set unbuffered (is this necessary?)
    #
    select((select($CONN), $| = 1)[0]);

    # Set nonblocking
    #
    my $flags = fcntl($CONN, F_GETFL, 0) ||
      error ("can't get flags for the socket: $!");
    $flags = fcntl($CONN, F_SETFL, $flags | O_NONBLOCK) ||
      error ("can't set flags for the socket: $!");

    print STDERR "$progname: initialized connection\n" if ($verbose);

  } else {                               # local serial port

    #open ($CONN, '+<', $device) || error ("$device: $!")";
    sysopen ($CONN, $device, O_RDWR|O_NONBLOCK|O_NOCTTY|O_EXCL) ||
      error ("$device: $!");

    print STDERR "$progname: opened $device\n" if ($verbose);

    # Set unbuffered (is this necessary?)
    #
    select((select($CONN), $| = 1)[0]);

    # Set line speed
    #
    my $t =  POSIX::Termios->new;
    $t->getattr(fileno($CONN));
    $t->setispeed($speed);
    $t->setospeed($speed);
    $t->setattr(fileno($CONN), TCSANOW);

    print STDERR "$progname: initialized $device\n" if ($verbose);
  }

  # Flush any bits on the stream already.
  #
  my $buf = "";
  while (sysread($CONN, $buf, 1024)) {
    if ($verbose) {
      $buf =~ s/\r\n/\n/g;
      $buf =~ s/\r/\n/g;
      $buf =~ s/\n$//s;
      foreach (split (/\n/, $buf)) {
        $_ = sprintf "%-8s (flush)", $_;
        print STDERR "$progname: <<< $_\n";
      }
    }
  }
}

sub close_serial() {
  if ($debug) {
    print STDERR "$progname: close (debug)\n";
    return;
  }
  close $CONN || error ("$device: $!");
  print STDERR "$progname: closed $device\n" if ($verbose);
}


# Like sleep but is guaranteed to work on fractions of a second.
sub my_sleep($) {
  my ($secs) = @_;
  print STDERR "$progname:    sleep $secs\n" if ($verbose > 2);
  select(undef, undef, undef, $secs);
}


# write a one-line command.
#
sub raw_cmd($) {
  my ($cmd) = @_;
  $cmd =~ s/[\r\n]+$//gs;

  (print $CONN "$cmd\r\n") || error ("$device: $!");
  print STDERR "$progname:  >>> $cmd\n" if ($verbose > 1);
}

# read a response from a command.
# This is assumed to be a single line.
#
sub raw_reply() {

  return "" if $debug;

  my $wait = $command_delay;   # wait no longer than this long for a reply.

  my $result = "";
  while (1) {
    my $rin='';
    my $rout;
    vec($rin,fileno($CONN),1) = 1;

    my $nfound = select($rout=$rin, undef, undef, $wait);
    $wait = 0;
    last unless $nfound;
    my $buf = '';
    while (sysread ($CONN, $buf, 1024)) {
      $result .= $buf;
    }
  }

  # convert linebreaks.
  #
  $result =~ s/\r\n/\n/g;
  $result =~ s/\r/\n/g;

  # print what we got...
  #
  if ($verbose > 1) {
    if ($result =~ m/^\s*$/s) {
      print STDERR "$progname:  <<< no reply!\n";
      } else {
        foreach (split (/\n/, $result)) {
          print STDERR "$progname:  <<< $_\n";
        }
    }
  }

  return $result;
}


sub denon_raw_command($$$) {
  my ($cmd, $rawcmd, $queryp) = @_;

  raw_cmd ($rawcmd);
  my $result = raw_reply ();

  if ($queryp) {
    if ($result =~ m/^\s*$/s) {
      print STDOUT "$progname: $cmd = FAIL!\n";
    }

    foreach my $line (split (/\n/, $result)) {
      my $cmd2;
      ($cmd2, $line) = ($line =~ m/^(..)(.*)/s);
      if ($cmd2 eq 'MV') {
        my $n = $line;
        $n .= "0" if ($n =~ /^..$/);
        $line = sprintf ("%.1f dB", (800 - $n) / -10.0);
      }

      if    ($cmd2 eq 'PW') { $cmd2 = 'POWER';  }
      elsif ($cmd2 eq 'SI') { $cmd2 = 'INPUT';  }
      elsif ($cmd2 eq 'MU') { $cmd2 = 'MUTE';   }
      elsif ($cmd2 eq 'MV') { $cmd2 = 'VOLUME'; }

      print STDOUT "$progname: $cmd2 = $line\n";
    }
  }
}


# Converts a dB value to the integral range Denon uses.
#
sub db_to_raw($) {
  my ($arg) = @_;
  my $db = $arg;
  $db =~ s/^\+//;
  $db += 0.0;
  error ("dB must be in range -80.0 to -1.0, not \"$arg\"")
    unless ($db <= -1.0 && $db >= -80.0);

  #   +1.0 dB  810
  #   +0.5 dB  805
  #    0.0 dB  800
  #   -0.5 dB  795
  #   -1.0 dB  790
  #   -1.5 dB  785
  #   -2.0 dB  780
  #       ...
  #  -79.5 dB  005
  #  -80.0 dB  000
  #       ---  990

  return (800 - int ($db * -10));
}


sub current_volume() {
  raw_cmd ('MV?');
  my $result = raw_reply ();
  if ($result =~ m/^MV(\d+)$/m) {
    my $n = $1;
    $n .= '0' if ($n =~ m/^..$/);
    $result = $n;
  } else {
    print STDOUT "$progname: FAIL getting current volume!\n";
    exit 1;
  }

  if ($native_ethernet_p) {
    close_serial();
    open_serial();
  }

  return $result;
}


sub denon_command($) {
  my ($cmd) = @_;

  $cmd = uc($cmd);
  my $arg = undef;

  if ($cmd =~ m/^([^=]+)\s*=\s*(.*)$/si) {
    ($cmd, $arg) = ($1, $2);
    $arg = undef if ($arg eq '');
  }

  $arg = '?' if (defined($arg) && $arg eq 'QUERY');

  my $rawcmd;
  if ($cmd =~ m/^INPUT$/si) {
    $rawcmd = "SI";

    # aliases
    if (!defined($arg))                { $arg = '?';         }
    elsif ($arg =~ m/^(DBS)$/si)       { $arg = 'DBS/SAT';   }
    elsif ($arg =~ m/^(SAT)$/si)       { $arg = 'SAT/CBL';   }
    elsif ($arg =~ m/^VAUX|AUX$/si)    { $arg = 'V.AUX';     }
    elsif ($arg =~ m/^CDR|TAPE-?1$/si) { $arg = 'CDR/TAPE1'; }
    elsif ($arg =~ m/^MD|TAPE-?2$/si)  { $arg = 'MD/TAPE2';  }
    elsif ($arg =~ m/^(VCR)(\d)$/si)   { $arg = "$1-$2";     }
    elsif ($arg =~ m/^(NET|USB)$/si)   { $arg = 'NET/USB';   }
    elsif ($arg =~ m/^(TV)$/si)        { $arg = 'TV/CBL';    }

    error ("unknown input source: $arg")
      unless ($arg =~ m@^(\?|PHONO|CD|TUNER|DVD|HDP|VDP|TV/CBL|SAT|DBS/SAT|
			  SAT/CBL|VCR|VCR-[123]|DVR|V\.AUX|CDR/TAPE1|MD/TAPE2|
			  NET/USB|XM|IPOD)$@xsi);
    $rawcmd .= $arg;

  } elsif ($cmd =~ m/^MUTE$/si) {
    if (! defined($arg))       { $arg = 'ON';   }
    elsif ($arg =~ m/^ON$/si)  { $arg = 'ON';   }
    elsif ($arg =~ m/^OFF$/si) { $arg = 'OFF';  }
    elsif ($arg =~ m/^\?$/si)  { $arg = '?';    }
    else { error ("mute: on or off, not $arg"); }
    $rawcmd = "MU$arg";

  } elsif ($cmd =~ m/^UNMUTE$/si) {
    error ("unmute: no args allowed: $arg") if defined($arg);
    $rawcmd = "MUOFF";

  } elsif ($cmd =~ m/^POWER$/si) {
    if (! defined($arg))       { $arg = '?';       }
    elsif ($arg =~ m/^\?$/si)  { $arg = '?';       }
    elsif ($arg =~ m/^ON$/si)  { $arg = 'ON';      }
    elsif ($arg =~ m/^OFF$/si) { $arg = 'STANDBY'; }
    else { error ("power: on or off, not $arg");   }
    $rawcmd = "PW$arg";

  } elsif ($cmd =~ m/^VOL(UME)?$/si) {
    my $change;
    if (! defined($arg))              { $arg = '?';      }
    elsif ($arg =~ m/^\?$/si)         { $arg = '?';      }
    elsif ($arg =~ m/^UP\s*([\d.]+)?$/si)   { $arg = 'UP';
                                              $change = $1 if $1; }
    elsif ($arg =~ m/^DOWN\s*([\d.]+)?$/si) { $arg = 'DOWN';
                                              $change = -$1 if $1; }
    elsif ($arg =~ m/^([-+]?\d+\.?\d*)\s*(dB)?$/si) {
      $arg = sprintf("%03d", db_to_raw ($1));
      $arg =~ s/0$//;
    }
    else { error ("volume: UP, DOWN, or 'NN dB', not $arg"); }

    if (defined ($change)) {
      $arg = current_volume();
      $arg += $change * 10;
      $arg = sprintf("%03d", $arg);
      $arg =~ s/0$//;
      my_sleep ($command_delay * 1.5)  # WTF!  COME ON!
        unless ($native_ethernet_p);
    }

    $rawcmd = "MV$arg";
  } else {
    usage();
    exit 1;
  }

  my $queryp = 1 if ($arg eq '?' || $verbose);
  denon_raw_command ($cmd, $rawcmd, $queryp);
}


sub error($) {
  my ($err) = @_;
  print STDERR "$progname: $err\n";
  exit 1;
}

sub usage() {
  print STDERR "usage: $progname [--verbose] CMD=ARG ...\n" .
    "\n" .
    "    Commands:  Args:\n" .
    "\n" .
    "      INPUT    QUERY PHONO CD TUNER DVD VDP HDP DBS DVR SAT\n" .
    "               TV VCR VCR-1 VCR-2 VCR-3 AUX TAPE-1 TAPE-2\n" .
    "               NET USB XM IPOD\n" .
    "      MUTE     QUERY ON OFF\n" .
    "      POWER    QUERY ON OFF\n" .
    "      VOLUME   QUERY UP DOWN  \"NN dB\"" .
    "               UPn DOWNn (where 'n' is a dB value)\n" .
    "\n";
  exit 1;
}

sub main() {
  my @cmds;
  while ($#ARGV >= 0) {
    $_ = shift @ARGV;
    if (m/^--?verbose$/) { $verbose++; }
    elsif (m/^-v+$/) { $verbose += length($_)-1; }
    elsif (m/^--?debug$/) { $debug++; }
    elsif (m/^-[^\d]/) { usage; }
    else { push @cmds, $_; }
  }

  usage unless ($#cmds >= 0);

  open_serial() unless ($native_ethernet_p);

  my $count = 0;
  foreach (@cmds) {
    my_sleep ($command_delay) if ($count > 0 && !$native_ethernet_p);
    open_serial() if ($native_ethernet_p);
    denon_command ($_);
    close_serial() if ($native_ethernet_p);
    $count++;
  }

  close_serial() unless ($native_ethernet_p);
}

main();
exit 0;