FHEM/fhem-mirror
2
0
Fork 0
mirror of https://github.com/fhem/fhem-mirror.git synced 2025-04-28 11:01:59 +00:00
Code Issues Releases Wiki Activity

First CUL version, small changes

Browse Source 
git-svn-id: https://svn.fhem.de/fhem/trunk@232 2b470e98-0d58-463d-a4d8-8e2adae1ed80
This commit is contained in:
rudolfkoenig 2008-08-25 09:51:57 +00:00
parent 0bc7015af1
commit 091e52c3e9
3 changed files with 507 additions and 27 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

483
fhem/FHEM/00_CUL.pm Executable file
View File

@ -0,0 +1,483 @@
##############################################
# Implemented:
# - Transmit limit trigger: Fire if more then 1% airtime
# is used in the last hour
# - reconnect
# - message flow control (send one F message every 0.25 seconds)
# - repeater/filtertimeout
# - FS20 rcv
# - FS20 xmit
# - FHT rcv
# TODO:
# - FHT xmit
# - HMS rcv
# - KS300 rcv
# - EMEM rcv
# - EMWZ rcv
# - EMGZ rcv
# - S300TH rcv
package main;
use strict;
use warnings;
use Time::HiRes qw(gettimeofday);
sub CUL_Write($$$);
sub CUL_Read($);
sub CUL_ReadAnswer($$);
sub CUL_Ready($$);
my %msghist; # Used when more than one CUL is attached
my $msgcount = 0;
my %gets = (
"ccreg" => "C",
"version" => "V",
);
sub
CUL_Initialize($)
{
my ($hash) = @_;
# Provider
$hash->{ReadFn} = "CUL_Read";
$hash->{WriteFn} = "CUL_Write";
$hash->{Clients} = ":CUL:FS20:FHT:";
$hash->{ReadyFn} = "CUL_Ready" if ($^O eq 'MSWin32');
# Normal devices
$hash->{DefFn} = "CUL_Define";
$hash->{UndefFn} = "CUL_Undef";
$hash->{GetFn} = "CUL_Get";
$hash->{SetFn} = "CUL_Set";
$hash->{StateFn} = "CUL_SetState";
$hash->{AttrList}= "do_not_notify:1,0 dummy:1,0 filtertimeout repeater:1,0 " .
"showtime:1,0 model:CUL loglevel:0,1,2,3,4,5,6";
}
#####################################
sub
CUL_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];
$attr{$name}{savefirst} = 1;
$attr{$name}{repeater} = 1;
if($dev eq "none") {
Log 1, "CUL device is none, commands will be echoed only";
$attr{$name}{dummy} = 1;
return undef;
}
Log 3, "CUL opening CUL 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, "CUL opened CUL device $dev";
$hash->{PortObj} = $po;
$hash->{FD} = $po->FILENO if !( $^O =~ /Win/ );
$hash->{DeviceName} = $dev;
$hash->{PARTIAL} = "";
return CUL_DoInit($hash);
}
#####################################
sub
CUL_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
CUL_Set($@)
{
my ($hash, @a) = @_;
return "NYI";
}
#####################################
sub
CUL_Get($@)
{
my ($hash, @a) = @_;
return "\"get CUL\" needs at leass one parameter" if(@a < 2);
return "Unknown argument $a[1], choose one of " . join(",", sort keys %gets)
if(!defined($gets{$a[1]}));
my $arg = ($a[2] ? $a[2] : "");
CUL_Write($hash, $gets{$a[1]}, $arg) if(!IsDummy($hash->{NAME}));
my $msg = CUL_ReadAnswer($hash, $a[1]);
$msg =~ s/[\r\n]//g;
$hash->{READINGS}{$a[1]}{VAL} = $msg;
$hash->{READINGS}{$a[1]}{TIME} = TimeNow();
return "$a[0] $a[1] => $msg";
return "NYI"
}
#####################################
sub
CUL_SetState($$$$)
{
my ($hash, $tim, $vt, $val) = @_;
return "NYI";
}
#####################################
sub
CUL_DoInit($)
{
my $hash = shift;
my $name = $hash->{NAME};
# Clear the pipe
$hash->{RA_Timeout} = 0.1;
for(;;) {
last if(CUL_ReadAnswer($hash, "Clear") =~ m/^Timeout/);
}
delete($hash->{RA_Timeout});
$hash->{PortObj}->write("V\n");
my $ver = CUL_ReadAnswer($hash, "Version");
if($ver !~ m/^V/) {
$attr{$name}{dummy} = 1;
$hash->{PortObj}->close();
my $msg = "Not an CUL device, receives for V: $ver";
Log 1, $msg;
return $msg;
}
$hash->{PortObj}->write("XFE\n"); # Enable message reporting
# Reset the counter
delete($hash->{XMIT_TIME});
delete($hash->{NR_CMD_LAST_H});
}
#####################################
# This is a direct read for commands like get
sub
CUL_ReadAnswer($$)
{
my ($hash,$arg) = @_;
return undef if(!$hash || !defined($hash->{FD}));
my ($mculdata, $rin) = ("", '');
my $nfound;
for(;;) {
if($^O eq 'MSWin32') {
$nfound=CUL_Ready($hash, undef);
} else {
vec($rin, $hash->{FD}, 1) = 1;
my $to = 3; # 3 seconds timeout
$to = $hash->{RA_Timeout} if($hash->{RA_Timeout}); # ...or less
$nfound = select($rin, undef, undef, $to);
if($nfound < 0) {
next if ($! == EAGAIN() || $! == EINTR() || $! == 0);
die("Select error $nfound / $!\n");
}
}
return "Timeout reading answer for get $arg" if($nfound == 0);
my $buf = $hash->{PortObj}->input();
Log 5, "CUL/RAW: $buf";
$mculdata .= $buf;
return $mculdata if($mculdata =~ m/\r\n/);
}
}
#####################################
# Check if the 1% limit is reached and trigger notifies
sub
CUL_XmitLimitCheck($$)
{
my ($hash,$fn) = @_;
my $now = time();
if(!$hash->{XMIT_TIME}) {
$hash->{XMIT_TIME}[0] = $now;
$hash->{NR_CMD_LAST_H} = 1;
return;
}
my $nowM1h = $now-3600;
my @b = grep { $_ > $nowM1h } @{$hash->{XMIT_TIME}};
if(@b > 163) { # Maximum nr of transmissions per hour (unconfirmed).
my $me = $hash->{NAME};
Log GetLogLevel($me,2), "CUL TRANSMIT LIMIT EXCEEDED";
DoTrigger($me, "TRANSMIT LIMIT EXCEEDED");
} else {
push(@b, $now);
}
$hash->{XMIT_TIME} = \@b;
$hash->{NR_CMD_LAST_H} = int(@b);
}
#####################################
sub
CUL_Write($$$)
{
my ($hash,$fn,$msg) = @_;
if(!$hash || !defined($hash->{PortObj})) {
Log 5, "CUL device $hash->{NAME} is not active, cannot send";
return;
}
###################
# Rewrite message from FHZ -> CUL
if(length($fn) == 1) { # CUL Native
} elsif($fn eq "04" && substr($msg,0,6) eq "010101") { # FS20
$fn = "F";
$msg = substr($msg,6);
} else {
Log 1, "CUL cannot translate $fn $msg";
return;
}
###############
# insert value into the msghist. At the moment this only makes sense for FS20
# devices. As the transmitted value differs from the received one, we have to
# recompute.
if($fn eq "F" || $fn eq "T") {
$msghist{$msgcount}{TIME} = gettimeofday();
$msghist{$msgcount}{NAME} = $hash->{NAME};
$msghist{$msgcount}{MSG} = "$fn$msg";
$msgcount++;
}
Log 5, "CUL sending $fn$msg";
my $bstring = "$fn$msg\n";
if($fn eq "F") {
if(!$hash->{QUEUECNT}) {
CUL_XmitLimitCheck($hash, $bstring);
$hash->{PortObj}->write($bstring);
##############
# Write the next buffer not earlier than 0.227 seconds (= 65.6ms + 10ms +
# 65.6ms + 10ms + 65.6ms + 10ms)
InternalTimer(gettimeofday()+0.25, "CUL_HandleWriteQueue", $hash, 1);
} elsif($hash->{QUEUECNT} == 1) {
$hash->{QUEUE} = [ $bstring ];
} else {
push(@{$hash->{QUEUE}}, $bstring);
}
$hash->{QUEUECNT}++;
} else {
$hash->{PortObj}->write($bstring);
}
}
#####################################
sub
CUL_HandleWriteQueue($)
{
my $hash = shift;
my $cnt = --$hash->{QUEUECNT};
if($cnt > 0) {
my $bstring = shift(@{$hash->{QUEUE}});
CUL_XmitLimitCheck($hash,$bstring);
$hash->{PortObj}->write($bstring);
InternalTimer(gettimeofday()+0.25, "CUL_HandleWriteQueue", $hash, 1);
}
}
#####################################
sub
CUL_Read($)
{
my ($hash) = @_;
my $buf = $hash->{PortObj}->input();
my $iohash = $modules{$hash->{TYPE}}; # Our (CUL) module pointer
my $name = $hash->{NAME};
###########
# Lets' try again: Some drivers return len(0) on the first read...
if(defined($buf) && length($buf) == 0) {
$buf = $hash->{PortObj}->input();
}
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');
CUL_DoInit($hash);
return;
}
}
}
my $culdata = $hash->{PARTIAL};
Log 5, "CUL/RAW: $culdata/$buf";
$culdata .= $buf;
while($culdata =~ m/\n/) {
my $dmsg;
($dmsg,$culdata) = split("\n", $culdata);
$dmsg =~ s/\r//;
###############
# check for duplicate msg from different CUL's
my $now = gettimeofday();
my $skip;
my $meetoo = ($attr{$name}{repeater} ? 1 : 0);
my $to = 0.3;
if(defined($attr{$name}) && defined($attr{$name}{filtertimeout})) {
$to = $attr{$name}{filtertimeout};
}
foreach my $oidx (keys %msghist) {
if($now-$msghist{$oidx}{TIME} > $to) {
delete($msghist{$oidx});
next;
}
if($msghist{$oidx}{MSG} eq $dmsg &&
($meetoo || $msghist{$oidx}{NAME} ne $name)) {
Log 5, "Skipping $msghist{$oidx}{MSG}";
$skip = 1;
}
}
goto NEXTMSG if($skip);
$msghist{$msgcount}{TIME} = $now;
$msghist{$msgcount}{NAME} = $name;
$msghist{$msgcount}{MSG} = $dmsg;
$msgcount++;
Log 1, "CUL: $dmsg";
#Translate Message from CUL to FHZ
my $fn = substr($dmsg,0,1);
if($fn eq "F") { # FS20
$dmsg = sprintf("81%02x04xx0101a001%s00%s",
length($dmsg)/2+5,
substr($dmsg,1,6), substr($dmsg,7));
$dmsg = lc($dmsg);
} elsif($fn eq "T") { # FHT
$dmsg =~ s/([1-4]\d)79(..)$/${1}69$2/; # should be done in the FHT
$dmsg = sprintf("81%02x04xx0909a001%s00%s",
length($dmsg)/2+5,
substr($dmsg,1,6), substr($dmsg,7));
$dmsg = lc($dmsg);
} else {
Log 5, "CUL: unknown message $dmsg";
goto NEXTMSG;
}
my @found;
my $last_module;
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;
last if(int(@found));
}
if(!int(@found)) {
Log 1, "Unknown code $dmsg, help me!";
goto NEXTMSG;
}
goto NEXTMSG if($found[0] eq ""); # Special return: Do not notify
if($found[0] =~ m/^(UNDEFINED) ([^ ]*) (.*)$/) {
my $d = $1;
$defs{$d}{NAME} = $1;
$defs{$d}{TYPE} = $last_module;
DoTrigger($d, "$2 $3");
delete $defs{$d};
goto NEXTMSG;
}
foreach my $found (@found) {
DoTrigger($found, undef);
}
NEXTMSG:
}
$hash->{PARTIAL} = $culdata;
}
#####################################
sub
CUL_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;

37
fhem/FHEM/00_FHZ.pm
View File

@ -9,9 +9,9 @@ use Time::HiRes qw(gettimeofday);
sub FHZ_Write($$$); sub FHZ_Write($$$);
sub FHZ_Read($); sub FHZ_Read($);
sub FHZ_ReadAnswer($$); sub FHZ_ReadAnswer($$);
sub FhzCrc(@); sub FHZ_Crc(@);
sub CheckFhzCrc($); sub FHZ_CheckCrc($);
sub XmitLimitCheck($$); sub FHZ_XmitLimitCheck($$);
my $msgstart = pack('H*', "81");# Every msg starts wit this my $msgstart = pack('H*', "81");# Every msg starts wit this
@ -47,7 +47,6 @@ my %codes = (
my $def; my $def;
my %msghist; # Used when more than one FHZ is attached my %msghist; # Used when more than one FHZ is attached
my $msgcount = 0; my $msgcount = 0;
my $xmit_limit = 163; # Maximum nr of transmissions per hour (unconfirmed).
##################################### #####################################
# Note: we are a data provider _and_ a consumer at the same time # Note: we are a data provider _and_ a consumer at the same time
@ -61,16 +60,18 @@ FHZ_Initialize($)
$hash->{ReadFn} = "FHZ_Read"; $hash->{ReadFn} = "FHZ_Read";
$hash->{WriteFn} = "FHZ_Write"; $hash->{WriteFn} = "FHZ_Write";
$hash->{Clients} = ":FHZ:FS20:FHT:HMS:KS300:"; $hash->{Clients} = ":FHZ:FS20:FHT:HMS:KS300:";
$hash->{ReadyFn} = "FHZ_Ready" if ($^O eq 'MSWin32');
# Consumer # Consumer
$hash->{Match} = "^81..C9..0102"; $hash->{Match} = "^81..C9..0102";
$hash->{ParseFn} = "FHZ_Parse";
# Normal devices
$hash->{DefFn} = "FHZ_Define"; $hash->{DefFn} = "FHZ_Define";
$hash->{UndefFn} = "FHZ_Undef"; $hash->{UndefFn} = "FHZ_Undef";
$hash->{GetFn} = "FHZ_Get"; $hash->{GetFn} = "FHZ_Get";
$hash->{SetFn} = "FHZ_Set"; $hash->{SetFn} = "FHZ_Set";
$hash->{StateFn} = "FHZ_SetState"; $hash->{StateFn} = "FHZ_SetState";
$hash->{ParseFn} = "FHZ_Parse";
$hash->{ReadyFn} = "FHZ_Ready" if ($^O eq 'MSWin32');
$hash->{AttrList}= "do_not_notify:1,0 dummy:1,0 filtertimeout repeater:1,0 " . $hash->{AttrList}= "do_not_notify:1,0 dummy:1,0 filtertimeout repeater:1,0 " .
"showtime:1,0 model:fhz1000,fhz1300 loglevel:0,1,2,3,4,5,6 ". "showtime:1,0 model:fhz1000,fhz1300 loglevel:0,1,2,3,4,5,6 ".
"fhtsoftbuffer:1,0"; "fhtsoftbuffer:1,0";
@ -85,6 +86,7 @@ FHZ_Ready($$)
my ($BlockingFlags, $InBytes, $OutBytes, $ErrorFlags)=$po->status; my ($BlockingFlags, $InBytes, $OutBytes, $ErrorFlags)=$po->status;
return ($InBytes>0); return ($InBytes>0);
} }
##################################### #####################################
sub sub
FHZ_Set($@) FHZ_Set($@)
@ -134,7 +136,7 @@ FHZ_Set($@)
} }
FHZ_Write($hash, $fn, $arg) if(!IsDummy("FHZ")); FHZ_Write($hash, $fn, $arg) if(!IsDummy($hash->{NAME}));
return undef; return undef;
} }
@ -154,7 +156,7 @@ FHZ_Get($@)
my $name = $hash->{NAME}; my $name = $hash->{NAME};
Log GetLogLevel($name,2), "FHZ get $v"; Log GetLogLevel($name,2), "FHZ get $v";
FHZ_Write($hash, $fn, $arg) if(!IsDummy("FHZ")); FHZ_Write($hash, $fn, $arg) if(!IsDummy($hash->{NAME}));
my $msg = FHZ_ReadAnswer($hash, $a[1]); my $msg = FHZ_ReadAnswer($hash, $a[1]);
return $msg if(!$msg || $msg !~ /^81..c9..0102/); return $msg if(!$msg || $msg !~ /^81..c9..0102/);
@ -338,7 +340,7 @@ FHZ_Parse($$)
##################################### #####################################
sub sub
FhzCrc(@) FHZ_Crc(@)
{ {
my $sum = 0; my $sum = 0;
map { $sum += $_; } @_; map { $sum += $_; } @_;
@ -347,7 +349,7 @@ FhzCrc(@)
##################################### #####################################
sub sub
CheckFhzCrc($) FHZ_CheckCrc($)
{ {
my $msg = shift; my $msg = shift;
return 0 if(length($msg) < 8); return 0 if(length($msg) < 8);
@ -360,7 +362,7 @@ CheckFhzCrc($)
# FS20 Repeater generate a CRC which is one or two greater then the computed # FS20 Repeater generate a CRC which is one or two greater then the computed
# one. The FHZ1000 filters such pakets, so we do not see them # one. The FHZ1000 filters such pakets, so we do not see them
return (($crc eq FhzCrc(@data)) ? 1 : 0); return (($crc eq FHZ_Crc(@data)) ? 1 : 0);
} }
@ -405,6 +407,7 @@ FHZ_ReadAnswer($$)
} }
############## ##############
# Compute CRC, add header, glue fn and messages
sub sub
FHZ_CompleteMsg($$) FHZ_CompleteMsg($$)
{ {
@ -414,14 +417,14 @@ FHZ_CompleteMsg($$)
for(my $i = 0; $i < $len; $i += 2) { for(my $i = 0; $i < $len; $i += 2) {
push(@data, ord(pack('H*', substr($msg, $i, 2)))); push(@data, ord(pack('H*', substr($msg, $i, 2))));
} }
return pack('C*', 0x81, $len/2+2, ord(pack('H*',$fn)), FhzCrc(@data), @data); return pack('C*', 0x81, $len/2+2, ord(pack('H*',$fn)), FHZ_Crc(@data), @data);
} }
##################################### #####################################
# Check if the 1% limit is reached and trigger notifies # Check if the 1% limit is reached and trigger notifies
sub sub
XmitLimitCheck($$) FHZ_XmitLimitCheck($$)
{ {
my ($hash,$bstring) = @_; my ($hash,$bstring) = @_;
my $now = time(); my $now = time();
@ -438,7 +441,7 @@ XmitLimitCheck($$)
my $nowM1h = $now-3600; my $nowM1h = $now-3600;
my @b = grep { $_ > $nowM1h } @{$hash->{XMIT_TIME}}; my @b = grep { $_ > $nowM1h } @{$hash->{XMIT_TIME}};
if(@b > $xmit_limit) { if(@b > 163) { # Maximum nr of transmissions per hour (unconfirmed).
my $me = $hash->{NAME}; my $me = $hash->{NAME};
Log GetLogLevel($me,2), "FHZ TRANSMIT LIMIT EXCEEDED"; Log GetLogLevel($me,2), "FHZ TRANSMIT LIMIT EXCEEDED";
@ -481,7 +484,7 @@ FHZ_Write($$$)
if(!$hash->{QUEUECNT}) { if(!$hash->{QUEUECNT}) {
XmitLimitCheck($hash,$bstring); FHZ_XmitLimitCheck($hash,$bstring);
$hash->{PortObj}->write($bstring); $hash->{PortObj}->write($bstring);
############## ##############
@ -507,7 +510,7 @@ FHZ_HandleWriteQueue($)
my $cnt = --$hash->{QUEUECNT}; my $cnt = --$hash->{QUEUECNT};
if($cnt > 0) { if($cnt > 0) {
my $bstring = shift(@{$hash->{QUEUE}}); my $bstring = shift(@{$hash->{QUEUE}});
XmitLimitCheck($hash,$bstring); FHZ_XmitLimitCheck($hash,$bstring);
$hash->{PortObj}->write($bstring); $hash->{PortObj}->write($bstring);
InternalTimer(gettimeofday()+0.25, "FHZ_HandleWriteQueue", $hash, 1); InternalTimer(gettimeofday()+0.25, "FHZ_HandleWriteQueue", $hash, 1);
} }
@ -583,7 +586,7 @@ FHZ_Read($)
last if(length($fhzdata) < $len); last if(length($fhzdata) < $len);
my $dmsg = unpack('H*', substr($fhzdata, 0, $len)); my $dmsg = unpack('H*', substr($fhzdata, 0, $len));
if(CheckFhzCrc($dmsg)) { if(FHZ_CheckCrc($dmsg)) {
if(substr($fhzdata,2,1) eq $msgstart) { # Skip function 0x81 if(substr($fhzdata,2,1) eq $msgstart) { # Skip function 0x81
$fhzdata = substr($fhzdata, 2); $fhzdata = substr($fhzdata, 2);

14
fhem/FHEM/10_FS20.pm
View File

@ -177,13 +177,8 @@ FS20_Set($@)
(undef, $v) = split(" ", $v, 2); # Not interested in the name... (undef, $v) = split(" ", $v, 2); # Not interested in the name...
my $val; my $val;
if($na == 2) {
IOWrite($hash, "04", "010101" . $hash->{XMIT} . $hash->{BTN} . $c)
if(!IsDummy($a[0]));
} else {
if($na == 3) { # Timed command.
$c =~ s/1/3/; # Set the extension bit $c =~ s/1/3/; # Set the extension bit
######################## ########################
@ -202,12 +197,11 @@ FS20_Set($@)
} }
} }
return "Specified timeout too large, max is 15360" if(length($c) == 2); return "Specified timeout too large, max is 15360" if(length($c) == 2);
IOWrite($hash, "04", "010101" . $hash->{XMIT} . $hash->{BTN} . $c)
if(!IsDummy($a[0]));
} }
IOWrite($hash, "04", "010101" . $hash->{XMIT} . $hash->{BTN} . $c)
if(!IsDummy($a[0]));
########################################### ###########################################
# Set the state of a device to off if on-for-timer is called # Set the state of a device to off if on-for-timer is called
if($follow{$a[0]}) { if($follow{$a[0]}) {