#
# 80_xxLG7000.pm; an FHEM module for interfacing
# with LG's Scarlet Series of LCDs (e. g. LG 47LG7000)
#
# Written by Kai 'wusel' Siering <wusel+fhem@uu.org> around 2010-01-20
# $Id$
#
# re-using code of 80_M232.pm by Dr. Boris Neubert
##############################################
package main;

use strict;
use warnings;


sub xxLG7000Write($$);
sub xxLG7000GetData($$);
sub Log($$);
use vars qw {%attr %defs};

my %commands = (
  "power state"      => "ka %x FF\r",
  "power on"         => "ka %x 01\r",
  "power off"        => "ka %x 00\r",
  "input AV1"        => "xb %x 20\r",
  "input AV2"        => "xb %x 21\r",
  "input AV3"        => "xb %x 22\r",
  "input AV4"        => "xb %x 23\r",
  "input Component"  => "xb %x 40\r",
  "input RGB-PC"     => "xb %x 50\r",
  "input HDMI1"      => "xb %x 90\r",
  "input HDMI2"      => "xb %x 91\r",
  "input HDMI3"      => "xb %x 92\r",
  "input HDMI4"      => "xb %x 93\r",
  "input DVB-T"      => "xb %x 00\r",
  "input PAL"        => "xb %x 10\r",
  "selected input"   => "xb %x FF\r",
  "audio mute"       => "ke %x 00\r",
  "audio normal"     => "ke %x 01\r",
  "audio state"      => "ke %x FF\r",
);

my %responses = (
  "a OK00"    => "power off",
  "a OK01"    => "power on",
  "b OK20"    => "input AV1",
  "b OK21"    => "input AV2",
  "b OK22"    => "input AV3",
  "b OK23"    => "input AV4",
  "b OK90"    => "input HDMI1",
  "b OK91"    => "input HDMI2",
  "b OK92"    => "input HDMI3",
  "b OK93"    => "input HDMI4",
  "b OKa0"    => "input HDMI1-no_link", # At least 47LG7000 returns 10100001 instead of 10010001 when
  "b OKa1"    => "input HDMI2-no_link", # there is no link/signal connected to the corresponding
  "b OKa2"    => "input HDMI3-no_link", # HDMI input. -wusel, 2010-01-20
  "b OKa3"    => "input HDMI4-no_link",
  "b OK40"    => "input Components",
  "b OK50"    => "input RGB-PC",
  "b OK10"    => "input PAL",           # Selecting analogue (dubbed PAL here) input does not work for
  "b OK00"    => "input DVB-T",         # me; well, there's nothing to see anymore anyway, at least
  "e OK00"    => "audio muted",         # in Germany ;) (Ack, I don't have CATV.) -wusel, 2010-01-20
  "e OK01"    => "audio normal",
);



#####################################
sub
xxLG7000_Initialize($)
{
  my ($hash) = @_;

# Provider
  $hash->{WriteFn} = "xxLG7000_Write";
  $hash->{Clients} = ":LGTV:";
# No ReadFn as this is a purely command->response interface, in contrast
# to e. g. CUL which send's data on it's own. -wusel

# Consumer
  $hash->{DefFn}   = "xxLG7000_Define";
  $hash->{UndefFn} = "xxLG7000_Undef";
  $hash->{AttrList}= "SetID:1,2,... loglevel:0,1,2,3,4,5";
}


#####################################
sub
xxLG7000_Define($$)
{
  my ($hash, $def) = @_;
  my @a = split("[ \t][ \t]*", $def);

  $hash->{STATE} = "Initialized";

  my $dev = $a[2];
  if($dev eq "none") {
    Log 1, "xxLG7000 device is none, commands will be echoed only";
    return undef;
  }

  Log 3, "xxLG7000 opening device $dev";
  my $po;
	if ($^O eq 'MSWin32') {
		eval ("use Win32::SerialPort;");
		if ($@) {
                   $hash->{STATE} = "error using Modul Win32::SerialPort";
                   Log 1,"Error using Device::SerialPort";
                   return "Can't use Win32::SerialPort $@\n";
                }
                $po = new Win32::SerialPort ($dev, 1);
                
	} else {
		eval ("use Device::SerialPort;");
		if ($@) {
                   $hash->{STATE} = "error using Modul Device::SerialPort";
                   Log 1,"Error using Device::SerialPort";
                   return "Can't Device::SerialPort $@\n";
                }
		$po = new Device::SerialPort ($dev, 1);
	}
	if (!$po) {
                   $hash->{STATE} = "error opening device";
                   Log 1,"Error opening Serial Device $dev";
                   return "Can't open Device $dev: $^E\n";
	}
  
  Log 3, "xxLG7000 opened device $dev";
  $po->close();

  $hash->{DeviceName} = $dev;
  $attr{$a[0]}{SetID}=1;
  return undef;
}


#####################################
sub
xxLG7000_Undef($$)
{
  my ($hash, $arg) = @_;
  my $name = $hash->{NAME};

  foreach my $d (sort keys %defs) {
    if(defined($defs{$d}) &&
       defined($defs{$d}{IODev}) &&
       $defs{$d}{IODev} == $hash)
      {
        my $lev = ($reread_active ? 4 : 2);
        Log GetLogLevel($name,$lev), "deleting port for $d";
        delete $defs{$d}{IODev};
      }
  }
  return undef;
}


#####################################
# implement ReadyFn, only used for Win32
sub
xxLG7000_Ready($$)
{
  my ($hash, $dev) = @_;
  my $po=$dev||$hash->{po};
  return 0 if !$po;
  my ($BlockingFlags, $InBytes, $OutBytes, $ErrorFlags)=$po->status;
  return ($InBytes>0);
}


#####################################
sub
xxLG7000_Write($$)
{
  my ($hash,$msg) = @_;
  my $dev = $hash->{DeviceName};
  my $UnitNo=1;
  my $ret;
  my $retmsg="error occured";
  my $myname=$hash->{NAME};


  if(defined($attr{$myname}{SetID})) {
      $UnitNo=$attr{$myname}{SetID};
      Log $UnitNo==1?5:4, "xxLG7000_Write: Using SetID $UnitNo for $myname.";
  }

  my $sendstring=$commands{$msg};

  if(!defined($sendstring)) {
      return "error unknown command $msg, choose one of " . join(" ", sort keys %commands);
  }

  $sendstring=sprintf($sendstring, $UnitNo);
  Log 5, "xxLG7000_Write: sending $sendstring";
  $ret=xxLG7000GetData($hash, $sendstring);
  if(!defined($ret) || length($ret)<=6) {
      Log 2, "xxLG7000_Write: error, got too short answer ($ret).";
  } else {
      Log 5, "xxLG7000_Write: wrote $msg, received $ret";

      $retmsg=sprintf("%s %s", substr($ret, 0, 1), substr($ret, 5));
      $retmsg=$responses{$retmsg};
      if(!defined($retmsg)) {
	  if(substr($ret, 5, 2) eq "NG") {
	      $retmsg="error message";
	      Log 5, "xxLG7000_Write: error message: $ret";
	  } else {
	      Log 2, "xxLG7000_Write: Unknown response $ret, help me!";
	      $retmsg=sprintf("error message_unknown:%s", $ret =~ s/ /_/);
	  }
      } else {
	  Log 5, "xxLG7000_Write: returns $retmsg";
      }
  }

  return $retmsg;
}


#####################################
sub
xxLG7000GetData($$)
{
    my ($hash, $data) = @_;
    my $dev=$hash->{DeviceName};
    my $serport;
    my $d = $data;
    my $MSGACK= 'x';
    
    if ($^O eq 'MSWin32') {
	$serport=new Win32::SerialPort ($dev, 1);
    } else {
	$serport=new Device::SerialPort ($dev, 1);
    }
    if(!$serport) {
	Log 3, "xxLG7000: Can't open $dev: $!";
	return undef;
    }
    $serport->reset_error();
    $serport->baudrate(9800);
    $serport->databits(8);
    $serport->parity('none');
    $serport->stopbits(1);
    $serport->handshake('none');
    $serport->write_settings;
    $hash->{po}=$serport;
    Log 4, "xxLG7000: Sending $d";
    
    my $rm = "xxLG7000: ?";
    
    $serport->lookclear;
    $serport->write($d);
    
    my $retval = "";
    my $status = "";
    my $nfound=0;
    my $ret=undef;
    sleep(1);
    for(;;) {
	if ($^O eq 'MSWin32') {
	    $nfound=xxLG7000_Ready($hash,undef);
	} else {
	    my ($rout, $rin) = ('', '');
	    vec($rin, $serport->FILENO, 1) = 1;
	    $nfound = select($rin, undef, undef, 1.0); # 3 seconds timeout
	    if($nfound < 0) {
		next if ($! == EAGAIN() || $! == EINTR() || $! == 0);
		$rm="xxLG7000:Select error $nfound / $!";
		last;
	    }
	}
	
	last if($nfound == 0);
	
	my $out = $serport->read(1);
	if(!defined($out) || length($out) == 0) {
	    $rm = "xxLG7000 EOF on $dev";
	    last;
	}
	
	if($out eq $MSGACK) {
	    $rm= "xxLG7000: acknowledged";
	    Log 4, "xxLG7000: return value \'" . $retval . "\'";
	    $status= "ACK";
	} else {
	    $retval .= $out;
	}
	
	if($status) {
	    $ret=$retval;
	    last;
	}
	
    }
    
  DONE:
    $serport->close();
    undef $serport;
    delete $hash->{po} if exists($hash->{po});
    Log 4, $rm;
    return $ret;
}

1;
