FHEM/fhem-mirror
2
0
Fork 0
mirror of https://github.com/fhem/fhem-mirror.git synced 2025-03-03 16:56:54 +00:00
Code Issues Releases Wiki Activity

00_TUL.pm: ABU 20170427 reintegrated mechanism for extenden GAD-Support, cleaned logs

Browse Source 
git-svn-id: https://svn.fhem.de/fhem/trunk@14126 2b470e98-0d58-463d-a4d8-8e2adae1ed80
This commit is contained in:
andi291 2017-04-28 08:04:26 +00:00
parent 816db3e62f
commit 0e1025056e
1 changed files with 50 additions and 43 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

93
fhem/FHEM/00_TUL.pm
View File

@ -13,6 +13,8 @@
# ABU 20161108 added knxd. Added doku as well. Added summary. Treat it like eibd. See thread #58375 # ABU 20161108 added knxd. Added doku as well. Added summary. Treat it like eibd. See thread #58375
# ABU 20170102 fixed write-mechanism, added mod for extended adressing (thx to its2bit) # ABU 20170102 fixed write-mechanism, added mod for extended adressing (thx to its2bit)
# ABU 20170110 removed mod for extended adressing # ABU 20170110 removed mod for extended adressing
# ABU 20170427 reintegrated mechanism for extenden GAD-Support
# ABU 20170427 cleaned logs
package main; package main;
@ -64,8 +66,6 @@ TUL_Initialize($)
$hash->{UndefFn} = "TUL_Undef"; $hash->{UndefFn} = "TUL_Undef";
$hash->{StateFn} = "TUL_SetState"; $hash->{StateFn} = "TUL_SetState";
$hash->{AttrFn} = "TUL_Attr"; $hash->{AttrFn} = "TUL_Attr";
#$hash->{AttrList}= "do_not_notify:1,0 dummy:1,0 " .
# "showtime:1,0 model:TUL loglevel:0,1,2,3,4,5,6 ";
$hash->{AttrList}= "do_not_notify:1,0 " . $hash->{AttrList}= "do_not_notify:1,0 " .
"dummy:1,0 " . "dummy:1,0 " .
@ -87,7 +87,6 @@ TUL_Define($$)
if(@a < 4) if(@a < 4)
{ {
my $msg = "wrong syntax: define <name> TUL <devicename> <device addr> [<line def in hex>]"; my $msg = "wrong syntax: define <name> TUL <devicename> <device addr> [<line def in hex>]";
Log (2, $msg);
return $msg; return $msg;
} }
@ -107,8 +106,6 @@ TUL_Define($$)
#Set attributes in order to control backward-compatibility #Set attributes in order to control backward-compatibility
#$attr{$name}{useEIB} = 1; #$attr{$name}{useEIB} = 1;
#Log3 ($name, 1, "Using EIB is deprecated. Please migrate to KNX soon. Module 10_EIB is not maintained any longer.") if (AttrVal($name, "useEIB", 0) =~ m/1/);
#Log3 ($name, 0, "Using EIB is deprecated. Please migrate to KNX soon. Module 10_EIB is not maintained any longer. If you still want to use the module EIB, please set the attribute useEIB to 1.") if (AttrVal($name, "useEIB", 0) =~ m/1/);
Log3 ($name, 0, "Using EIB is deprecated. Please migrate to KNX soon. Module 10_EIB is not maintained any longer. If you still want to use the module EIB, Log3 ($name, 0, "Using EIB is deprecated. Please migrate to KNX soon. Module 10_EIB is not maintained any longer. If you still want to use the module EIB,
please set the attribute useEIB to 1 within the tul-device. Please keep in mind, that 10_KNX has a changed syntax regarding the definition, arguments and readings. Please refer to the commandref. please set the attribute useEIB to 1 within the tul-device. Please keep in mind, that 10_KNX has a changed syntax regarding the definition, arguments and readings. Please refer to the commandref.
As well 10_EIB and 10_KNX are compatible to daemon eibd and knxd.") if (AttrVal($name, "useEIB", 0) =~ m/0/); As well 10_EIB and 10_KNX are compatible to daemon eibd and knxd.") if (AttrVal($name, "useEIB", 0) =~ m/0/);
@ -305,7 +302,10 @@ TUL_SimpleWrite(@)
# v is a simple (1 Byte) or complex value (n bytes) # v is a simple (1 Byte) or complex value (n bytes)
# For eibd we need a more elaborate structure # For eibd we need a more elaborate structure
if($msg =~ /^[BC](.)(.{4})(.*)$/) # Old
#if($msg =~ /^[BC](.)(.{4})(.*)$/)
# New: its2bit
if($msg =~ /^[BC](.)(.{5})(.*)$/)
{ {
my $eibmsg; my $eibmsg;
if($1 eq "w") if($1 eq "w")
@ -583,7 +583,7 @@ TUL_OpenDev($$)
if($ret) if($ret)
{ {
TUL_CloseDev($hash); TUL_CloseDev($hash);
Log 1, "Cannot init $dev, ignoring it"; Log (1, "Cannot init $dev, ignoring it");
} }
DoTrigger($name, "CONNECTED") if($reopen); DoTrigger($name, "CONNECTED") if($reopen);
@ -636,7 +636,10 @@ TUL_Attr(@)
sub tul_hex2addr sub tul_hex2addr
{ {
my $str = lc($_[0]); my $str = lc($_[0]);
if ($str =~ /([0-9a-f])([0-9a-f])([0-9a-f]{2})/) # Old
#if ($str =~ /([0-9a-f])([0-9a-f])([0-9a-f]{2})/)
# New its2bit
if ($str =~ /([0-9a-f]{2})([0-9a-f])([0-9a-f]{2})/)
{ {
return (hex($1) << 11) | (hex($2) << 8) | hex($3); return (hex($1) << 11) | (hex($2) << 8) | hex($3);
} }
@ -656,14 +659,17 @@ sub tul_addr2hex
{ {
#logical address used #logical address used
#old, short-syntax #old, short-syntax
$str = sprintf "%01x%01x%02x", ($a >> 11) & 0xf, ($a >> 8) & 0x7, $a & 0xff; #$str = sprintf "%01x%01x%02x", ($a >> 11) & 0xf, ($a >> 8) & 0x7, $a & 0xff;
#extended adress-range #extended adress-range
#$str = sprintf "%02x%01x%02x", ($a >> 11) & 0x1f, ($a >> 8) & 0x7, $a & 0xff; $str = sprintf "%02x%01x%02x", ($a >> 11) & 0x1f, ($a >> 8) & 0x7, $a & 0xff;
} }
else else
{ {
#physical address used #physical address used
$str = sprintf "%01x%01x%02x", $a >> 12, ($a >> 8) & 0xf, $a & 0xff; # Old
# $str = sprintf "%01x%01x%02x", $a >> 12, ($a >> 8) & 0xf, $a & 0xff;
# New
$str = sprintf "%02x%01x%02x", $a >> 12, ($a >> 8) & 0xf, $a & 0xff;
} }
return $str; return $str;
} }
@ -673,7 +679,10 @@ sub tul_str2hex
my $str = $_[0]; my $str = $_[0];
if ($str =~ /(\d+)\/(\d+)\/(\d+)/) if ($str =~ /(\d+)\/(\d+)\/(\d+)/)
{ # logical address { # logical address
my $hex = sprintf("%01x%01x%02x",$1,$2,$3); # old
# my $hex = sprintf("%01x%01x%02x",$1,$2,$3);
# New
my $hex = sprintf("%02x%01x%02x",$1,$2,$3);
return $hex; return $hex;
} }
elsif ($str =~ /(\d+)\.(\d+)\.(\d+)/) elsif ($str =~ /(\d+)\.(\d+)\.(\d+)/)
@ -713,7 +722,6 @@ sub decode_eibd($)
{ {
$msg{'type'} = 'apci ' . $apci; $msg{'type'} = 'apci ' . $apci;
} }
$msg{'src'} = tul_addr2hex($src,0); $msg{'src'} = tul_addr2hex($src,0);
$msg{'dst'} = tul_addr2hex($dst,1); $msg{'dst'} = tul_addr2hex($dst,1);
@ -751,7 +759,7 @@ sub encode_eibd($)
@data = (0x0) if(!@data || !defined($data[0])); #make sure data has at least one element @data = (0x0) if(!@data || !defined($data[0])); #make sure data has at least one element
#@data = (0x0) if(!(defined @data) || !(defined $data[0])); #make sure data has at least one element #@data = (0x0) if(!(defined @data) || !(defined $data[0])); #make sure data has at least one element
my $datalen = @data; my $datalen = @data;
Log(5,"encode_eibd dst: $mref->{'dst'} apci: $APCI datalen: $datalen data: @data"); Log (5,"encode_eibd dst: $mref->{'dst'} apci: $APCI datalen: $datalen data: @data");
@msg = ( @msg = (
tul_hex2addr( $mref->{'dst'}), # Destination address tul_hex2addr( $mref->{'dst'}), # Destination address
0x0 | ($APCI >> 2), # TPDU type, Sequence no, APCI (msb) 0x0 | ($APCI >> 2), # TPDU type, Sequence no, APCI (msb)
@ -796,12 +804,11 @@ sub decode_tpuart($)
#if(($ctrl & 0xB0)!=0xB0) #if(($ctrl & 0xB0)!=0xB0)
if(($ctrl & 0x90)!=0x90) if(($ctrl & 0x90)!=0x90)
{ {
#Log(3,"Control Byte " . sprintf("0x%02x",$ctrl) . " does not match expected mask 0xB0"); Log (3,"Control Byte " . sprintf("0x%02x",$ctrl) . " does not match expected mask 2x1001nnnn");
Log(3,"Control Byte " . sprintf("0x%02x",$ctrl) . " does not match expected mask 2x1001nnnn");
return undef; return undef;
} }
Log(5,"msg cmd: " . sprintf("0x%02x",$cmd) ." datalen: $len"); Log (5,"msg cmd: " . sprintf("0x%02x",$cmd) ." datalen: $len");
my $apci = ($cmd >> 6) & 0x0F; my $apci = ($cmd >> 6) & 0x0F;
if($len == 2) if($len == 2)
@ -809,7 +816,7 @@ sub decode_tpuart($)
$bytes = pack("C",$cmd & 0x3F); $bytes = pack("C",$cmd & 0x3F);
} }
Log(5,"msg cmd: " . sprintf("0x%02x",$cmd) ." datalen: $len apci: $apci"); Log (5,"msg cmd: " . sprintf("0x%02x",$cmd) ." datalen: $len apci: $apci");
my %msg; my %msg;
my @data; my @data;
@ -827,7 +834,7 @@ sub decode_tpuart($)
@data = unpack ("C" . length($bytes), $bytes); @data = unpack ("C" . length($bytes), $bytes);
my $datalen = @data; my $datalen = @data;
Log(5, "decode_tpuart byte len: " . length($bytes) . " array size: $datalen"); Log (5, "decode_tpuart byte len: " . length($bytes) . " array size: $datalen");
$msg{'data'} = \@data; $msg{'data'} = \@data;
return \%msg; return \%msg;
@ -844,18 +851,18 @@ sub encode_tpuart($)
$APCI = $apcivalues{$mref->{'type'}}; $APCI = $apcivalues{$mref->{'type'}};
if (!(defined $APCI)) if (!(defined $APCI))
{ {
Log(3,"Bad EIB message type $mref->{'type'}\n"); Log (3,"Bad EIB message type $mref->{'type'}\n");
return; return;
} }
@data = @{$mref->{'data'}}; @data = @{$mref->{'data'}};
my $datalen = @data; my $datalen = @data;
if($datalen > 14) if($datalen > 14)
{ {
Log(3,"Bad EIB message length $datalen\n"); Log (3,"Bad EIB message length $datalen\n");
return; return;
} }
Log(5,"encode_tpuart dst: $mref->{'dst'} apci: $APCI datalen: $datalen data: @data"); Log (5,"encode_tpuart dst: $mref->{'dst'} apci: $APCI datalen: $datalen data: @data");
@msg = ( @msg = (
0xBC, # EIB ctrl byte 0xBC, # EIB ctrl byte
tul_hex2addr($mref->{'src'}), # src address tul_hex2addr($mref->{'src'}), # src address
@ -933,7 +940,7 @@ sub sendGroup($$)
{ {
my @encmsg = encode_eibd($msgref); my @encmsg = encode_eibd($msgref);
Log(5,"SendGroup: dst: $dst, msg: @encmsg \n"); Log (5,"SendGroup: dst: $dst, msg: @encmsg \n");
my @msg = (0x0027); # EIB_GROUP_PACKET my @msg = (0x0027); # EIB_GROUP_PACKET
push @msg, @encmsg; push @msg, @encmsg;
@ -943,7 +950,7 @@ sub sendGroup($$)
{ {
my @encmsg = encode_tpuart($msgref); my @encmsg = encode_tpuart($msgref);
Log(5,"SendGroup: dst: $dst, msg: @encmsg \n"); Log (5,"SendGroup: dst: $dst, msg: @encmsg \n");
sendRequest($hash, pack("C*", @encmsg)); sendRequest($hash, pack("C*", @encmsg));
my $response = getRequestFixLength($hash,($#encmsg + 1)/2+1); my $response = getRequestFixLength($hash,($#encmsg + 1)/2+1);
} }
@ -957,12 +964,12 @@ sub purgeReceiverBuf($)
my ($hash) = @_; my ($hash) = @_;
if($hash->{DevType} eq 'TPUART') if($hash->{DevType} eq 'TPUART')
{ {
Log(5,"purging receiver buffer "); Log (5,"purging receiver buffer ");
my $data = undef; my $data = undef;
do do
{ {
my(undef,$data) = $hash->{USBDev}->read(100); my(undef,$data) = $hash->{USBDev}->read(100);
Log(5,"purging packet: ". unpack("H*",$data) . "\n") if(defined($data) and length($data)>0); Log (5,"purging packet: ". unpack("H*",$data) . "\n") if(defined($data) and length($data)>0);
} while(defined($data) and length($data)>0) } while(defined($data) and length($data)>0)
} }
} }
@ -973,16 +980,16 @@ sub getRequestFixLength($$)
if($hash->{DevType} eq 'TPUART') if($hash->{DevType} eq 'TPUART')
{ {
Log(5,"waiting to receive $len bytes ..."); Log (5,"waiting to receive $len bytes ...");
my $buf = ""; my $buf = "";
while(length($buf)<$len) while(length($buf)<$len)
{ {
#select(undef,undef,undef,0.5); #select(undef,undef,undef,0.5);
my (undef,$data) = $hash->{USBDev}->read($len-length($buf)); my (undef,$data) = $hash->{USBDev}->read($len-length($buf));
Log(5,"Received fixlen packet: ". unpack("H*",$data) . "\n") if(defined($data) and length($data)>0); Log (5,"Received fixlen packet: ". unpack("H*",$data) . "\n") if(defined($data) and length($data)>0);
$buf .= $data if(defined($data)); $buf .= $data if(defined($data));
#Log(5,"buf len: " . length($buf) . " expected: $len"); #Log (5,"buf len: " . length($buf) . " expected: $len");
# TODO: if we are longer than 5 seconds here, we should reset # TODO: if we are longer than 5 seconds here, we should reset
} }
@ -994,10 +1001,10 @@ sub getRequestFixLength($$)
$hash->{PARTIAL} .= $remainpart; $hash->{PARTIAL} .= $remainpart;
$buf = substr($buf,0,$len); $buf = substr($buf,0,$len);
Log(5,"we got too much.. buf(" .unpack("H*",$buf).") remainingpart(" .unpack("H*",$remainpart).")"); Log (5,"we got too much.. buf(" .unpack("H*",$buf).") remainingpart(" .unpack("H*",$remainpart).")");
} }
Log(5,"getRequest len: $len packet: ". unpack("H*",$buf) . "\n"); Log (5,"getRequest len: $len packet: ". unpack("H*",$buf) . "\n");
return $buf; return $buf;
} }
@ -1031,7 +1038,7 @@ sub getGroup($)
my $data = getRequestFixLength($hash,$reqlen-length($buf)) if($reqlen>length($buf)); my $data = getRequestFixLength($hash,$reqlen-length($buf)) if($reqlen>length($buf));
if(length($buf)==0 && (!defined($data)||length($data)==0)) if(length($buf)==0 && (!defined($data)||length($data)==0))
{ {
Log(5,"read fix length delivered no data."); Log (5,"read fix length delivered no data.");
return undef; return undef;
} }
$buf .= $data if(defined($data)); $buf .= $data if(defined($data));
@ -1042,7 +1049,7 @@ sub getGroup($)
{ {
$buf = substr($buf,1); $buf = substr($buf,1);
$hash->{PARTIAL} = $buf; $hash->{PARTIAL} = $buf;
Log(5,"TPUART RSP " . sprintf("0x%02x",$ctrl) ." ignored."); Log (5,"TPUART RSP " . sprintf("0x%02x",$ctrl) ." ignored.");
return undef; return undef;
} }
@ -1050,7 +1057,7 @@ sub getGroup($)
{ {
my $routingcnt = unpack("xxxxxC", $buf); my $routingcnt = unpack("xxxxxC", $buf);
$reqlen = ($routingcnt & 0x0F)+8; $reqlen = ($routingcnt & 0x0F)+8;
Log(5,"receiving telegram with len: $reqlen"); Log (5,"receiving telegram with len: $reqlen");
} }
@ -1062,8 +1069,8 @@ sub getGroup($)
} }
while(!defined($telegram)); while(!defined($telegram));
Log(5, "Telegram: (".length($telegram)."): " . unpack("H*",$telegram)); Log (5, "Telegram: (".length($telegram)."): " . unpack("H*",$telegram));
Log(5, "Buf: (".length($buf)."): " . unpack("H*",$buf)); Log (5, "Buf: (".length($buf)."): " . unpack("H*",$buf));
$hash->{PARTIAL} = $buf; $hash->{PARTIAL} = $buf;
my $msg = decode_tpuart($telegram); my $msg = decode_tpuart($telegram);
@ -1076,13 +1083,13 @@ sub getGroup($)
# { # {
# # ACK # # ACK
# sendRequest($hash,pack('C',0x11)); # sendRequest($hash,pack('C',0x11));
# Log(5,"Ack!"); # Log (5,"Ack!");
# } # }
return $msg; return $msg;
} }
Log(2,"DevType $hash->{DevType} not supported for getGroup\n"); Log (2,"DevType $hash->{DevType} not supported for getGroup\n");
return undef; return undef;
error: error:
@ -1102,16 +1109,16 @@ sub getRequest($)
goto error unless sysread($hash->{TCPDev}, $data, 2); goto error unless sysread($hash->{TCPDev}, $data, 2);
my $size = unpack ("n", $data); my $size = unpack ("n", $data);
goto error unless sysread($hash->{TCPDev}, $data, $size); goto error unless sysread($hash->{TCPDev}, $data, $size);
Log(5,"Received packet: ". unpack("H*",$data) . "\n"); Log (5,"Received packet: ". unpack("H*",$data) . "\n");
return $data; return $data;
} }
elsif($hash->{USBDev}) { elsif($hash->{USBDev}) {
my $data = $hash->{USBDev}->input(); my $data = $hash->{USBDev}->input();
Log(5,"Received packet: ". unpack("H*",$data) . "\n") if(defined($data) and length($data)>0); Log (5,"Received packet: ". unpack("H*",$data) . "\n") if(defined($data) and length($data)>0);
return $data; return $data;
} }
Log(1,"TUL $hash->{NAME}: can not select a source for reading data."); Log (1,"TUL $hash->{NAME}: can not select a source for reading data.");
return undef; return undef;
error: error:
@ -1125,7 +1132,7 @@ sub getRequest($)
sub sendRequest($$) sub sendRequest($$)
{ {
my ($hash,$str) = @_; my ($hash,$str) = @_;
Log(5,"sendRequest: ". unpack("H*",$str). "\n"); Log (5,"sendRequest: ". unpack("H*",$str). "\n");
if($hash->{TCPDev}) if($hash->{TCPDev})
{ {
@ -1141,7 +1148,7 @@ sub sendRequest($$)
} }
else else
{ {
Log(2,"TUL $hash->{NAME}: No known physical protocoll defined."); Log (2,"TUL $hash->{NAME}: No known physical protocoll defined.");
return undef; return undef;
} }
return 1; return 1;