mirror of
https://github.com/fhem/fhem-mirror.git
synced 2025-03-13 17:26:34 +00:00
*** empty log message ***
git-svn-id: https://svn.fhem.de/fhem/trunk@264 2b470e98-0d58-463d-a4d8-8e2adae1ed80
This commit is contained in:
borisneubert
parent
d2fc6430a9
commit
73c03c294f
666
fhem/FHEM/00_CM11.pm
Executable file
666
fhem/FHEM/00_CM11.pm
Executable file
@ -0,0 +1,666 @@
|
||||
################################################################
|
||||
#
|
||||
# Copyright notice
|
||||
#
|
||||
# (c) 2008 Dr. Boris Neubert (omega@online.de)
|
||||
#
|
||||
# This script is free software; you can redistribute it and/or modify
|
||||
# it under the terms of the GNU General Public License as published by
|
||||
# the Free Software Foundation; either version 2 of the License, or
|
||||
# (at your option) any later version.
|
||||
#
|
||||
# The GNU General Public License can be found at
|
||||
# http://www.gnu.org/copyleft/gpl.html.
|
||||
# A copy is found in the textfile GPL.txt and important notices to the license
|
||||
# from the author is found in LICENSE.txt distributed with these scripts.
|
||||
#
|
||||
# This script is distributed in the hope that it will be useful,
|
||||
# but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
# GNU General Public License for more details.
|
||||
#
|
||||
# This copyright notice MUST APPEAR in all copies of the script!
|
||||
#
|
||||
################################################################
|
||||
|
||||
package main;
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
use Time::HiRes qw(gettimeofday);
|
||||
|
||||
|
||||
sub CM11_Write($$$);
|
||||
sub CM11_Read($);
|
||||
sub CM11_Ready($$);
|
||||
|
||||
my $msg_pollpc = pack("H*", "5a"); # interface poll signal (CM11->PC)
|
||||
my $msg_pollpcpf = pack("H*", "a5"); # power fail poll signal (CM11->PC)
|
||||
my $msg_pollack = pack("H*", "c3"); # response to poll signal (PC->CM11)
|
||||
my $msg_pollackpf= pack("H*", "fb"); # response to power fail poll signal (PC->CM11)
|
||||
my $msg_txok = pack("H*", "00"); # OK for transmission (PC->CM11)
|
||||
my $msg_ifrdy = pack("H*", "55"); # interface ready (CM11->PC)
|
||||
my $msg_statusrq = pack("H*", "8b"); # status request (PC->CM11)
|
||||
|
||||
my %housecodes_rcv = qw(0110 A 1110 B 0010 C 1010 D
|
||||
0001 E 1001 F 0101 G 1101 H
|
||||
0111 I 1111 J 0011 K 1011 L
|
||||
0000 M 1000 N 0100 O 1100 P);
|
||||
|
||||
my %unitcodes_rcv = qw(0110 1 1110 2 0010 3 1010 4
|
||||
0001 5 1001 6 0101 7 1101 8
|
||||
0111 9 1111 10 0011 11 1011 12
|
||||
0000 13 1000 14 0100 15 1100 16);
|
||||
|
||||
my %functions_rcv = qw(0000 ALL_UNITS_OFF
|
||||
0001 ALL_LIGHTS_ON
|
||||
0010 ON
|
||||
0011 OFF
|
||||
0100 DIM
|
||||
0101 BRIGHT
|
||||
0110 ALL_LIGHTS_OFF
|
||||
0111 EXTENDED_CODE
|
||||
1000 HAIL_REQUEST
|
||||
1001 HAIL_ACK
|
||||
1010 PRESET_DIM1
|
||||
1011 PRESET_DIM2
|
||||
1100 EXTENDED_DATA_TRANSFER
|
||||
1101 STATUS_ON
|
||||
1110 STATUS_OFF
|
||||
1111 STATUS_REQUEST);
|
||||
|
||||
|
||||
my %gets = (
|
||||
"test" => "xxx",
|
||||
);
|
||||
|
||||
my %sets = (
|
||||
"test" => "xxx",
|
||||
);
|
||||
|
||||
my $def;
|
||||
my %msghist; # Used when more than one CUL is attached
|
||||
my $msgcount = 0;
|
||||
|
||||
|
||||
#####################################
|
||||
|
||||
sub
|
||||
CM11_Initialize($)
|
||||
{
|
||||
my ($hash) = @_;
|
||||
|
||||
# Provider
|
||||
$hash->{ReadFn} = "CM11_Read";
|
||||
$hash->{WriteFn} = "CM11_Write";
|
||||
$hash->{Clients} = ":X10:";
|
||||
$hash->{ReadyFn} = "CM11_Ready" if ($^O eq 'MSWin32');
|
||||
|
||||
# Normal Devices
|
||||
$hash->{DefFn} = "CM11_Define";
|
||||
$hash->{UndefFn} = "CM11_Undef";
|
||||
# $hash->{GetFn} = "CM11_Get";
|
||||
# $hash->{SetFn} = "CM11_Set";
|
||||
$hash->{StateFn} = "CM11_SetState";
|
||||
$hash->{AttrList}= "do_not_notify:1,0 dummy:1,0 " .
|
||||
"model:CM11 loglevel:0,1,2,3,4,5,6";
|
||||
}
|
||||
#####################################
|
||||
sub
|
||||
CM11_DoInit($$$)
|
||||
{
|
||||
my ($name,$type,$po) = @_;
|
||||
my @init;
|
||||
|
||||
$po->reset_error();
|
||||
$po->baudrate(4800);
|
||||
$po->databits(8);
|
||||
$po->parity('none');
|
||||
$po->stopbits(1);
|
||||
$po->handshake('none');
|
||||
|
||||
if($type && $type eq "strangetty") {
|
||||
|
||||
# This part is for some Linux kernel versions whih has strange default
|
||||
# settings. Device::SerialPort is nice: if the flag is not defined for your
|
||||
# OS then it will be ignored.
|
||||
$po->stty_icanon(0);
|
||||
#$po->stty_parmrk(0); # The debian standard install does not have it
|
||||
$po->stty_icrnl(0);
|
||||
$po->stty_echoe(0);
|
||||
$po->stty_echok(0);
|
||||
$po->stty_echoctl(0);
|
||||
|
||||
# Needed for some strange distros
|
||||
$po->stty_echo(0);
|
||||
$po->stty_icanon(0);
|
||||
$po->stty_isig(0);
|
||||
$po->stty_opost(0);
|
||||
$po->stty_icrnl(0);
|
||||
}
|
||||
|
||||
$po->write_settings;
|
||||
|
||||
}
|
||||
|
||||
|
||||
#####################################
|
||||
sub
|
||||
CM11_Define($$)
|
||||
{
|
||||
my ($hash, $def) = @_;
|
||||
my @a = split("[ \t][ \t]*", $def);
|
||||
my $po;
|
||||
$hash->{STATE} = "Initialized";
|
||||
|
||||
delete $hash->{PortObj};
|
||||
delete $hash->{FD};
|
||||
|
||||
my $name = $a[0];
|
||||
my $dev = $a[2];
|
||||
$hash->{ttytype} = $a[3] if($a[3]);
|
||||
|
||||
$attr{$name}{savefirst} = 1;
|
||||
|
||||
if($dev eq "none") {
|
||||
Log 1, "CM11 device is none, commands will be echoed only";
|
||||
$attr{$name}{dummy} = 1;
|
||||
return undef;
|
||||
}
|
||||
|
||||
Log 3, "CM11 opening CM11 device $dev";
|
||||
if ($^O=~/Win/) {
|
||||
require Win32::SerialPort;
|
||||
$po = new Win32::SerialPort ($dev);
|
||||
} else {
|
||||
require Device::SerialPort;
|
||||
$po = new Device::SerialPort ($dev);
|
||||
}
|
||||
return "Can't open $dev: $!\n" if(!$po);
|
||||
Log 3, "CM11 opened CM11 device $dev";
|
||||
|
||||
$hash->{PortObj} = $po;
|
||||
if( $^O !~ /Win/ ) {
|
||||
$hash->{FD} = $po->FILENO;
|
||||
$selectlist{"$name.$dev"} = $hash;
|
||||
} else {
|
||||
$readyfnlist{"$name.$dev"} = $hash;
|
||||
}
|
||||
$hash->{DeviceName} = $dev;
|
||||
$hash->{PARTIAL} = "";
|
||||
|
||||
CM11_DoInit($name, $hash->{ttytype}, $po);
|
||||
|
||||
#CM11_SetInterfaceTime($hash);
|
||||
#CM11_GetInterfaceStatus($hash);
|
||||
return undef;
|
||||
}
|
||||
|
||||
#####################################
|
||||
sub
|
||||
CM11_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)
|
||||
{
|
||||
Log GetLogLevel($name,2), "deleting port for $d";
|
||||
delete $defs{$d}{IODev};
|
||||
}
|
||||
}
|
||||
$hash->{PortObj}->close() if($hash->{PortObj});
|
||||
return undef;
|
||||
}
|
||||
|
||||
|
||||
#####################################
|
||||
sub
|
||||
CM11_SetState($$$$)
|
||||
{
|
||||
my ($hash, $tim, $vt, $val) = @_;
|
||||
return undef;
|
||||
}
|
||||
|
||||
#####################################
|
||||
sub
|
||||
CM11_LogReadWrite($@)
|
||||
{
|
||||
my ($rw,$hash, $msg, $trlr) = @_;
|
||||
my $name= $hash->{NAME};
|
||||
Log GetLogLevel($name,5),
|
||||
"CM11 device " . $name . ": $rw " .
|
||||
sprintf("%2d: ", length($msg)) . unpack("H*", $msg);
|
||||
}
|
||||
|
||||
sub
|
||||
CM11_LogRead(@)
|
||||
{
|
||||
CM11_LogReadWrite("read ", @_);
|
||||
}
|
||||
|
||||
sub
|
||||
CM11_LogWrite(@)
|
||||
{
|
||||
CM11_LogReadWrite("write", @_);
|
||||
}
|
||||
|
||||
#####################################
|
||||
|
||||
sub
|
||||
CM11_SimpleWrite($$)
|
||||
{
|
||||
my ($hash, $msg) = @_;
|
||||
return if(!$hash || !defined($hash->{PortObj}));
|
||||
CM11_LogWrite($hash,$msg);
|
||||
$hash->{PortObj}->write($msg);
|
||||
}
|
||||
|
||||
#####################################
|
||||
sub
|
||||
CM11_ReadDirect($$)
|
||||
{
|
||||
# This is a direct read for CM11_Write
|
||||
my ($hash,$arg) = @_;
|
||||
return undef if(!$hash || !defined($hash->{FD}));
|
||||
|
||||
my $name= $hash->{NAME};
|
||||
my $prefix= "CM11 device " . $name . ":";
|
||||
my $rin= '';
|
||||
my $nfound;
|
||||
|
||||
if($^O eq 'MSWin32') {
|
||||
$nfound= CM11_Ready($hash, undef);
|
||||
} else {
|
||||
vec($rin, $hash->{FD}, 1) = 1;
|
||||
my $to = 20; # seconds timeout (response might be damn slow)
|
||||
$to = $hash->{RA_Timeout} if($hash->{RA_Timeout}); # ...or less
|
||||
$nfound = select($rin, undef, undef, $to);
|
||||
if($nfound < 0) {
|
||||
next if ($! == EAGAIN() || $! == EINTR() || $! == 0);
|
||||
Log GetLogLevel($name,3), "$prefix Select error $nfound / $!";
|
||||
return undef;
|
||||
}
|
||||
}
|
||||
if(!$nfound) {
|
||||
Log GetLogLevel($name,3), "$prefix Timeout reading $arg";
|
||||
return undef;
|
||||
}
|
||||
|
||||
my $buf = $hash->{PortObj}->input();
|
||||
CM11_LogRead($hash,$buf);
|
||||
return $buf;
|
||||
}
|
||||
|
||||
#####################################
|
||||
sub
|
||||
CM11_Write($$$)
|
||||
{
|
||||
# send two bytes, verify checksum, send ok
|
||||
my ($hash,$b1,$b2) = @_;
|
||||
my $name = $hash->{NAME};
|
||||
my $prefix= "CM11 device $name:";
|
||||
|
||||
if(!$hash || !defined($hash->{PortObj})) {
|
||||
Log GetLogLevel($name,3),
|
||||
"$prefix device is not active, cannot send";
|
||||
return;
|
||||
|
||||
}
|
||||
|
||||
# checksum
|
||||
my $b1d = unpack('C', $b1);
|
||||
my $b2d = unpack('C', $b2);
|
||||
my $checksum_w = ($b1d + $b2d) & 0xff;
|
||||
|
||||
my $data;
|
||||
|
||||
# try 5 times to send
|
||||
my $try= 5;
|
||||
for(;;) {
|
||||
$try--;
|
||||
# send two bytes
|
||||
$data= $b1 . $b2;
|
||||
CM11_LogWrite($hash,$data);
|
||||
$hash->{PortObj}->write($data);
|
||||
|
||||
# get checksum
|
||||
my $checksum= CM11_ReadDirect($hash, "checksum");
|
||||
return 0 if(!defined($checksum)); # read failure
|
||||
|
||||
my $checksum_r= unpack('C', $checksum);
|
||||
if($checksum_w ne $checksum_r) {
|
||||
Log 5,
|
||||
"$prefix wrong checksum (send: $checksum_w, received: $checksum_r)";
|
||||
return 0 if(!$try);
|
||||
my $nexttry= 6-$try;
|
||||
Log 5,
|
||||
"$prefix retrying (" . $nexttry . "/5)";
|
||||
} else {
|
||||
Log 5, "$prefix checksum correct, OK for transmission";
|
||||
last;
|
||||
}
|
||||
}
|
||||
|
||||
# checksum ok => send OK for transmission
|
||||
$data= $msg_txok;
|
||||
CM11_LogWrite($hash,$data);
|
||||
$hash->{PortObj}->write($data);
|
||||
my $ready= CM11_ReadDirect($hash, "ready");
|
||||
return 0 if(!defined($ready)); # read failure
|
||||
if($ready ne $msg_ifrdy) {
|
||||
Log GetLogLevel($name,3),
|
||||
"$prefix strange ready signal (" . unpack('C', $ready) . ")";
|
||||
return 0
|
||||
} else {
|
||||
Log 5, "$prefix ready";
|
||||
}
|
||||
|
||||
# we are fine
|
||||
return 1;
|
||||
}
|
||||
|
||||
#####################################
|
||||
sub
|
||||
CM11_GetInterfaceStatus($)
|
||||
{
|
||||
my ($hash)= @_;
|
||||
|
||||
CM11_SimpleWrite($hash, $msg_statusrq);
|
||||
my $statusmsg= "";
|
||||
while(length($statusmsg)<14) {
|
||||
my $buf= CM11_ReadDirect($hash, "status");
|
||||
return if(!defined($buf)); # read error
|
||||
$statusmsg.= $buf;
|
||||
}
|
||||
}
|
||||
|
||||
#####################################
|
||||
sub
|
||||
CM11_SetInterfaceTime($)
|
||||
{
|
||||
my ($hash)= @_;
|
||||
|
||||
# 7 Bytes, Bits 0..55 are
|
||||
# 55 to 48 timer download header (0x9b)
|
||||
# 47 to 40 Current time (seconds)
|
||||
# 39 to 32 Current time (minutes ranging from 0 to 119)
|
||||
# 31 to 23 Current time (hours/2, ranging from 0 to 11)
|
||||
# 23 to 16 Current year day (bits 0 to 7)
|
||||
# 15 Current year day (bit 8)
|
||||
# 14 to 8 Day mask (SMTWTFS)
|
||||
# 7 to 4 Monitored house code
|
||||
# 3 Reserved
|
||||
# 2 Battery timer clear flag
|
||||
# 1 Monitored status clear flag
|
||||
# 0 Timer purge flag
|
||||
|
||||
# make the interface happy (time is set to zero)
|
||||
my $data = pack('C7', 0x9b,0x00,0x00,0x00,0x00,0x00,0x03);
|
||||
CM11_SimpleWrite($hash, $data);
|
||||
# get checksum (ignored)
|
||||
my $checksum= CM11_ReadDirect($hash, "checksum");
|
||||
return 0 if(!defined($checksum)); # read failure
|
||||
# tx OK
|
||||
CM11_SimpleWrite($hash, $msg_txok);
|
||||
# get ready (ignored)
|
||||
my $ready= CM11_ReadDirect($hash, "ready");
|
||||
return 0 if(!defined($ready)); # read failure
|
||||
return 1;
|
||||
}
|
||||
|
||||
#####################################
|
||||
sub
|
||||
CM11_Dispatch($$$$)
|
||||
{
|
||||
my ($hash,$housecode,$unitcodes,$x10func)= @_;
|
||||
|
||||
my $prefix= "CM11 device " . $hash->{NAME} . ":";
|
||||
my $iohash = $modules{$hash->{TYPE}}; # Our (CM11) module pointer
|
||||
|
||||
$unitcodes= "" unless(defined($unitcodes));
|
||||
my $dmsg= "X10:$housecode;$unitcodes;$x10func";
|
||||
Log 5, "$prefix dispatch $dmsg";
|
||||
|
||||
my @found;
|
||||
my $last_module;
|
||||
my $nfound;
|
||||
foreach my $m (sort { $modules{$a}{ORDER} cmp $modules{$b}{ORDER} }
|
||||
grep {defined($modules{$_}{ORDER});}keys %modules) {
|
||||
next if($iohash->{Clients} !~ m/:$m:/);
|
||||
|
||||
# Module is not loaded or the message is not for this module
|
||||
next if(!$modules{$m}{Match} || $dmsg !~ m/$modules{$m}{Match}/i);
|
||||
|
||||
no strict "refs";
|
||||
@found = &{$modules{$m}{ParseFn}}($hash,$dmsg);
|
||||
use strict "refs";
|
||||
$last_module = $m;
|
||||
$nfound= int(@found);
|
||||
last if($nfound);
|
||||
}
|
||||
# if the function was not evaluated, undef was returned
|
||||
if(!$nfound) {
|
||||
Log 1, "Unknown message $dmsg, help me!";
|
||||
return;
|
||||
}
|
||||
|
||||
foreach my $found (@found) {
|
||||
if($found =~ m/^(UNDEFINED) ([^ ]*) (.*)$/) {
|
||||
# The trigger needs a device: we create a minimal temporary one
|
||||
my $d = $1;
|
||||
$defs{$d}{NAME} = $1;
|
||||
$defs{$d}{TYPE} = $last_module;
|
||||
DoTrigger($d, "$2 $3");
|
||||
CommandDelete(undef, $d); # Remove the device
|
||||
$nfound--;
|
||||
} else {
|
||||
DoTrigger($found, undef);
|
||||
}
|
||||
}
|
||||
|
||||
Log 5, "$prefix $nfound devices addressed";
|
||||
return @found;
|
||||
|
||||
}
|
||||
|
||||
#####################################
|
||||
sub
|
||||
CM11_Read($)
|
||||
{
|
||||
#
|
||||
# prolog
|
||||
#
|
||||
|
||||
my ($hash) = @_;
|
||||
|
||||
my $buf = $hash->{PortObj}->input();
|
||||
my $name = $hash->{NAME};
|
||||
|
||||
# prefix for logging
|
||||
my $prefix= "CM11 device " . $name . ":";
|
||||
|
||||
# Lets' try again: Some drivers return len(0) on the first read...
|
||||
if(defined($buf) && length($buf) == 0) {
|
||||
$buf = $hash->{PortObj}->input();
|
||||
}
|
||||
|
||||
# USB troubleshooting
|
||||
if(!defined($buf) || length($buf) == 0) {
|
||||
my $devname = $hash->{DeviceName};
|
||||
Log 1, "USB device $devname disconnected, waiting to reappear";
|
||||
$hash->{PortObj}->close();
|
||||
for(;;) {
|
||||
sleep(5);
|
||||
if ($^O eq 'MSWin32') {
|
||||
$hash->{PortObj} = new Win32::SerialPort($devname);
|
||||
}else{
|
||||
$hash->{PortObj} = new Device::SerialPort($devname);
|
||||
}
|
||||
if($hash->{PortObj}) {
|
||||
Log 1, "USB device $devname reappeared";
|
||||
$hash->{FD} = $hash->{PortObj}->FILENO if !($^O eq 'MSWin32');
|
||||
CM11_DoInit($name, $hash->{ttytype}, $hash->{PortObj});
|
||||
return;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
#
|
||||
# begin of message digesting
|
||||
#
|
||||
|
||||
# concatenate yet unparsed message and newly received data
|
||||
my $x10data = $hash->{PARTIAL} . $buf;
|
||||
CM11_LogRead($hash,$buf);
|
||||
Log 5, "$prefix Data: " . unpack('H*',$x10data);
|
||||
|
||||
# normally the while loop will run only once
|
||||
while(length($x10data) > 0) {
|
||||
|
||||
# we cut off everything before the latest poll signal
|
||||
my $p= index(reverse($x10data), $msg_pollpc);
|
||||
if($p<0) { $p= index(reverse($x10data), $msg_pollpcpf); }
|
||||
if($p>=0) { $x10data= substr($x10data, -$p-1); }
|
||||
|
||||
# to start with, a single 0x5a is received
|
||||
if( substr($x10data,0,1) eq $msg_pollpc ) { # CM11 polls PC
|
||||
Log 5, "$prefix start of message";
|
||||
CM11_SimpleWrite($hash, $msg_pollack); # PC ready
|
||||
$x10data= substr($x10data,1); # $x10data now empty
|
||||
next;
|
||||
}
|
||||
|
||||
# experimental code follows
|
||||
#if( substr($x10data,0,2) eq pack("H*", "98e6") ) { # CM11 polls PC
|
||||
# Log 5, "$prefix 98e6";
|
||||
# CM11_SimpleWrite($hash, $msg_pollack); # PC ready
|
||||
# $x10data= "";
|
||||
# next;
|
||||
#}
|
||||
#if( substr($x10data,0,1) eq pack("H*", "98") ) { # CM11 polls PC
|
||||
# Log 5, "$prefix 98";
|
||||
# next;
|
||||
#}
|
||||
|
||||
# a single 0xa5 is a power-fail macro download poll
|
||||
if( substr($x10data,0,1) eq $msg_pollpcpf ) { # CM11 polls PC
|
||||
Log 5, "$prefix power-fail poll";
|
||||
# the documentation wrongly says that the macros should be downloaded
|
||||
# in fact, the time must be set!
|
||||
if(CM11_SetInterfaceTime($hash)) {
|
||||
Log 5, "$prefix power-fail poll satisfied";
|
||||
} else {
|
||||
Log 5, "$prefix power-fail poll satisfaction failed";
|
||||
}
|
||||
$x10data= substr($x10data,1); # $x10data now empty
|
||||
next;
|
||||
}
|
||||
|
||||
# a single 0x55 is a leftover from a failed transmission
|
||||
if( substr($x10data,0,1) eq $msg_ifrdy ) { # CM11 polls PC
|
||||
Log 5, "$prefix skipping leftover ready signal";
|
||||
$x10data= substr($x10data,1);
|
||||
next;
|
||||
}
|
||||
|
||||
# the message comes in small chunks of 1 or few bytes instead of the
|
||||
# whole buffer at once
|
||||
my $len= ord(substr($x10data,0,1))-1; # upload buffer size
|
||||
last if(length($x10data)< $len+2); # wait for complete msg
|
||||
|
||||
# message is now complete, start interpretation
|
||||
|
||||
# mask: Bits 0 (LSB)..7 (MSB) correspond to data bytes 0..7
|
||||
# bit= 0: unitcode, bit= 1: function
|
||||
my $mask= unpack('B8', substr($x10data,1,1));
|
||||
$x10data= substr($x10data,2); # cut off length and mask
|
||||
|
||||
# $x10data now contains $len data bytes
|
||||
my $databytes= unpack('H*', substr($x10data,0));
|
||||
Log 5, "$prefix message complete " .
|
||||
"(length $len, mask $mask, data $databytes)";
|
||||
|
||||
# the following lines decode the messages into unitcodes and functions
|
||||
# in general we have 0..n unitcodes followed by 1..m functions in the
|
||||
# message
|
||||
my $i= 0;
|
||||
my $dmsg= "";
|
||||
while($i< $len) {
|
||||
|
||||
my $data= substr($x10data, $i);
|
||||
my $bits = unpack('B8', $data);
|
||||
my $nibble_hi = substr($bits, 0, 4);
|
||||
my $nibble_lo = substr($bits, 4, 4);
|
||||
|
||||
my $housecode= $housecodes_rcv{$nibble_hi};
|
||||
|
||||
# one hash for unitcodes X_UNIT and one hash for functions
|
||||
# X_FUNC is maintained per housecode X= A..P
|
||||
my $housecode_unit= $housecode . "_UNIT";
|
||||
my $housecode_func= $housecode . "_FUNC";
|
||||
|
||||
my $isfunc= (substr($mask, -$i-1, 1));
|
||||
if($isfunc) {
|
||||
# data byte is function
|
||||
my $x10func= $functions_rcv{$nibble_lo};
|
||||
if(($x10func eq "DIM") || ($x10func eq "BRIGHT")) {
|
||||
my $level= ord(substr($x10data, ++$i));
|
||||
$x10func.= " $level";
|
||||
}
|
||||
elsif($x10func eq "EXTENDED_DATA_TRANSFER") {
|
||||
$data= substr($x10data, 2+(++$i));
|
||||
my $command= substr($x10data, ++$i);
|
||||
$x10func.= unpack("H*", $data) . ":" .
|
||||
unpack("H*", $command);
|
||||
}
|
||||
$hash->{$housecode_func}= $x10func;
|
||||
Log 5, "$prefix $housecode_func: " .
|
||||
$hash->{$housecode_func};
|
||||
# dispatch message to clients
|
||||
CM11_Dispatch($hash, $housecode,
|
||||
$hash->{$housecode_unit},
|
||||
$hash->{$housecode_func});
|
||||
} else {
|
||||
# data byte is unitcode
|
||||
# if a command was executed before, clear unitcode list
|
||||
if(defined($hash->{$housecode_func})) {
|
||||
undef $hash->{$housecode_unit};
|
||||
undef $hash->{$housecode_func};
|
||||
}
|
||||
# get unitcode of unitcode
|
||||
my $unitcode= $unitcodes_rcv{$nibble_lo};
|
||||
# append to list of unitcodes
|
||||
my $unitcodes= $hash->{$housecode_unit};
|
||||
if(defined($hash->{$housecode_unit})) {
|
||||
$unitcodes= $hash->{$housecode_unit} . " ";
|
||||
} else {
|
||||
$unitcodes= "";
|
||||
}
|
||||
$hash->{$housecode_unit}= "$unitcodes$unitcode";
|
||||
Log 5, "$prefix $housecode_unit: " .
|
||||
$hash->{$housecode_unit};
|
||||
}
|
||||
$i++;
|
||||
}
|
||||
$x10data= '';
|
||||
}
|
||||
|
||||
$hash->{PARTIAL} = $x10data;
|
||||
}
|
||||
|
||||
#####################################
|
||||
sub
|
||||
CM11_Ready($$) # Windows - only
|
||||
{
|
||||
my ($hash, $dev) = @_;
|
||||
my $po=$hash->{PortObj};
|
||||
return undef if !$po;
|
||||
my ($BlockingFlags, $InBytes, $OutBytes, $ErrorFlags)=$po->status;
|
||||
return ($InBytes>0);
|
||||
}
|
||||
|
||||
1;
|
||||
371
fhem/FHEM/20_X10.pm
Executable file
371
fhem/FHEM/20_X10.pm
Executable file
@ -0,0 +1,371 @@
|
||||
################################################################
|
||||
#
|
||||
# Copyright notice
|
||||
#
|
||||
# (c) 2008 Dr. Boris Neubert (omega@online.de)
|
||||
#
|
||||
# This script is free software; you can redistribute it and/or modify
|
||||
# it under the terms of the GNU General Public License as published by
|
||||
# the Free Software Foundation; either version 2 of the License, or
|
||||
# (at your option) any later version.
|
||||
#
|
||||
# The GNU General Public License can be found at
|
||||
# http://www.gnu.org/copyleft/gpl.html.
|
||||
# A copy is found in the textfile GPL.txt and important notices to the license
|
||||
# from the author is found in LICENSE.txt distributed with these scripts.
|
||||
#
|
||||
# This script is distributed in the hope that it will be useful,
|
||||
# but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
# GNU General Public License for more details.
|
||||
#
|
||||
# This copyright notice MUST APPEAR in all copies of the script!
|
||||
#
|
||||
################################################################
|
||||
|
||||
package main;
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
my %functions = ( ALL_UNITS_OFF => "all_units_off",
|
||||
ALL_LIGHTS_ON => "all_lights_on",
|
||||
ON => "on",
|
||||
OFF => "off",
|
||||
DIM => "dimdown",
|
||||
BRIGHT => "dimup",
|
||||
ALL_LIGHTS_OFF => "all_lights_off",
|
||||
EXTENDED_CODE => "",
|
||||
HAIL_REQUEST => "",
|
||||
HAIL_ACK => "",
|
||||
PRESET_DIM1 => "",
|
||||
PRESET_DIM2 => "",
|
||||
EXTENDED_DATA_TRANSFER => "",
|
||||
STATUS_ON => "",
|
||||
STATUS_OFF => "",
|
||||
STATUS_REQUEST => "",
|
||||
);
|
||||
|
||||
my %snoitcnuf; # the reverse of the above
|
||||
|
||||
my %functions_rewrite = ( "all_units_off" => "off",
|
||||
"all_lights_on" => "on",
|
||||
"all_lights_off" => "off",
|
||||
);
|
||||
|
||||
my %functions_snd = qw( ON 0010
|
||||
OFF 0011
|
||||
DIM 0100
|
||||
BRIGHT 0101 );
|
||||
|
||||
my %housecodes_snd = qw(A 0110 B 1110 C 0010 D 1010
|
||||
E 0001 F 1001 G 0101 H 1101
|
||||
I 0111 J 1111 K 0011 K 1011
|
||||
M 0000 N 1000 O 0100 P 1100);
|
||||
|
||||
my %unitcodes_snd = qw( 1 0110 2 1110 3 0010 4 1010
|
||||
5 0001 6 1001 7 0101 8 1101
|
||||
9 0111 10 1111 11 0011 12 1011
|
||||
13 0000 14 1000 15 0100 16 1100);
|
||||
|
||||
|
||||
my %functions_set = ( "on" => 0,
|
||||
"off" => 0,
|
||||
"dimup" => 1,
|
||||
"dimdown" => 1,
|
||||
"on-till" => 1,
|
||||
);
|
||||
|
||||
# devices{HOUSE}{UNIT} -> Pointer to hash for the device for lookups
|
||||
my %devices;
|
||||
|
||||
my %models = (
|
||||
lm12 => 'dimmer',
|
||||
lm15 => 'simple',
|
||||
am12 => 'simple',
|
||||
tm13 => 'simple',
|
||||
);
|
||||
|
||||
my @lampmodules = ('lm12','lm15'); # lamp modules
|
||||
|
||||
|
||||
sub
|
||||
X10_Initialize($)
|
||||
{
|
||||
my ($hash) = @_;
|
||||
|
||||
foreach my $k (keys %functions) {
|
||||
$snoitcnuf{$functions{$k}}= $k;
|
||||
}
|
||||
|
||||
$hash->{Match} = "^X10:[A-P];";
|
||||
$hash->{SetFn} = "X10_Set";
|
||||
$hash->{StateFn} = "X10_SetState";
|
||||
$hash->{DefFn} = "X10_Define";
|
||||
$hash->{UndefFn} = "X10_Undef";
|
||||
$hash->{ParseFn} = "X10_Parse";
|
||||
$hash->{AttrList} = "follow-on-for-timer:1,0 do_not_notify:1,0 dummy:1,0
|
||||
showtime:1,0 model:lm12,lm15,am12,tm13 loglevel:0,1,2,3,4,5,6";
|
||||
|
||||
}
|
||||
|
||||
#####################################
|
||||
sub
|
||||
X10_SetState($$$$)
|
||||
{
|
||||
my ($hash, $tim, $vt, $val) = @_;
|
||||
return undef;
|
||||
}
|
||||
|
||||
#############################
|
||||
sub
|
||||
X10_Do_On_Till($@)
|
||||
{
|
||||
my ($hash, @a) = @_;
|
||||
return "Timespec (HH:MM[:SS]) needed for the on-till command" if(@a != 3);
|
||||
|
||||
my ($err, $hr, $min, $sec, $fn) = GetTimeSpec($a[2]);
|
||||
return $err if($err);
|
||||
|
||||
my @lt = localtime;
|
||||
my $hms_till = sprintf("%02d:%02d:%02d", $hr, $min, $sec);
|
||||
my $hms_now = sprintf("%02d:%02d:%02d", $lt[2], $lt[1], $lt[0]);
|
||||
if($hms_now ge $hms_till) {
|
||||
Log 4, "on-till: won't switch as now ($hms_now) is later than $hms_till";
|
||||
return "";
|
||||
}
|
||||
|
||||
my @b = ($a[0], "on");
|
||||
X10_Set($hash, @b);
|
||||
CommandDefine(undef, $hash->{NAME} . "_till at $hms_till set $a[0] off");
|
||||
|
||||
}
|
||||
|
||||
###################################
|
||||
|
||||
sub
|
||||
X11_Write($$$)
|
||||
{
|
||||
my ($hash, $function, $dim)= @_;
|
||||
my $name = $hash->{NAME};
|
||||
my $housecode= $hash->{HOUSE};
|
||||
my $unitcode = $hash->{UNIT};
|
||||
my $x10func = $snoitcnuf{$function};
|
||||
undef $function; # do not use after this point
|
||||
my $prefix= "X10 device $name:";
|
||||
|
||||
Log 5, "$prefix sending X10:$housecode;$unitcode;$x10func $dim";
|
||||
|
||||
my ($hc_b, $hu_b, $hf_b);
|
||||
my ($hc, $hu, $hf);
|
||||
|
||||
# Header:Code, Address
|
||||
$hc_b = "00000100"; # 0x04
|
||||
$hc = pack("B8", $hc_b);
|
||||
$hu_b = $housecodes_snd{$housecode} . $unitcodes_snd{$unitcode};
|
||||
$hu = pack("B8", $hu_b);
|
||||
IOWrite($hash, $hc, $hu);
|
||||
|
||||
# Header:Code, Function
|
||||
$hc_b = substr(unpack('B8', pack('C', $dim)), 3) . # dim, 0..22
|
||||
"110"; # always 110
|
||||
$hc = pack("B8", $hc_b);
|
||||
$hf_b = $housecodes_snd{$housecode} . $functions_snd{$x10func};
|
||||
$hf = pack("B8", $hf_b);
|
||||
IOWrite($hash, $hc, $hf);
|
||||
}
|
||||
|
||||
###################################
|
||||
sub
|
||||
X10_Set($@)
|
||||
{
|
||||
my ($hash, @a) = @_;
|
||||
my $ret = undef;
|
||||
my $na = int(@a);
|
||||
|
||||
# initialization and sanity checks
|
||||
return "no set value specified" if($na < 2);
|
||||
|
||||
my $name= $hash->{NAME};
|
||||
my $function= $a[1];
|
||||
my $nrparams= $functions_set{$function};
|
||||
return "Unknown argument $function, choose one of " .
|
||||
join(",", sort keys %functions_set) if(!defined($nrparams));
|
||||
return "Wrong number of parameters" if($na != 2+$nrparams);
|
||||
|
||||
# special for on-till
|
||||
return X10_Do_On_Till($hash, @a) if($function eq "on-till");
|
||||
|
||||
# argument evaluation
|
||||
my $model= $hash->{MODEL};
|
||||
|
||||
my $dim= 0;
|
||||
if($function =~ m/^dim/) {
|
||||
return "Cannot dim $name (model $model)" if($models{$model} ne "dimmer");
|
||||
my $arg= $a[2];
|
||||
return "Wrong argument $arg, use 0..22" if($arg !~ m/^[0-9]{1,2}$/);
|
||||
return "Wrong argument $arg, use 0..22" if($arg>22);
|
||||
$dim= $arg;
|
||||
}
|
||||
|
||||
# send command to CM11
|
||||
X11_Write($hash, $function, $dim) if(!IsDummy($a[0]));
|
||||
|
||||
my $v = join(" ", @a);
|
||||
Log GetLogLevel($a[0],2), "X10 set $v";
|
||||
(undef, $v) = split(" ", $v, 2); # Not interested in the name...
|
||||
|
||||
my $tn = TimeNow();
|
||||
|
||||
$hash->{CHANGED}[0] = $v;
|
||||
$hash->{STATE} = $v;
|
||||
$hash->{READINGS}{state}{TIME} = $tn;
|
||||
$hash->{READINGS}{state}{VAL} = $v;
|
||||
|
||||
return undef;
|
||||
}
|
||||
|
||||
#############################
|
||||
sub
|
||||
X10_Define($$)
|
||||
{
|
||||
my ($hash, $def) = @_;
|
||||
my @a = split("[ \t][ \t]*", $def);
|
||||
|
||||
return "wrong syntax: define <name> X10 model housecode unitcode"
|
||||
if(int(@a)!= 5);
|
||||
|
||||
my $model= $a[2];
|
||||
return "Define $a[0]: wrong model: specify one of " .
|
||||
join ",", sort keys %models
|
||||
if(!grep { $_ eq $model} keys %models);
|
||||
|
||||
my $housecode = $a[3];
|
||||
return "Define $a[0]: wrong housecode format: specify a value ".
|
||||
"from A to P"
|
||||
if($housecode !~ m/^[A-P]$/i);
|
||||
|
||||
my $unitcode = $a[4];
|
||||
return "Define $a[0]: wrong unitcode format: specify a value " .
|
||||
"from 1 to 16"
|
||||
if( ($unitcode<1) || ($unitcode>16) );
|
||||
|
||||
|
||||
$hash->{MODEL} = $model;
|
||||
$hash->{HOUSE} = $housecode;
|
||||
$hash->{UNIT} = $unitcode;
|
||||
|
||||
if(defined($devices{$housecode}{$unitcode})) {
|
||||
return "Error: duplicate X10 device $housecode $unitcode definition " .
|
||||
$hash->{NAME} . " (previous: " .
|
||||
$devices{$housecode}{$unitcode}->{NAME} .")";
|
||||
}
|
||||
|
||||
$devices{$housecode}{$unitcode}= $hash;
|
||||
|
||||
AssignIoPort($hash);
|
||||
}
|
||||
|
||||
#############################
|
||||
sub
|
||||
X10_Undef($$)
|
||||
{
|
||||
my ($hash, $name) = @_;
|
||||
if( defined($hash->{HOUSE}) && defined($hash->{UNIT}) ) {
|
||||
delete($devices{$hash->{HOUSE}}{$hash->{UNIT}});
|
||||
}
|
||||
return undef;
|
||||
}
|
||||
|
||||
#############################
|
||||
sub
|
||||
X10_Parse($$)
|
||||
{
|
||||
my ($hash, $msg) = @_;
|
||||
|
||||
# message example: X10:N;1 12;OFF
|
||||
(undef, $msg)= split /:/, $msg, 2; # strip off "X10"
|
||||
my ($housecode,$unitcodes,$command)= split /;/, $msg, 4;
|
||||
|
||||
my @list; # list of selected devices
|
||||
|
||||
#
|
||||
# command evaluation
|
||||
#
|
||||
my ($x10func,$arg)= split / /, $command, 2;
|
||||
my $function= $functions{$x10func}; # translate, eg BRIGHT -> dimup
|
||||
undef $x10func; # do not use after this point
|
||||
|
||||
# the following code sequence converts an all on/off command into
|
||||
# a sequence of simple on/off commands for all defined devices
|
||||
my $all_lights= ($function=~ m/^all_lights_/);
|
||||
my $all_units= ($function=~ m/^all_units_/);
|
||||
if($all_lights || $all_units) {
|
||||
$function= $functions_rewrite{$function}; # translate, all_lights_on -> on
|
||||
$unitcodes= "";
|
||||
foreach my $unitcode (keys %{ $devices{$housecode} } ) {
|
||||
my $h= $devices{$housecode}{$unitcode};
|
||||
my $islampmodule= grep { $_ eq $h->{MODEL} } @lampmodules;
|
||||
if($all_units || $islampmodule ) {
|
||||
$unitcodes.= " " if($unitcodes ne "");
|
||||
$unitcodes.= $h->{UNIT};
|
||||
}
|
||||
}
|
||||
# no units for that housecode
|
||||
if($unitcodes eq "") {
|
||||
Log 3, "X10 No units with housecode $housecode, command $command, " .
|
||||
"please define one";
|
||||
push(@list,
|
||||
"UNDEFINED X10 device $housecode ?, command $command");
|
||||
return @list;
|
||||
}
|
||||
}
|
||||
|
||||
# apply to each unit in turn
|
||||
my @unitcodes= split / /, $unitcodes;
|
||||
|
||||
if(!int(@unitcodes)) {
|
||||
# command without unitcodes, this happens when a single on/off is sent
|
||||
# but no unit was previously selected
|
||||
Log 3, "X10 No unit selected for housecode $housecode, command $command";
|
||||
push(@list,
|
||||
"UNDEFINED X10 device $housecode ?, command $command");
|
||||
return @list;
|
||||
}
|
||||
|
||||
# function rewriting
|
||||
my $value= $function;
|
||||
return @list if($value eq ""); # function not evaluated
|
||||
|
||||
# function determined, add argument
|
||||
if( defined($arg) ) {
|
||||
# received dims from 0..210
|
||||
my $dim= $arg;
|
||||
$value = "$value $dim" ;
|
||||
}
|
||||
|
||||
|
||||
my $unknown_unitcodes= '';
|
||||
foreach my $unitcode (@unitcodes) {
|
||||
my $h= $devices{$housecode}{$unitcode};
|
||||
if($h) {
|
||||
my $name= $h->{NAME};
|
||||
$h->{CHANGED}[0] = $value;
|
||||
$h->{STATE} = $value;
|
||||
$h->{READINGS}{state}{TIME} = TimeNow();
|
||||
$h->{READINGS}{state}{VAL} = $value;
|
||||
Log GetLogLevel($name,2), "X10 $name $value";
|
||||
push(@list, $name);
|
||||
} else {
|
||||
Log 3, "X10 Unknown device $housecode $unitcode, command $command, " .
|
||||
"please define it";
|
||||
push(@list,
|
||||
"UNDEFINED X10 device $housecode $unitcode, command $command");
|
||||
}
|
||||
}
|
||||
return @list;
|
||||
|
||||
}
|
||||
|
||||
|
||||
1;
|
||||
Loading…
x
Reference in New Issue
Block a user