mirror of
https://github.com/fhem/fhem-mirror.git
synced 2025-03-03 16:56:54 +00:00
00_TUL.pm: ABU 20170427 reintegrated mechanism for extenden GAD-Support, cleaned logs
git-svn-id: https://svn.fhem.de/fhem/trunk@14126 2b470e98-0d58-463d-a4d8-8e2adae1ed80
This commit is contained in:
andi291
parent
816db3e62f
commit
0e1025056e
@ -13,6 +13,8 @@
|
||||
# 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 20170110 removed mod for extended adressing
|
||||
# ABU 20170427 reintegrated mechanism for extenden GAD-Support
|
||||
# ABU 20170427 cleaned logs
|
||||
|
||||
package main;
|
||||
|
||||
@ -64,8 +66,6 @@ TUL_Initialize($)
|
||||
$hash->{UndefFn} = "TUL_Undef";
|
||||
$hash->{StateFn} = "TUL_SetState";
|
||||
$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 " .
|
||||
"dummy:1,0 " .
|
||||
@ -87,7 +87,6 @@ TUL_Define($$)
|
||||
if(@a < 4)
|
||||
{
|
||||
my $msg = "wrong syntax: define <name> TUL <devicename> <device addr> [<line def in hex>]";
|
||||
Log (2, $msg);
|
||||
return $msg;
|
||||
}
|
||||
|
||||
@ -107,8 +106,6 @@ TUL_Define($$)
|
||||
|
||||
#Set attributes in order to control backward-compatibility
|
||||
#$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,
|
||||
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/);
|
||||
@ -305,7 +302,10 @@ TUL_SimpleWrite(@)
|
||||
# v is a simple (1 Byte) or complex value (n bytes)
|
||||
|
||||
# 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;
|
||||
if($1 eq "w")
|
||||
@ -583,7 +583,7 @@ TUL_OpenDev($$)
|
||||
if($ret)
|
||||
{
|
||||
TUL_CloseDev($hash);
|
||||
Log 1, "Cannot init $dev, ignoring it";
|
||||
Log (1, "Cannot init $dev, ignoring it");
|
||||
}
|
||||
|
||||
DoTrigger($name, "CONNECTED") if($reopen);
|
||||
@ -636,7 +636,10 @@ TUL_Attr(@)
|
||||
sub tul_hex2addr
|
||||
{
|
||||
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);
|
||||
}
|
||||
@ -656,14 +659,17 @@ sub tul_addr2hex
|
||||
{
|
||||
#logical address used
|
||||
#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
|
||||
#$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
|
||||
{
|
||||
#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;
|
||||
}
|
||||
@ -673,7 +679,10 @@ sub tul_str2hex
|
||||
my $str = $_[0];
|
||||
if ($str =~ /(\d+)\/(\d+)\/(\d+)/)
|
||||
{ # 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;
|
||||
}
|
||||
elsif ($str =~ /(\d+)\.(\d+)\.(\d+)/)
|
||||
@ -713,7 +722,6 @@ sub decode_eibd($)
|
||||
{
|
||||
$msg{'type'} = 'apci ' . $apci;
|
||||
}
|
||||
|
||||
$msg{'src'} = tul_addr2hex($src,0);
|
||||
$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(!(defined @data) || !(defined $data[0])); #make sure data has at least one element
|
||||
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 = (
|
||||
tul_hex2addr( $mref->{'dst'}), # Destination address
|
||||
0x0 | ($APCI >> 2), # TPDU type, Sequence no, APCI (msb)
|
||||
@ -796,12 +804,11 @@ sub decode_tpuart($)
|
||||
#if(($ctrl & 0xB0)!=0xB0)
|
||||
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;
|
||||
}
|
||||
|
||||
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;
|
||||
if($len == 2)
|
||||
@ -809,7 +816,7 @@ sub decode_tpuart($)
|
||||
$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 @data;
|
||||
@ -827,7 +834,7 @@ sub decode_tpuart($)
|
||||
|
||||
@data = unpack ("C" . length($bytes), $bytes);
|
||||
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;
|
||||
return \%msg;
|
||||
@ -844,18 +851,18 @@ sub encode_tpuart($)
|
||||
$APCI = $apcivalues{$mref->{'type'}};
|
||||
if (!(defined $APCI))
|
||||
{
|
||||
Log(3,"Bad EIB message type $mref->{'type'}\n");
|
||||
Log (3,"Bad EIB message type $mref->{'type'}\n");
|
||||
return;
|
||||
}
|
||||
@data = @{$mref->{'data'}};
|
||||
my $datalen = @data;
|
||||
if($datalen > 14)
|
||||
{
|
||||
Log(3,"Bad EIB message length $datalen\n");
|
||||
Log (3,"Bad EIB message length $datalen\n");
|
||||
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 = (
|
||||
0xBC, # EIB ctrl byte
|
||||
tul_hex2addr($mref->{'src'}), # src address
|
||||
@ -933,7 +940,7 @@ sub sendGroup($$)
|
||||
{
|
||||
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
|
||||
push @msg, @encmsg;
|
||||
@ -943,7 +950,7 @@ sub sendGroup($$)
|
||||
{
|
||||
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));
|
||||
my $response = getRequestFixLength($hash,($#encmsg + 1)/2+1);
|
||||
}
|
||||
@ -957,12 +964,12 @@ sub purgeReceiverBuf($)
|
||||
my ($hash) = @_;
|
||||
if($hash->{DevType} eq 'TPUART')
|
||||
{
|
||||
Log(5,"purging receiver buffer ");
|
||||
Log (5,"purging receiver buffer ");
|
||||
my $data = undef;
|
||||
do
|
||||
{
|
||||
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)
|
||||
}
|
||||
}
|
||||
@ -973,16 +980,16 @@ sub getRequestFixLength($$)
|
||||
|
||||
if($hash->{DevType} eq 'TPUART')
|
||||
{
|
||||
Log(5,"waiting to receive $len bytes ...");
|
||||
Log (5,"waiting to receive $len bytes ...");
|
||||
my $buf = "";
|
||||
while(length($buf)<$len)
|
||||
{
|
||||
#select(undef,undef,undef,0.5);
|
||||
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));
|
||||
#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
|
||||
}
|
||||
|
||||
@ -994,10 +1001,10 @@ sub getRequestFixLength($$)
|
||||
$hash->{PARTIAL} .= $remainpart;
|
||||
$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;
|
||||
}
|
||||
|
||||
@ -1031,7 +1038,7 @@ sub getGroup($)
|
||||
my $data = getRequestFixLength($hash,$reqlen-length($buf)) if($reqlen>length($buf));
|
||||
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;
|
||||
}
|
||||
$buf .= $data if(defined($data));
|
||||
@ -1042,7 +1049,7 @@ sub getGroup($)
|
||||
{
|
||||
$buf = substr($buf,1);
|
||||
$hash->{PARTIAL} = $buf;
|
||||
Log(5,"TPUART RSP " . sprintf("0x%02x",$ctrl) ." ignored.");
|
||||
Log (5,"TPUART RSP " . sprintf("0x%02x",$ctrl) ." ignored.");
|
||||
return undef;
|
||||
}
|
||||
|
||||
@ -1050,7 +1057,7 @@ sub getGroup($)
|
||||
{
|
||||
my $routingcnt = unpack("xxxxxC", $buf);
|
||||
$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));
|
||||
|
||||
Log(5, "Telegram: (".length($telegram)."): " . unpack("H*",$telegram));
|
||||
Log(5, "Buf: (".length($buf)."): " . unpack("H*",$buf));
|
||||
Log (5, "Telegram: (".length($telegram)."): " . unpack("H*",$telegram));
|
||||
Log (5, "Buf: (".length($buf)."): " . unpack("H*",$buf));
|
||||
|
||||
$hash->{PARTIAL} = $buf;
|
||||
my $msg = decode_tpuart($telegram);
|
||||
@ -1076,13 +1083,13 @@ sub getGroup($)
|
||||
# {
|
||||
# # ACK
|
||||
# sendRequest($hash,pack('C',0x11));
|
||||
# Log(5,"Ack!");
|
||||
# Log (5,"Ack!");
|
||||
# }
|
||||
|
||||
return $msg;
|
||||
}
|
||||
|
||||
Log(2,"DevType $hash->{DevType} not supported for getGroup\n");
|
||||
Log (2,"DevType $hash->{DevType} not supported for getGroup\n");
|
||||
return undef;
|
||||
|
||||
error:
|
||||
@ -1102,16 +1109,16 @@ sub getRequest($)
|
||||
goto error unless sysread($hash->{TCPDev}, $data, 2);
|
||||
my $size = unpack ("n", $data);
|
||||
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;
|
||||
}
|
||||
elsif($hash->{USBDev}) {
|
||||
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;
|
||||
}
|
||||
|
||||
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;
|
||||
|
||||
error:
|
||||
@ -1125,7 +1132,7 @@ sub getRequest($)
|
||||
sub sendRequest($$)
|
||||
{
|
||||
my ($hash,$str) = @_;
|
||||
Log(5,"sendRequest: ". unpack("H*",$str). "\n");
|
||||
Log (5,"sendRequest: ". unpack("H*",$str). "\n");
|
||||
|
||||
if($hash->{TCPDev})
|
||||
{
|
||||
@ -1141,7 +1148,7 @@ sub sendRequest($$)
|
||||
}
|
||||
else
|
||||
{
|
||||
Log(2,"TUL $hash->{NAME}: No known physical protocoll defined.");
|
||||
Log (2,"TUL $hash->{NAME}: No known physical protocoll defined.");
|
||||
return undef;
|
||||
}
|
||||
return 1;
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user