From 0e1025056e9be3457dee0ae72c83ffac54a597c7 Mon Sep 17 00:00:00 2001 From: andi291 <> Date: Fri, 28 Apr 2017 08:04:26 +0000 Subject: [PATCH] 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 --- fhem/FHEM/00_TUL.pm | 93 ++++++++++++++++++++++++--------------------- 1 file changed, 50 insertions(+), 43 deletions(-) diff --git a/fhem/FHEM/00_TUL.pm b/fhem/FHEM/00_TUL.pm index a9259d5e8..db4bb50fb 100644 --- a/fhem/FHEM/00_TUL.pm +++ b/fhem/FHEM/00_TUL.pm @@ -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 TUL []"; - 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;