FHEM/fhem-mirror
2
0
Fork 0
mirror of https://github.com/fhem/fhem-mirror.git synced 2025-04-07 19:04:20 +00:00
Code Issues Releases Wiki Activity
fhem-mirror/fhem/FHEM/00_FHZ.pm
rudolfkoenig c25b2fbf32 stty/pgm2 fix for FHT summary 
git-svn-id: https://svn.fhem.de/fhem/trunk@160 2b470e98-0d58-463d-a4d8-8e2adae1ed80
2008-04-16 16:26:25 +00:00

639 lines
14 KiB
Perl
Executable File
Raw Blame History

##############################################
package main;
use strict;
use warnings;
use Time::HiRes qw(gettimeofday);
use Device::SerialPort;
sub FHZ_Write($$$);
sub FHZ_Read($);
sub FHZ_ReadAnswer($$);
sub FhzCrc(@);
sub CheckFhzCrc($);
sub XmitLimitCheck($$);
my $msgstart = pack('H*', "81");# Every msg starts wit this
my %gets = (
"init1" => "c9 02011f64",
"init2" => "c9 02011f60",
"init3" => "c9 02011f0a",
"serial" => "04 c90184570208",
"fhtbuf" => "04 c90185",
);
my %sets = (
"time" => "c9 020161",
"initHMS" => "04 c90186",
"initFS20" => "04 c90196",
"FHTcode" => "04 c901839e0101",
"activefor"=> "xx xx",
"raw" => "xx xx",
);
my %setnrparam = (
"time" => 0,
"initHMS" => 0,
"initFS20" => 0,
"FHTcode" => 1,
"activefor"=> 1,
"raw" => 2,
);
my %codes = (
"^8501..\$" => "fhtbuf",
);
my $def;
my %msghist; # Used when more than one FHZ is attached
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
sub
FHZ_Initialize($)
{
my ($hash) = @_;
# Provider
$hash->{ReadFn} = "FHZ_Read";
$hash->{WriteFn} = "FHZ_Write";
$hash->{Clients} = ":FHZ:FS20:FHT:HMS:KS300:";
# Consumer
$hash->{Match} = "^81..C9..0102";
$hash->{DefFn} = "FHZ_Define";
$hash->{UndefFn} = "FHZ_Undef";
$hash->{GetFn} = "FHZ_Get";
$hash->{SetFn} = "FHZ_Set";
$hash->{StateFn} = "FHZ_SetState";
$hash->{ParseFn} = "FHZ_Parse";
$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 ".
"fhtsoftbuffer:1,0";
}
#####################################
sub
FHZ_Set($@)
{
my ($hash, @a) = @_;
return "Need one to three parameter" if(@a < 2);
return "Unknown argument $a[1], choose one of " . join(" ", sort keys %sets)
if(!defined($sets{$a[1]}));
return "Need one to three parameter" if(@a > 4);
return "Wrong number of parameters for $a[1], need " . ($setnrparam{$a[1]}+2)
if(@a != ($setnrparam{$a[1]} + 2));
my ($fn, $arg) = split(" ", $sets{$a[1]});
my $v = join(" ", @a);
my $name = $hash->{NAME};
Log GetLogLevel($name,2), "FHZ set $v";
if($a[1] eq "activefor") {
my $dhash = $defs{$a[2]};
return "device $a[2] unknown" if(!defined($dhash));
return "Cannot handle $dhash->{TYPE} devices"
if($modules{FHZ}->{Clients} !~ m/:$dhash->{TYPE}:/);
$dhash->{IODev} = $hash;
return undef;
} elsif($a[1] eq "raw") {
$fn = $a[2];
$arg = $a[3];
} elsif($a[1] eq "time") {
my @t = localtime;
$arg .= sprintf("%02x%02x%02x%02x%02x",
$t[5]%100, $t[4]+1, $t[3], $t[2], $t[1]);
} elsif($a[1] eq "FHTcode") {
return "invalid argument, must be hex" if(!$a[2] ||
$a[2] !~ m/^[A-F0-9]{2}$/);
$arg .= $a[2];
}
FHZ_Write($hash, $fn, $arg) if(!IsDummy("FHZ"));
return undef;
}
#####################################
sub
FHZ_Get($@)
{
my ($hash, @a) = @_;
return "\"get FHZ\" needs only one parameter" if(@a != 2);
return "Unknown argument $a[1], choose one of " . join(",", sort keys %gets)
if(!defined($gets{$a[1]}));
my ($fn, $arg) = split(" ", $gets{$a[1]});
my $v = join(" ", @a);
my $name = $hash->{NAME};
Log GetLogLevel($name,2), "FHZ get $v";
FHZ_Write($hash, $fn, $arg) if(!IsDummy("FHZ"));
my $msg = FHZ_ReadAnswer($hash, $a[1]);
return $msg if(!$msg || $msg !~ /^81..c9..0102/);
if($a[1] eq "serial") {
$v = substr($msg, 22, 8)
} elsif($a[1] eq "fhtbuf") {
$v = substr($msg, 16, 2);
} else {
$v = substr($msg, 12);
}
$hash->{READINGS}{$a[1]}{VAL} = $v;
$hash->{READINGS}{$a[1]}{TIME} = TimeNow();
return "$a[0] $a[1] => $v";
}
#####################################
sub
FHZ_SetState($$$$)
{
my ($hash, $tim, $vt, $val) = @_;
return "Undefined value $vt" if(!defined($gets{$vt}));
return undef;
}
#####################################
sub
DoInit($)
{
my $name = shift;
my @init;
push(@init, "get $name init2");
push(@init, "get $name serial");
push(@init, "set $name initHMS");
push(@init, "set $name initFS20");
push(@init, "set $name time");
# Workaround: Sending "set 0001 00 off" after initialization to enable
# the fhz1000 receiver, else we won't get anything reported.
push(@init, "set $name raw 04 01010100010000");
CommandChain(3, \@init);
# Reset the counter
my $hash = $defs{$name};
delete($hash->{XMIT_TIME});
delete($hash->{NR_CMD_LAST_H});
}
#####################################
sub
FHZ_Define($$)
{
my ($hash, $def) = @_;
my @a = split("[ \t][ \t]*", $def);
$hash->{STATE} = "Initialized";
delete $hash->{PortObj};
delete $hash->{FD};
my $name = $a[0];
my $dev = $a[2];
$attr{$name}{savefirst} = 1;
$attr{$name}{fhtsoftbuffer} = 0;
if($dev eq "none") {
Log 1, "FHZ device is none, commands will be echoed only";
$attr{$name}{dummy} = 1;
return undef;
}
Log 3, "FHZ opening FHZ device $dev";
my $po = new Device::SerialPort ($dev);
return "Can't open $dev: $!\n" if(!$po);
Log 3, "FHZ opened FHZ device $dev";
$po->reset_error();
$po->baudrate(9600);
$po->databits(8);
$po->parity('none');
$po->stopbits(1);
$po->handshake('none');
# 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);
$hash->{PortObj} = $po;
$hash->{FD} = $po->FILENO;
$hash->{DeviceName} = $dev;
$hash->{PARTIAL} = "";
DoInit($name);
return undef;
}
#####################################
sub
FHZ_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
FHZ_Parse($$)
{
my ($hash,$msg) = @_;
my $omsg = $msg;
$msg = substr($msg, 12); # The first 12 bytes are not really interesting
my $type = "";
my $name = $hash->{NAME};
foreach my $c (keys %codes) {
if($msg =~ m/$c/) {
$type = $codes{$c};
last;
}
}
if(!$type) {
Log 4, "FHZ $name unknown: $omsg";
$def->{CHANGED}[0] = "$msg";
return $hash->{NAME};
}
if($type eq "fhtbuf") {
$msg = substr($msg, 4, 2);
}
Log 4, "FHZ $name $type: $msg";
$def->{CHANGED}[0] = "$type: $msg";
return $hash->{NAME};
}
#####################################
sub
FhzCrc(@)
{
my $sum = 0;
map { $sum += $_; } @_;
return $sum & 0xFF;
}
#####################################
sub
CheckFhzCrc($)
{
my $msg = shift;
return 0 if(length($msg) < 8);
my @data;
for(my $i = 8; $i < length($msg); $i += 2) {
push(@data, ord(pack('H*', substr($msg, $i, 2))));
}
my $crc = hex(substr($msg, 6, 2));
# 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
return (($crc eq FhzCrc(@data)) ? 1 : 0);
}
#####################################
# This is a direct read for commands like get
sub
FHZ_ReadAnswer($$)
{
my ($hash,$arg) = @_;
return undef if(!$hash || !defined($hash->{FD}));
my ($mfhzdata, $rin) = ("", '');
for(;;) {
vec($rin, $hash->{FD}, 1) = 1;
my $nfound = select($rin, undef, undef, 3); # 3 seconds timeout
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, "FHZ/RAW: " . unpack('H*',$buf);
$mfhzdata .= $buf;
next if(length($mfhzdata) < 2);
my $len = ord(substr($mfhzdata,1,1)) + 2;
if($len>20) {
Log 4, "Oversized message (" . unpack('H*',$mfhzdata) .
"), dropping it ...";
return undef;
}
return unpack('H*', $mfhzdata) if(length($mfhzdata) == $len);
}
}
##############
sub
FHZ_CompleteMsg($$)
{
my ($fn,$msg) = @_;
my $len = length($msg);
my @data;
for(my $i = 0; $i < $len; $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);
}
#####################################
# Check if the 1% limit is reached and trigger notifies
sub
XmitLimitCheck($$)
{
my ($hash,$bstring) = @_;
my $now = time();
$bstring = unpack('H*', $bstring);
return if($bstring =~ m/c90185$/); # fhtbuf
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 > $xmit_limit) {
my $me = $hash->{NAME};
Log GetLogLevel($me,2), "FHZ TRANSMIT LIMIT EXCEEDED";
DoTrigger($me, "TRANSMIT LIMIT EXCEEDED");
} else {
push(@b, $now);
}
$hash->{XMIT_TIME} = \@b;
$hash->{NR_CMD_LAST_H} = int(@b);
}
#####################################
sub
FHZ_Write($$$)
{
my ($hash,$fn,$msg) = @_;
if(!$hash || !defined($hash->{PortObj})) {
Log 5, "FHZ device $hash->{NAME} is not active, cannot send";
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 "04" && substr($msg,0,6) eq "010101") {
my $nmsg = "0101a001" . substr($msg, 6, 6) . "00" . substr($msg, 12);
$msghist{$msgcount}{TIME} = gettimeofday();
$msghist{$msgcount}{NAME} = $hash->{NAME};
$msghist{$msgcount}{MSG} = unpack('H*', FHZ_CompleteMsg($fn, $nmsg));
$msgcount++;
}
my $bstring = FHZ_CompleteMsg($fn, $msg);
Log 5, "Sending " . unpack('H*', $bstring);
if(!$hash->{QUEUECNT}) {
XmitLimitCheck($hash,$bstring);
$hash->{PortObj}->write($bstring);
##############
# Write the next buffer not earlier than 0.22 seconds (= 65.6ms + 10ms +
# 65.6ms + 10ms + 65.6ms), else it will be discarded by the FHZ1X00 PC
InternalTimer(gettimeofday()+0.25, "FHZ_HandleWriteQueue", $hash, 1);
} elsif($hash->{QUEUECNT} == 1) {
$hash->{QUEUE} = [ $bstring ];
} else {
push(@{$hash->{QUEUE}}, $bstring);
}
$hash->{QUEUECNT}++;
}
#####################################
sub
FHZ_HandleWriteQueue($)
{
my $hash = shift;
my $cnt = --$hash->{QUEUECNT};
if($cnt > 0) {
my $bstring = shift(@{$hash->{QUEUE}});
XmitLimitCheck($hash,$bstring);
$hash->{PortObj}->write($bstring);
InternalTimer(gettimeofday()+0.25, "FHZ_HandleWriteQueue", $hash, 1);
}
}
#####################################
sub
FHZ_Read($)
{
my ($hash) = @_;
my $buf = $hash->{PortObj}->input();
my $iohash = $modules{$hash->{TYPE}};
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);
$hash->{PortObj} = new Device::SerialPort($devname);
if($hash->{PortObj}) {
Log 1, "USB device $devname reappeared";
$hash->{FD} = $hash->{PortObj}->FILENO;
DoInit($name);
return;
}
}
}
my $fhzdata = $hash->{PARTIAL};
Log 5, "FHZ/RAW: " . unpack('H*',$buf) .
" (Unparsed: " . unpack('H*', $fhzdata) . ")";
$fhzdata .= $buf;
while(length($fhzdata) > 2) {
###################################
# Skip trash.
my $si = index($fhzdata, $msgstart);
if($si) {
if($si == -1) {
Log(5, "Bogus message received, no start character found");
$fhzdata = "";
last;
} else {
Log(5, "Bogus message received, skipping to start character");
$fhzdata = substr($fhzdata, $si);
}
}
my $len = ord(substr($fhzdata,1,1)) + 2;
if($len>20) {
Log 4,
"Oversized message (" . unpack('H*',$fhzdata) . "), dropping it ...";
$fhzdata = "";
next;
}
last if(length($fhzdata) < $len);
my $dmsg = unpack('H*', substr($fhzdata, 0, $len));
if(CheckFhzCrc($dmsg)) {
if(substr($fhzdata,2,1) eq $msgstart) { # Skip function 0x81
$fhzdata = substr($fhzdata, 2);
next;
}
###############
# check for duplicate msg from different FHZ's
my $now = gettimeofday();
my $skip;
my $meetoo = ($attr{$name}{repeater} ? 1 : 0);
my $to = 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++;
my @found;
my $last_module;
foreach my $m (sort { $modules{$a}{ORDER} cmp $modules{$b}{ORDER} }
keys %modules) {
next if($iohash->{Clients} !~ m/:$m:/);
next if($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:
$fhzdata = substr($fhzdata, $len);
} else {
Log 4, "Bad CRC message, skipping it (Bogus message follows)";
$fhzdata = substr($fhzdata, 2);
}
}
$hash->{PARTIAL} = $fhzdata;
}
1;
Reference in New Issue View Git Blame Copy Permalink