# # 80_xxLG7000.pm; an FHEM module for interfacing # with LG's Scarlet Series of LCDs (e. g. LG 47LG7000) # # Written by Kai 'wusel' Siering 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; =pod =begin html

xxLG7000

=end html =cut