From e66a27cd426a65fec4136bbe4ed38366239a164a Mon Sep 17 00:00:00 2001 From: erwin Date: Thu, 26 Aug 2021 15:34:16 +0000 Subject: [PATCH] 10_KNX.pm: mayor rewrite of the Module, pls. check forum #122582 git-svn-id: https://svn.fhem.de/fhem/trunk@24873 2b470e98-0d58-463d-a4d8-8e2adae1ed80 --- fhem/CHANGED | 3 + fhem/FHEM/10_KNX.pm | 3387 +++++++++++++++++++++---------------------- 2 files changed, 1621 insertions(+), 1769 deletions(-) diff --git a/fhem/CHANGED b/fhem/CHANGED index b748f155f..178aff9ff 100644 --- a/fhem/CHANGED +++ b/fhem/CHANGED @@ -1,5 +1,8 @@ # Add changes at the top of the list. Keep it in ASCII, and 80-char wide. # Do not insert empty lines here, update check depends on it. + - change: 10_KNX: major rewrite of the module. pls. check forum + https://forum.fhem.de/index.php/topic,122582.0.html + before shutdown/restart! - feature: 11_OWDevice: new attribute disable (forum #122563) - change: 50_TelegramBot: parseMode for Photo & Video / FIX: 0_none logmode - feature: 19_Revolt: add standard attributes ignore, showtime etc. diff --git a/fhem/FHEM/10_KNX.pm b/fhem/FHEM/10_KNX.pm index 1cab85365..8f8364546 100644 --- a/fhem/FHEM/10_KNX.pm +++ b/fhem/FHEM/10_KNX.pm @@ -1,5 +1,5 @@ ############################################## -# $Id$ +# $Id$ # ABU 20180218 restructuring, removed older documentation # ABU 20180317 setExtensions reingebaut, set funktion # ABU 20180319 repaired "reply"-function @@ -30,74 +30,141 @@ # ABU 20180626 fixed last changes # ABU 20180706 changed eval, removed stateCopy # ABU 20180706 fixed doku: changed readonly in listenonly -# ABU 20180815 updated link in doku, changed (dpt16$) to dpt16 in set, tried to fix öast-sender (replaced bulk by single in decoding loop) +# ABU 20180815 updated link in doku, changed (dpt16$) to dpt16 in set, tried to fix last-sender (replaced bulk by single in decoding loop) # ABU 20180829 added dpt9.0020, tried workaround in putCmd, remove non printable chars # ABU 20180925 added dpt3.007, added last-sender "fhem" # ABU 20180926 fixed KNX_Eval in line 1291 (replaced hash by deviceHash), fixed decoding dpt3 # ABU 20181007 fixed dpt19 +# HAUSWART 20201112 implemented DPT20.102 #91462, KNX_parse set & get #115122, corrected dpt1 / dpt1.001 #112538 +# HAUSWART 20201113 fixed dpt19 #91650, KNX_hexToName2 +# MH 20201122 reworked most of dpt1, added dpt6.010, reworked dpt19, fixed (hopefully) putCmd, corrcetions to docu +# MH 20201202 dpt10 compatibility with widgetoverride :time, docu formatting +# MH 20201207 improve code (PerlBestPractices) changes marked with #PBP, added x-flag to most of regex, fixed dpt16 +# MH 20201210 add docu example for dpt16, fix docu indent. +# MH 20201223 add Evolution-version string, add dpt2.000 (JoeALLb), correction to "unknow argument..." +# new attr disable, simplify set-cmd logic, removed 'use SetExtensions', rework DbLogsplit logic +# MH 20210110 E04.20 rework / simplify set and define subs. No functional changes, i hope... +# PBP /perlcritic: now down to 12 Lines (from original 425) on package main Level 3, +# most of them 'cascading if-elsif chain' or 'high complexity score's. +# Still one severity 5, don't know how to fix that one. +# MH 20210210 E04.40 reworked dpt3 en- de-code, added disable also for KNX_parse, +# reworked set & parse -> new sub KNX_SetReading +# fix dpt16 empty string / full string length +# autocreate: new devices will be default disabled during autocreate! - see cmdref +# the Log msg "Unknown code xxxxx please help me" cannot be suppressed, would require a change in TUL/KNXTUL Module +# "set xxx (on|off)-until hh:mm" now works like "at xxx on-till-overnight hh:mm" +# fixed toggle (current value) +# additional PBP/perlcritic fixes +# fixed ugly bug when doing defmod or copy (defptr not cleared!) +# MH 20210211 E04.41 quick fix readingnames (gammatwin) +# MH 20210218 E04.42 cleanup, change dpts: 6,8,13 en-/de-code, fixed $PAT_DATE, +# readings: a write from bus updates always the "get" reading, indepedend of option set !!! +# add KNX_toggle Attr & docu +# MH 20210225 E04.43 fix autocreate- unknown code..., defptr +# cmdref: changed "", - $ON => "", - $ONFORTIMER => "", - $ONUNTIL => "", - $OFFFORTIMER => "", - $OFFUNTIL => "", - $TOGGLE => "", - $RAW => "", - $RGB => "colorpicker", - $STRING => "", - $VALUE => "" -); - -#identifier for TUL -my $id = 'C'; +my $TULid = 'C'; #identifier for TUL - extended adressing #regex patterns #pattern for group-adress -my $PAT_GAD = '^[0-9]{1,2}\/[0-9]{1,2}\/[0-9]{1,3}$'; +my $PAT_GAD = '(?:3[01]|([012])?[0-9])\/(?:1[0-5]|[0-9])\/(?:2[0-4][0-9]|25[0-5]|([01])?[0-9]{1,2})'; # 0-31/0-15/0-255 #pattern for group-adress in hex-format -#new syntax for extended adressing -my $PAT_GAD_HEX = '^[0-9a-f]{5}$'; -#old syntax -#my $PAT_GAD_HEX = qr/^[0-9a-f]{4}$/; +my $PAT_GAD_HEX = '[01][0-9a-f]{4}'; # max is 1FFFF -> 31/15/255 #pattern for group-no my $PAT_GNO = '[gG][1-9][0-9]?'; #pattern for GAD-Options -my $PAT_GAD_OPTIONS = '^\s*((get)|(set)|(listenonly))\s*$'; +my $PAT_GAD_OPTIONS = '(get|set|listenonly)'; #pattern for GAD-suffixes my $PAT_GAD_SUFFIX = 'nosuffix'; #pattern for forbidden GAD-Names -#my $PAT_GAD_NONAME = '((on)|(off)|(value)|(raw)|' . $PAT_GAD_OPTIONS . ')$'; +my $PAT_GAD_NONAME = '^(on|off|value|raw|' . $PAT_GAD_OPTIONS . q{|} . $PAT_GAD_SUFFIX . ')'; #pattern for DPT my $PAT_GAD_DPT = 'dpt\d*\.?\d*'; +#pattern for dpt1 (standard) +my $PAT_DPT1_PAT = '(on)|(off)|(0?1)|(0?0)'; +#pattern for date +my $PAT_DTSEP = qr/(?:_)/ix; # date/time separator +my $PAT_DATE = qr/(3[01]|[0-2]?[0-9])\.(1[0-2]|0?[0-9])\.((?:19|20)[0-9][0-9])/ix; +#pattern for time +my $PAT_TIME = qr/(2[0-4]|[0?1][0-9]):([0?1-5][0-9]):([0?1-5][0-9])/ix; +my $PAT_DPT16_CLR = qr/>CLR {CODE=>"dpt1", UNIT=>"", FACTOR=>undef, OFFSET=>undef, PATTERN=>qr/((on)|(off)|(0?1)|(0?0))$/i, MIN=>"off", MAX=>"on"}, - "dpt1.000" => {CODE=>"dpt1", UNIT=>"", FACTOR=>undef, OFFSET=>undef, PATTERN=>qr/((on)|(off)|(0?1)|(0?0))$/i, MIN=>"0", MAX=>"1"}, - "dpt1.001" => {CODE=>"dpt1", UNIT=>"", FACTOR=>undef, OFFSET=>undef, PATTERN=>qr/((on)|(off)|(0?1)|(0?0))$/i, MIN=>"off", MAX=>"on"}, - "dpt1.002" => {CODE=>"dpt1", UNIT=>"", FACTOR=>undef, OFFSET=>undef, PATTERN=>qr/((on)|(off)|(true)|(false)|(0?1)|(0?0))$/i, MIN=>"false", MAX=>"true"}, - "dpt1.003" => {CODE=>"dpt1", UNIT=>"", FACTOR=>undef, OFFSET=>undef, PATTERN=>qr/((on)|(off)|(enable)|(disable)|(0?1)|(0?0))$/i, MIN=>"disable", MAX=>"enable"}, - "dpt1.004" => {CODE=>"dpt1", UNIT=>"", FACTOR=>undef, OFFSET=>undef, PATTERN=>qr/((on)|(off)|(0?1)|(0?0))$/i, MIN=>"no ramp", MAX=>"ramp"}, - "dpt1.005" => {CODE=>"dpt1", UNIT=>"", FACTOR=>undef, OFFSET=>undef, PATTERN=>qr/((on)|(off)|(0?1)|(0?0))$/i, MIN=>"no alarm", MAX=>"alarm"}, - "dpt1.006" => {CODE=>"dpt1", UNIT=>"", FACTOR=>undef, OFFSET=>undef, PATTERN=>qr/((on)|(off)|(0?1)|(0?0))$/i, MIN=>"low", MAX=>"high"}, - "dpt1.007" => {CODE=>"dpt1", UNIT=>"", FACTOR=>undef, OFFSET=>undef, PATTERN=>qr/((on)|(off)|(0?1)|(0?0))$/i, MIN=>"decrease", MAX=>"increase"}, - "dpt1.008" => {CODE=>"dpt1", UNIT=>"", FACTOR=>undef, OFFSET=>undef, PATTERN=>qr/((on)|(off)|(up)|(down)|(0?1)|(0?0))$/i, MIN=>"up", MAX=>"down"}, - "dpt1.009" => {CODE=>"dpt1", UNIT=>"", FACTOR=>undef, OFFSET=>undef, PATTERN=>qr/((on)|(off)|(closed)|(open)|(0?1)|(0?0))$/i, MIN=>"open", MAX=>"closed"}, - "dpt1.010" => {CODE=>"dpt1", UNIT=>"", FACTOR=>undef, OFFSET=>undef, PATTERN=>qr/((on)|(off)|(start)|(stop)|(0?1)|(0?0))$/i, MIN=>"stop", MAX=>"start"}, - "dpt1.011" => {CODE=>"dpt1", UNIT=>"", FACTOR=>undef, OFFSET=>undef, PATTERN=>qr/((on)|(off)|(0?1)|(0?0))$/i, MIN=>"inactive", MAX=>"active"}, - "dpt1.012" => {CODE=>"dpt1", UNIT=>"", FACTOR=>undef, OFFSET=>undef, PATTERN=>qr/((on)|(off)|(0?1)|(0?0))$/i, MIN=>"not inverted", MAX=>"inverted"}, - "dpt1.013" => {CODE=>"dpt1", UNIT=>"", FACTOR=>undef, OFFSET=>undef, PATTERN=>qr/((on)|(off)|(0?1)|(0?0))$/i, MIN=>"start/stop", MAX=>"cyclically"}, - "dpt1.014" => {CODE=>"dpt1", UNIT=>"", FACTOR=>undef, OFFSET=>undef, PATTERN=>qr/((on)|(off)|(0?1)|(0?0))$/i, MIN=>"fixed", MAX=>"calculated"}, - "dpt1.015" => {CODE=>"dpt1", UNIT=>"", FACTOR=>undef, OFFSET=>undef, PATTERN=>qr/((on)|(off)|(0?1)|(0?0))$/i, MIN=>"no action", MAX=>"reset"}, - "dpt1.016" => {CODE=>"dpt1", UNIT=>"", FACTOR=>undef, OFFSET=>undef, PATTERN=>qr/((on)|(off)|(0?1)|(0?0))$/i, MIN=>"no action", MAX=>"acknowledge"}, - "dpt1.017" => {CODE=>"dpt1", UNIT=>"", FACTOR=>undef, OFFSET=>undef, PATTERN=>qr/((on)|(off)|(0?1)|(0?0))$/i, MIN=>"trigger", MAX=>"trigger"}, - "dpt1.018" => {CODE=>"dpt1", UNIT=>"", FACTOR=>undef, OFFSET=>undef, PATTERN=>qr/((on)|(off)|(0?1)|(0?0))$/i, MIN=>"not occupied", MAX=>"occupied"}, - "dpt1.019" => {CODE=>"dpt1", UNIT=>"", FACTOR=>undef, OFFSET=>undef, PATTERN=>qr/((on)|(off)|(closed)|(open)|(0?1)|(0?0))$/i, MIN=>"closed", MAX=>"open"}, - "dpt1.021" => {CODE=>"dpt1", UNIT=>"", FACTOR=>undef, OFFSET=>undef, PATTERN=>qr/((on)|(off)|(0?1)|(0?0))$/i, MIN=>"logical or", MAX=>"logical and"}, - "dpt1.022" => {CODE=>"dpt1", UNIT=>"", FACTOR=>undef, OFFSET=>undef, PATTERN=>qr/((on)|(off)|(0?1)|(0?0))$/i, MIN=>"scene A", MAX=>"scene B"}, - "dpt1.023" => {CODE=>"dpt1", UNIT=>"", FACTOR=>undef, OFFSET=>undef, PATTERN=>qr/((on)|(off)|(0?1)|(0?0))$/i, MIN=>"move up/down", MAX=>"move and step mode"}, + #Binary value + "dpt1" => {CODE=>"dpt1", UNIT=>q{}, FACTOR=>undef, OFFSET=>undef, PATTERN=>qr/($PAT_DPT1_PAT)/ix, MIN=>"off", MAX=>"on"}, + "dpt1.000" => {CODE=>"dpt1", UNIT=>q{}, FACTOR=>undef, OFFSET=>undef, PATTERN=>qr/($PAT_DPT1_PAT)/ix, MIN=>"0", MAX=>"1"}, + "dpt1.001" => {CODE=>"dpt1", UNIT=>q{}, FACTOR=>undef, OFFSET=>undef, PATTERN=>qr/($PAT_DPT1_PAT)/ix, MIN=>"off", MAX=>"on"}, + "dpt1.002" => {CODE=>"dpt1", UNIT=>q{}, FACTOR=>undef, OFFSET=>undef, PATTERN=>qr/($PAT_DPT1_PAT|(true)|(false))/ix, MIN=>"false", MAX=>"true"}, + "dpt1.003" => {CODE=>"dpt1", UNIT=>q{}, FACTOR=>undef, OFFSET=>undef, PATTERN=>qr/($PAT_DPT1_PAT|(enable)|(disable))/ix, MIN=>"disable", MAX=>"enable"}, + "dpt1.004" => {CODE=>"dpt1", UNIT=>q{}, FACTOR=>undef, OFFSET=>undef, PATTERN=>qr/($PAT_DPT1_PAT|(no_ramp)|(ramp))/ix, MIN=>"no_ramp", MAX=>"ramp"}, + "dpt1.005" => {CODE=>"dpt1", UNIT=>q{}, FACTOR=>undef, OFFSET=>undef, PATTERN=>qr/($PAT_DPT1_PAT|(no_alarm)|(alarm))/ix, MIN=>"no_alarm", MAX=>"alarm"}, + "dpt1.006" => {CODE=>"dpt1", UNIT=>q{}, FACTOR=>undef, OFFSET=>undef, PATTERN=>qr/($PAT_DPT1_PAT|(low)|(high))/ix, MIN=>"low", MAX=>"high"}, + "dpt1.007" => {CODE=>"dpt1", UNIT=>q{}, FACTOR=>undef, OFFSET=>undef, PATTERN=>qr/($PAT_DPT1_PAT|(decrease)|(increase))/ix, MIN=>"decrease", MAX=>"increase"}, + "dpt1.008" => {CODE=>"dpt1", UNIT=>q{}, FACTOR=>undef, OFFSET=>undef, PATTERN=>qr/($PAT_DPT1_PAT|(up)|(down))/ix, MIN=>"up", MAX=>"down"}, + "dpt1.009" => {CODE=>"dpt1", UNIT=>q{}, FACTOR=>undef, OFFSET=>undef, PATTERN=>qr/($PAT_DPT1_PAT|(closed)|(open))/ix, MIN=>"open", MAX=>"closed"}, + "dpt1.010" => {CODE=>"dpt1", UNIT=>q{}, FACTOR=>undef, OFFSET=>undef, PATTERN=>qr/($PAT_DPT1_PAT|(start)|(stop))/ix, MIN=>"stop", MAX=>"start"}, + "dpt1.011" => {CODE=>"dpt1", UNIT=>q{}, FACTOR=>undef, OFFSET=>undef, PATTERN=>qr/($PAT_DPT1_PAT|(inactive)|(active))/ix, MIN=>"inactive", MAX=>"active"}, + "dpt1.012" => {CODE=>"dpt1", UNIT=>q{}, FACTOR=>undef, OFFSET=>undef, PATTERN=>qr/($PAT_DPT1_PAT|(not_inverted)|(inverted))/ix, MIN=>"not_inverted", MAX=>"inverted"}, + "dpt1.013" => {CODE=>"dpt1", UNIT=>q{}, FACTOR=>undef, OFFSET=>undef, PATTERN=>qr/($PAT_DPT1_PAT|(start_stop)|(cyclically))/ix, MIN=>"start_stop", MAX=>"cyclically"}, + "dpt1.014" => {CODE=>"dpt1", UNIT=>q{}, FACTOR=>undef, OFFSET=>undef, PATTERN=>qr/($PAT_DPT1_PAT|(fixed)|(calculated))/ix, MIN=>"fixed", MAX=>"calculated"}, + "dpt1.015" => {CODE=>"dpt1", UNIT=>q{}, FACTOR=>undef, OFFSET=>undef, PATTERN=>qr/($PAT_DPT1_PAT|(no_action)|(reset))/ix, MIN=>"no_action", MAX=>"reset"}, + "dpt1.016" => {CODE=>"dpt1", UNIT=>q{}, FACTOR=>undef, OFFSET=>undef, PATTERN=>qr/($PAT_DPT1_PAT|(no_action)|(acknowledge))/ix, MIN=>"no_action", MAX=>"acknowledge"}, + "dpt1.017" => {CODE=>"dpt1", UNIT=>q{}, FACTOR=>undef, OFFSET=>undef, PATTERN=>qr/($PAT_DPT1_PAT|(trigger)|(trigger))/ix, MIN=>"trigger", MAX=>"trigger"}, + "dpt1.018" => {CODE=>"dpt1", UNIT=>q{}, FACTOR=>undef, OFFSET=>undef, PATTERN=>qr/($PAT_DPT1_PAT|(not_occupied)|(occupied))/ix, MIN=>"not_occupied", MAX=>"occupied"}, + "dpt1.019" => {CODE=>"dpt1", UNIT=>q{}, FACTOR=>undef, OFFSET=>undef, PATTERN=>qr/($PAT_DPT1_PAT|(closed)|(open))/ix, MIN=>"closed", MAX=>"open"}, + "dpt1.021" => {CODE=>"dpt1", UNIT=>q{}, FACTOR=>undef, OFFSET=>undef, PATTERN=>qr/($PAT_DPT1_PAT|(logical_or)|(logical_and))/ix, MIN=>"logical_or", MAX=>"logical_and"}, + "dpt1.022" => {CODE=>"dpt1", UNIT=>q{}, FACTOR=>undef, OFFSET=>undef, PATTERN=>qr/($PAT_DPT1_PAT|(scene_A)|(scene_B))/ix, MIN=>"scene_A", MAX=>"scene_B"}, + "dpt1.023" => {CODE=>"dpt1", UNIT=>q{}, FACTOR=>undef, OFFSET=>undef, PATTERN=>qr/($PAT_DPT1_PAT|(move_(up_down|and_step_mode)))/ix, MIN=>"move_up_down", MAX=>"move_and_step_mode"}, #Step value (two-bit) - "dpt2" => {CODE=>"dpt2", UNIT=>"", FACTOR=>undef, OFFSET=>undef, PATTERN=>qr/((on)|(off)|(forceon)|(forceoff))$/i, MIN=>undef, MAX=>undef, SETLIST=>"on,off,forceon,forceoff"}, - + "dpt2" => {CODE=>"dpt2", UNIT=>q{}, FACTOR=>undef, OFFSET=>undef, PATTERN=>qr/((on)|(off)|(forceon)|(forceoff))/ix, MIN=>undef, MAX=>undef, SETLIST=>"on,off,forceon,forceoff"}, + "dpt2.000" => {CODE=>"dpt2", UNIT=>q{}, FACTOR=>1, OFFSET=>0, PATTERN=>qr/(0?[0-3])/ix, MIN=>0, MAX=>3}, + #Step value (four-bit) - "dpt3" => {CODE=>"dpt3", UNIT=>"", FACTOR=>1, OFFSET=>0, PATTERN=>qr/[+-]?\d{1,3}/i, MIN=>-100, MAX=>100}, - "dpt3.007" => {CODE=>"dpt3", UNIT=>"%", FACTOR=>1, OFFSET=>0, PATTERN=>qr/[+-]?\d{1,3}/i, MIN=>-100, MAX=>100}, + "dpt3" => {CODE=>"dpt3", UNIT=>q{}, FACTOR=>1, OFFSET=>0, PATTERN=>qr/[+-]?\d{1,3}/ix, MIN=>-100, MAX=>100}, + "dpt3.007" => {CODE=>"dpt3", UNIT=>q{%}, FACTOR=>1, OFFSET=>0, PATTERN=>qr/[+-]?\d{1,3}/ix, MIN=>-100, MAX=>100}, # 1-Octet unsigned value - "dpt5" => {CODE=>"dpt5", UNIT=>"", FACTOR=>1, OFFSET=>0, PATTERN=>qr/[+-]?\d{1,3}/i, MIN=>0, MAX=>255}, - "dpt5.001" => {CODE=>"dpt5", UNIT=>"%", FACTOR=>100/255, OFFSET=>0, PATTERN=>qr/[+-]?\d{1,3}/i, MIN=>0, MAX=>100}, - "dpt5.003" => {CODE=>"dpt5", UNIT=>"°", FACTOR=>360/255, OFFSET=>0, PATTERN=>qr/[+-]?\d{1,3}/i, MIN=>0, MAX=>360}, - "dpt5.004" => {CODE=>"dpt5", UNIT=>"%", FACTOR=>1, OFFSET=>0, PATTERN=>qr/[+-]?\d{1,3}/i, MIN=>0, MAX=>255}, - + "dpt5" => {CODE=>"dpt5", UNIT=>q{}, FACTOR=>1, OFFSET=>0, PATTERN=>qr/[+-]?\d{1,3}/ix, MIN=>0, MAX=>255}, + "dpt5.001" => {CODE=>"dpt5", UNIT=>q{%}, FACTOR=>100/255, OFFSET=>0, PATTERN=>qr/[+-]?\d{1,3}/ix, MIN=>0, MAX=>100}, + "dpt5.003" => {CODE=>"dpt5", UNIT=>q{°}, FACTOR=>360/255, OFFSET=>0, PATTERN=>qr/[+-]?\d{1,3}/ix, MIN=>0, MAX=>360}, + "dpt5.004" => {CODE=>"dpt5", UNIT=>q{%}, FACTOR=>1, OFFSET=>0, PATTERN=>qr/[+-]?\d{1,3}/ix, MIN=>0, MAX=>255}, + # 1-Octet signed value - "dpt6" => {CODE=>"dpt6", UNIT=>"", FACTOR=>1, OFFSET=>0, PATTERN=>qr/[+-]?\d{1,3}/i, MIN=>-127, MAX=>127}, - "dpt6.001" => {CODE=>"dpt6", UNIT=>"%", FACTOR=>1, OFFSET=>0, PATTERN=>qr/[+-]?\d{1,3}/i, MIN=>0, MAX=>100}, + "dpt6" => {CODE=>"dpt6", UNIT=>q{}, FACTOR=>1, OFFSET=>0, PATTERN=>qr/[+-]?\d{1,3}/ix, MIN=>-127, MAX=>127}, + "dpt6.001" => {CODE=>"dpt6", UNIT=>q{%}, FACTOR=>1, OFFSET=>0, PATTERN=>qr/[+-]?\d{1,3}/ix, MIN=>0, MAX=>100}, + "dpt6.010" => {CODE=>"dpt6", UNIT=>q{}, FACTOR=>1, OFFSET=>0, PATTERN=>qr/[+-]?\d{1,3}/ix, MIN=>-127, MAX=>127}, # 2-Octet unsigned Value - "dpt7" => {CODE=>"dpt7", UNIT=>"", FACTOR=>1, OFFSET=>0, PATTERN=>qr/[+-]?\d{1,5}/i, MIN=>0, MAX=>65535}, - "dpt7.001" => {CODE=>"dpt7", UNIT=>"", FACTOR=>1, OFFSET=>0, PATTERN=>qr/[+-]?\d{1,5}/i, MIN=>0, MAX=>65535}, - "dpt7.005" => {CODE=>"dpt7", UNIT=>"s", FACTOR=>1, OFFSET=>0, PATTERN=>qr/[+-]?\d{1,5}/i, MIN=>0, MAX=>65535}, - "dpt7.006" => {CODE=>"dpt7", UNIT=>"m", FACTOR=>1, OFFSET=>0, PATTERN=>qr/[+-]?\d{1,5}/i, MIN=>0, MAX=>65535}, - "dpt7.007" => {CODE=>"dpt7", UNIT=>"h", FACTOR=>1, OFFSET=>0, PATTERN=>qr/[+-]?\d{1,5}/i, MIN=>0, MAX=>65535}, - "dpt7.012" => {CODE=>"dpt7", UNIT=>"mA", FACTOR=>1, OFFSET=>0, PATTERN=>qr/[+-]?\d{1,5}/i, MIN=>0, MAX=>65535}, - "dpt7.013" => {CODE=>"dpt7", UNIT=>"lux", FACTOR=>1, OFFSET=>0, PATTERN=>qr/[+-]?\d{1,5}/i, MIN=>0, MAX=>65535}, + "dpt7" => {CODE=>"dpt7", UNIT=>q{}, FACTOR=>1, OFFSET=>0, PATTERN=>qr/[+-]?\d{1,5}/ix, MIN=>0, MAX=>65535}, + "dpt7.001" => {CODE=>"dpt7", UNIT=>q{}, FACTOR=>1, OFFSET=>0, PATTERN=>qr/[+-]?\d{1,5}/ix, MIN=>0, MAX=>65535}, + "dpt7.005" => {CODE=>"dpt7", UNIT=>q{s}, FACTOR=>1, OFFSET=>0, PATTERN=>qr/[+-]?\d{1,5}/ix, MIN=>0, MAX=>65535}, + "dpt7.006" => {CODE=>"dpt7", UNIT=>q{m}, FACTOR=>1, OFFSET=>0, PATTERN=>qr/[+-]?\d{1,5}/ix, MIN=>0, MAX=>65535}, + "dpt7.007" => {CODE=>"dpt7", UNIT=>q{h}, FACTOR=>1, OFFSET=>0, PATTERN=>qr/[+-]?\d{1,5}/ix, MIN=>0, MAX=>65535}, + "dpt7.012" => {CODE=>"dpt7", UNIT=>q{mA}, FACTOR=>1, OFFSET=>0, PATTERN=>qr/[+-]?\d{1,5}/ix, MIN=>0, MAX=>65535}, + "dpt7.013" => {CODE=>"dpt7", UNIT=>q{lux}, FACTOR=>1, OFFSET=>0, PATTERN=>qr/[+-]?\d{1,5}/ix, MIN=>0, MAX=>65535}, + "dpt7.600" => {CODE=>"dpt7", UNIT=>q{K}, FACTOR=>1, OFFSET=>0, PATTERN=>qr/[+]?\d{1,5}/ix, MIN=>0, MAX=>12000}, # 04.66 Farbtemperatur # 2-Octet signed Value - "dpt8" => {CODE=>"dpt8", UNIT=>"", FACTOR=>1, OFFSET=>0, PATTERN=>qr/[+-]?\d{1,5}/i, MIN=>-32768, MAX=>32768}, - "dpt8.005" => {CODE=>"dpt8", UNIT=>"s", FACTOR=>1, OFFSET=>0, PATTERN=>qr/[+-]?\d{1,5}/i, MIN=>-32768, MAX=>32768}, - "dpt8.010" => {CODE=>"dpt8", UNIT=>"%", FACTOR=>0.01, OFFSET=>0, PATTERN=>qr/[+-]?\d{1,5}/i, MIN=>-32768, MAX=>32768}, - "dpt8.011" => {CODE=>"dpt8", UNIT=>"°", FACTOR=>1, OFFSET=>0, PATTERN=>qr/[+-]?\d{1,5}/i, MIN=>-32768, MAX=>32768}, + "dpt8" => {CODE=>"dpt8", UNIT=>q{}, FACTOR=>1, OFFSET=>0, PATTERN=>qr/[+-]?\d{1,5}/ix, MIN=>-32768, MAX=>32767}, + "dpt8.005" => {CODE=>"dpt8", UNIT=>q{s}, FACTOR=>1, OFFSET=>0, PATTERN=>qr/[+-]?\d{1,5}/ix, MIN=>-32768, MAX=>32767}, + "dpt8.010" => {CODE=>"dpt8", UNIT=>q{%}, FACTOR=>0.01, OFFSET=>0, PATTERN=>qr/[+-]?\d{1,5}/ix, MIN=>-327.68, MAX=>327.67}, #04.66 min/max + "dpt8.011" => {CODE=>"dpt8", UNIT=>q{°}, FACTOR=>1, OFFSET=>0, PATTERN=>qr/[+-]?\d{1,5}/ix, MIN=>-32768, MAX=>32767}, # 2-Octet Float value - "dpt9" => {CODE=>"dpt9", UNIT=>"", FACTOR=>1, OFFSET=>0, PATTERN=>qr/[-+]?(?:\d*[\.\,])?\d+/i, MIN=>-670760, MAX=>670760}, - "dpt9.001" => {CODE=>"dpt9", UNIT=>"°C", FACTOR=>1, OFFSET=>0, PATTERN=>qr/[-+]?(?:\d*[\.\,])?\d+/i, MIN=>-670760, MAX=>670760}, - "dpt9.004" => {CODE=>"dpt9", UNIT=>"lux", FACTOR=>1, OFFSET=>0, PATTERN=>qr/[-+]?(?:\d*[\.\,])?\d+/i, MIN=>-670760, MAX=>670760}, - "dpt9.006" => {CODE=>"dpt9", UNIT=>"Pa", FACTOR=>1, OFFSET=>0, PATTERN=>qr/[-+]?(?:\d*[\.\,])?\d+/i, MIN=>-670760, MAX=>670760}, - "dpt9.005" => {CODE=>"dpt9", UNIT=>"m/s", FACTOR=>1, OFFSET=>0, PATTERN=>qr/[-+]?(?:\d*[\.\,])?\d+/i, MIN=>-670760, MAX=>670760}, - "dpt9.007" => {CODE=>"dpt9", UNIT=>"%", FACTOR=>1, OFFSET=>0, PATTERN=>qr/[-+]?(?:\d*[\.\,])?\d+/i, MIN=>-670760, MAX=>670760}, - "dpt9.008" => {CODE=>"dpt9", UNIT=>"ppm", FACTOR=>1, OFFSET=>0, PATTERN=>qr/[-+]?(?:\d*[\.\,])?\d+/i, MIN=>-670760, MAX=>670760}, - "dpt9.009" => {CODE=>"dpt9", UNIT=>"m³/h", FACTOR=>1, OFFSET=>0, PATTERN=>qr/[-+]?(?:\d*[\.\,])?\d+/i, MIN=>-670760, MAX=>670760}, - "dpt9.010" => {CODE=>"dpt9", UNIT=>"s", FACTOR=>1, OFFSET=>0, PATTERN=>qr/[-+]?(?:\d*[\.\,])?\d+/i, MIN=>-670760, MAX=>670760}, - "dpt9.020" => {CODE=>"dpt9", UNIT=>"mV", FACTOR=>1, OFFSET=>0, PATTERN=>qr/[-+]?(?:\d*[\.\,])?\d+/i, MIN=>-670760, MAX=>670760}, - "dpt9.021" => {CODE=>"dpt9", UNIT=>"mA", FACTOR=>1, OFFSET=>0, PATTERN=>qr/[-+]?(?:\d*[\.\,])?\d+/i, MIN=>-670760, MAX=>670760}, - "dpt9.024" => {CODE=>"dpt9", UNIT=>"kW", FACTOR=>1, OFFSET=>0, PATTERN=>qr/[-+]?(?:\d*[\.\,])?\d+/i, MIN=>-670760, MAX=>670760}, - "dpt9.025" => {CODE=>"dpt9", UNIT=>"l/h", FACTOR=>1, OFFSET=>0, PATTERN=>qr/[-+]?(?:\d*[\.\,])?\d+/i, MIN=>-670760, MAX=>670760}, - "dpt9.026" => {CODE=>"dpt9", UNIT=>"l/h", FACTOR=>1, OFFSET=>0, PATTERN=>qr/[-+]?(?:\d*[\.\,])?\d+/i, MIN=>-670760, MAX=>670760}, - "dpt9.028" => {CODE=>"dpt9", UNIT=>"km/h", FACTOR=>1, OFFSET=>0, PATTERN=>qr/[-+]?(?:\d*[\.\,])?\d+/i, MIN=>-670760, MAX=>670760}, - + "dpt9" => {CODE=>"dpt9", UNIT=>q{}, FACTOR=>1, OFFSET=>0, PATTERN=>qr/[-+]?(?:\d*[\.\,])?\d+/ix, MIN=>-670760, MAX=>670760}, + "dpt9.001" => {CODE=>"dpt9", UNIT=>q{°C}, FACTOR=>1, OFFSET=>0, PATTERN=>qr/[-+]?(?:\d*[\.\,])?\d+/ix, MIN=>-274, MAX=>670760}, + "dpt9.002" => {CODE=>"dpt9", UNIT=>q{K}, FACTOR=>1, OFFSET=>0, PATTERN=>qr/[-+]?(?:\d*[\.\,])?\d+/ix, MIN=>-670760, MAX=>670760}, + "dpt9.003" => {CODE=>"dpt9", UNIT=>q{K/h}, FACTOR=>1, OFFSET=>0, PATTERN=>qr/[-+]?(?:\d*[\.\,])?\d+/ix, MIN=>-670760, MAX=>670760}, + "dpt9.004" => {CODE=>"dpt9", UNIT=>q{lux}, FACTOR=>1, OFFSET=>0, PATTERN=>qr/[-+]?(?:\d*[\.\,])?\d+/ix, MIN=>-670760, MAX=>670760}, + "dpt9.005" => {CODE=>"dpt9", UNIT=>q{m/s}, FACTOR=>1, OFFSET=>0, PATTERN=>qr/[-+]?(?:\d*[\.\,])?\d+/ix, MIN=>-670760, MAX=>670760}, + "dpt9.006" => {CODE=>"dpt9", UNIT=>q{Pa}, FACTOR=>1, OFFSET=>0, PATTERN=>qr/[-+]?(?:\d*[\.\,])?\d+/ix, MIN=>-670760, MAX=>670760}, + "dpt9.007" => {CODE=>"dpt9", UNIT=>q{%}, FACTOR=>1, OFFSET=>0, PATTERN=>qr/[-+]?(?:\d*[\.\,])?\d+/ix, MIN=>-670760, MAX=>670760}, + "dpt9.008" => {CODE=>"dpt9", UNIT=>q{ppm}, FACTOR=>1, OFFSET=>0, PATTERN=>qr/[-+]?(?:\d*[\.\,])?\d+/ix, MIN=>-670760, MAX=>670760}, + "dpt9.009" => {CODE=>"dpt9", UNIT=>q{m³/h}, FACTOR=>1, OFFSET=>0, PATTERN=>qr/[-+]?(?:\d*[\.\,])?\d+/ix, MIN=>-670760, MAX=>670760}, + "dpt9.010" => {CODE=>"dpt9", UNIT=>q{s}, FACTOR=>1, OFFSET=>0, PATTERN=>qr/[-+]?(?:\d*[\.\,])?\d+/ix, MIN=>-670760, MAX=>670760}, + "dpt9.011" => {CODE=>"dpt9", UNIT=>q{ms}, FACTOR=>1, OFFSET=>0, PATTERN=>qr/[-+]?(?:\d*[\.\,])?\d+/ix, MIN=>-670760, MAX=>670760}, + "dpt9.020" => {CODE=>"dpt9", UNIT=>q{mV}, FACTOR=>1, OFFSET=>0, PATTERN=>qr/[-+]?(?:\d*[\.\,])?\d+/ix, MIN=>-670760, MAX=>670760}, + "dpt9.021" => {CODE=>"dpt9", UNIT=>q{mA}, FACTOR=>1, OFFSET=>0, PATTERN=>qr/[-+]?(?:\d*[\.\,])?\d+/ix, MIN=>-670760, MAX=>670760}, + "dpt9.022" => {CODE=>"dpt9", UNIT=>q{W/m²}, FACTOR=>1, OFFSET=>0, PATTERN=>qr/[-+]?(?:\d*[\.\,])?\d+/ix, MIN=>-670760, MAX=>670760}, + "dpt9.023" => {CODE=>"dpt9", UNIT=>q{K/%}, FACTOR=>1, OFFSET=>0, PATTERN=>qr/[-+]?(?:\d*[\.\,])?\d+/ix, MIN=>-670760, MAX=>670760}, + "dpt9.024" => {CODE=>"dpt9", UNIT=>q{kW}, FACTOR=>1, OFFSET=>0, PATTERN=>qr/[-+]?(?:\d*[\.\,])?\d+/ix, MIN=>-670760, MAX=>670760}, + "dpt9.025" => {CODE=>"dpt9", UNIT=>q{l/h}, FACTOR=>1, OFFSET=>0, PATTERN=>qr/[-+]?(?:\d*[\.\,])?\d+/ix, MIN=>-670760, MAX=>670760}, + "dpt9.026" => {CODE=>"dpt9", UNIT=>q{l/h}, FACTOR=>1, OFFSET=>0, PATTERN=>qr/[-+]?(?:\d*[\.\,])?\d+/ix, MIN=>-670760, MAX=>670760}, + "dpt9.028" => {CODE=>"dpt9", UNIT=>q{km/h}, FACTOR=>1, OFFSET=>0, PATTERN=>qr/[-+]?(?:\d*[\.\,])?\d+/ix, MIN=>-670760, MAX=>670760}, + "dpt9.029" => {CODE=>"dpt9", UNIT=>q{g/m³}, FACTOR=>1, OFFSET=>0, PATTERN=>qr/[-+]?(?:\d*[\.\,])?\d+/ix, MIN=>-670760, MAX=>670760}, #04.66 Abs. Luftfeuchte + "dpt9.030" => {CODE=>"dpt9", UNIT=>q{μg/m³}, FACTOR=>1, OFFSET=>0, PATTERN=>qr/[-+]?(?:\d*[\.\,])?\d+/ix, MIN=>-670760, MAX=>670760}, #04.66 Dichte + # Time of Day - "dpt10" => {CODE=>"dpt10", UNIT=>"", FACTOR=>undef, OFFSET=>undef, PATTERN=>qr/((2[0-4]|[0?1][0-9]):(60|[0?1-5]?[0-9]):(60|[0?1-5]?[0-9]))|(now)/i, MIN=>undef, MAX=>undef}, - + "dpt10" => {CODE=>"dpt10", UNIT=>q{}, FACTOR=>undef, OFFSET=>undef, PATTERN=>qr/($PAT_TIME|now)/ix, MIN=>undef, MAX=>undef}, + # Date - "dpt11" => {CODE=>"dpt11", UNIT=>"", FACTOR=>undef, OFFSET=>undef, PATTERN=>qr/((3[01]|[0-2]?[0-9]).(1[0-2]|0?[0-9]).(19[0-9][0-9]|2[01][0-9][0-9]))|(now)/i, MIN=>undef, MAX=>undef}, - + "dpt11" => {CODE=>"dpt11", UNIT=>q{}, FACTOR=>undef, OFFSET=>undef, PATTERN=>qr/($PAT_DATE|now)/ix, MIN=>undef, MAX=>undef}, + # 4-Octet unsigned value (handled as dpt7) - "dpt12" => {CODE=>"dpt12", UNIT=>"", FACTOR=>1, OFFSET=>0, PATTERN=>qr/[+-]?\d{1,10}/i, MIN=>0, MAX=>4294967295}, - + "dpt12" => {CODE=>"dpt12", UNIT=>q{}, FACTOR=>1, OFFSET=>0, PATTERN=>qr/[+-]?\d{1,10}/ix, MIN=>0, MAX=>4294967295}, + # 4-Octet Signed Value - "dpt13" => {CODE=>"dpt13", UNIT=>"", FACTOR=>1, OFFSET=>0, PATTERN=>qr/[+-]?\d{1,10}/i, MIN=>-2147483647, MAX=>2147483647}, - "dpt13.010" => {CODE=>"dpt13", UNIT=>"Wh", FACTOR=>1, OFFSET=>0, PATTERN=>qr/[+-]?\d{1,10}/i, MIN=>-2147483647, MAX=>2147483647}, - "dpt13.013" => {CODE=>"dpt13", UNIT=>"kWh", FACTOR=>1, OFFSET=>0, PATTERN=>qr/[+-]?\d{1,10}/i, MIN=>-2147483647, MAX=>2147483647}, + "dpt13" => {CODE=>"dpt13", UNIT=>q{}, FACTOR=>1, OFFSET=>0, PATTERN=>qr/[+-]?\d{1,10}/ix, MIN=>-2147483648, MAX=>2147483647}, + "dpt13.010" => {CODE=>"dpt13", UNIT=>q{Wh}, FACTOR=>1, OFFSET=>0, PATTERN=>qr/[+-]?\d{1,10}/ix, MIN=>-2147483648, MAX=>2147483647}, + "dpt13.013" => {CODE=>"dpt13", UNIT=>q{kWh}, FACTOR=>1, OFFSET=>0, PATTERN=>qr/[+-]?\d{1,10}/ix, MIN=>-2147483648, MAX=>2147483647}, # 4-Octet single precision float - "dpt14" => {CODE=>"dpt14", UNIT=>"", FACTOR=>1, OFFSET=>0, PATTERN=>qr/[+-]?\d{1,40}[.,]?\d{1,4}/i, MIN=>undef, MAX=>undef}, - "dpt14.019" => {CODE=>"dpt14", UNIT=>"A", FACTOR=>1, OFFSET=>0, PATTERN=>qr/[+-]?\d{1,40}[.,]?\d{1,4}/i, MIN=>undef, MAX=>undef}, - "dpt14.027" => {CODE=>"dpt14", UNIT=>"V", FACTOR=>1, OFFSET=>0, PATTERN=>qr/[+-]?\d{1,40}[.,]?\d{1,4}/i, MIN=>undef, MAX=>undef}, - "dpt14.033" => {CODE=>"dpt14", UNIT=>"Hz", FACTOR=>1, OFFSET=>0, PATTERN=>qr/[+-]?\d{1,40}[.,]?\d{1,4}/i, MIN=>undef, MAX=>undef}, - "dpt14.056" => {CODE=>"dpt14", UNIT=>"W", FACTOR=>1, OFFSET=>0, PATTERN=>qr/[+-]?\d{1,40}[.,]?\d{1,4}/i, MIN=>undef, MAX=>undef}, - "dpt14.068" => {CODE=>"dpt14", UNIT=>"°C", FACTOR=>1, OFFSET=>0, PATTERN=>qr/[+-]?\d{1,40}[.,]?\d{1,4}/i, MIN=>undef, MAX=>undef}, - "dpt14.076" => {CODE=>"dpt14", UNIT=>"m³", FACTOR=>1, OFFSET=>0, PATTERN=>qr/[+-]?\d{1,40}[.,]?\d{1,4}/i, MIN=>undef, MAX=>undef}, - "dpt14.057" => {CODE=>"dpt14", UNIT=>"cos Φ", FACTOR=>1, OFFSET=>0, PATTERN=>qr/[+-]?\d{1,40}[.,]?\d{1,4}/i, MIN=>undef, MAX=>undef}, - + "dpt14" => {CODE=>"dpt14", UNIT=>q{}, FACTOR=>1, OFFSET=>0, PATTERN=>qr/[+-]?\d{1,40}[.,]?\d{1,4}/ix, MIN=>undef, MAX=>undef}, + "dpt14.019" => {CODE=>"dpt14", UNIT=>q{A}, FACTOR=>1, OFFSET=>0, PATTERN=>qr/[+-]?\d{1,40}[.,]?\d{1,4}/ix, MIN=>undef, MAX=>undef}, + "dpt14.027" => {CODE=>"dpt14", UNIT=>q{V}, FACTOR=>1, OFFSET=>0, PATTERN=>qr/[+-]?\d{1,40}[.,]?\d{1,4}/ix, MIN=>undef, MAX=>undef}, + "dpt14.033" => {CODE=>"dpt14", UNIT=>q{Hz}, FACTOR=>1, OFFSET=>0, PATTERN=>qr/[+-]?\d{1,40}[.,]?\d{1,4}/ix, MIN=>undef, MAX=>undef}, + "dpt14.056" => {CODE=>"dpt14", UNIT=>q{W}, FACTOR=>1, OFFSET=>0, PATTERN=>qr/[+-]?\d{1,40}[.,]?\d{1,4}/ix, MIN=>undef, MAX=>undef}, + "dpt14.068" => {CODE=>"dpt14", UNIT=>q{°C}, FACTOR=>1, OFFSET=>0, PATTERN=>qr/[+-]?\d{1,40}[.,]?\d{1,4}/ix, MIN=>undef, MAX=>undef}, + "dpt14.076" => {CODE=>"dpt14", UNIT=>q{m³}, FACTOR=>1, OFFSET=>0, PATTERN=>qr/[+-]?\d{1,40}[.,]?\d{1,4}/ix, MIN=>undef, MAX=>undef}, + "dpt14.057" => {CODE=>"dpt14", UNIT=>q{cos Φ}, FACTOR=>1, OFFSET=>0, PATTERN=>qr/[+-]?\d{1,40}[.,]?\d{1,4}/ix, MIN=>undef, MAX=>undef}, + # 14-Octet String - "dpt16" => {CODE=>"dpt16", UNIT=>"", FACTOR=>undef, OFFSET=>undef, PATTERN=>qr/.{1,14}/i, MIN=>undef, MAX=>undef}, - "dpt16.000" => {CODE=>"dpt16", UNIT=>"", FACTOR=>undef, OFFSET=>undef, PATTERN=>qr/.{1,14}/i, MIN=>undef, MAX=>undef}, - "dpt16.001" => {CODE=>"dpt16", UNIT=>"", FACTOR=>undef, OFFSET=>undef, PATTERN=>qr/.{1,14}/i, MIN=>undef, MAX=>undef}, + "dpt16" => {CODE=>"dpt16", UNIT=>q{}, FACTOR=>undef, OFFSET=>undef, PATTERN=>qr/.{1,14}/ix, MIN=>undef, MAX=>undef, SETLIST=>"multiple,>CLR<"}, + "dpt16.000" => {CODE=>"dpt16", UNIT=>q{}, FACTOR=>undef, OFFSET=>undef, PATTERN=>qr/.{1,14}/ix, MIN=>undef, MAX=>undef, SETLIST=>"multiple,>CLR<"}, + "dpt16.001" => {CODE=>"dpt16", UNIT=>q{}, FACTOR=>undef, OFFSET=>undef, PATTERN=>qr/.{1,14}/ix, MIN=>undef, MAX=>undef, SETLIST=>"multiple,>CLR<"}, # Scene, 0-63 - "dpt17.001" => {CODE=>"dpt5", UNIT=>"", FACTOR=>1, OFFSET=>0, PATTERN=>qr/[+-]?\d{1,3}/i, MIN=>0, MAX=>63}, + "dpt17.001" => {CODE=>"dpt5", UNIT=>q{}, FACTOR=>1, OFFSET=>0, PATTERN=>qr/[+-]?\d{1,3}/ix, MIN=>0, MAX=>63}, # Scene, 1-64 - "dpt18.001" => {CODE=>"dpt5", UNIT=>"", FACTOR=>1, OFFSET=>1, PATTERN=>qr/[+-]?\d{1,3}/i, MIN=>1, MAX=>64}, + "dpt18.001" => {CODE=>"dpt5", UNIT=>q{}, FACTOR=>1, OFFSET=>1, PATTERN=>qr/[+-]?\d{1,3}/ix, MIN=>1, MAX=>64}, #date and time - "dpt19" => {CODE=>"dpt19", UNIT=>"", FACTOR=>undef, OFFSET=>undef, PATTERN=>qr/(((3[01]|[0-2]?[0-9]).(1[0-2]|0?[0-9]).(19[0-9][0-9]|2[01][0-9][0-9]))_((2[0-4]|[0?1][0-9]):(60|[0?1-5]?[0-9]):(60|[0?1-5]?[0-9])))|(now)/i, MIN=>undef, MAX=>undef}, + "dpt19" => {CODE=>"dpt19", UNIT=>q{}, FACTOR=>undef, OFFSET=>undef, PATTERN=>qr/($PAT_DATE$PAT_DTSEP$PAT_TIME|now)/ix, MIN=>undef, MAX=>undef}, + "dpt19.001" => {CODE=>"dpt19", UNIT=>q{}, FACTOR=>undef, OFFSET=>undef, PATTERN=>qr/($PAT_DATE$PAT_DTSEP$PAT_TIME|now)/ix, MIN=>undef, MAX=>undef}, + + # HVAC mode, 1Byte + "dpt20.102" => {CODE=>"dpt20", UNIT=>q{}, FACTOR=>1, OFFSET=>0, PATTERN=>qr/((auto)|(comfort)|(standby)|(economy|night)|(protection|frost|heat))/ix, MIN=>undef, MAX=>undef, SETLIST=>"Auto,Comfort,Standby,Economy,Protection"}, ## no critic (RegularExpressions::ProhibitComplexRegexes) # Color-Code - "dpt232" => {CODE=>"dpt232", UNIT=>"", FACTOR=>undef, OFFSET=>undef, PATTERN=>qr/[0-9a-f]{6}/i, MIN=>undef, MAX=>undef, SETLIST=>"colorpicker"} + "dpt232" => {CODE=>"dpt232", UNIT=>q{}, FACTOR=>undef, OFFSET=>undef, PATTERN=>qr/[0-9a-f]{6}/ix, MIN=>undef, MAX=>undef, SETLIST=>"colorpicker"} ); #Init this device #This declares the interface to fhem ############################# -sub -KNX_Initialize($) { - my ($hash) = @_; +#04.65 sub KNX_Initialize { +sub Initialize { + my $hash = shift // return; - $hash->{Match} = "^$id.*"; - $hash->{GetFn} = "KNX_Get"; - $hash->{SetFn} = "KNX_Set"; - $hash->{StateFn} = "KNX_State"; - $hash->{DefFn} = "KNX_Define"; - $hash->{UndefFn} = "KNX_Undef"; - $hash->{ParseFn} = "KNX_Parse"; - $hash->{AttrFn} = "KNX_Attr"; - $hash->{NotifyFn} = "KNX_Notify"; - $hash->{DbLog_splitFn} = "KNX_DbLog_split"; - $hash->{AttrList} = "IODev " . #tells the module the IO-Device to communicate with. Optionally set within definition. - "do_not_notify:1,0 " . #supress any notification (including log) - "showtime:1,0 " . #shows time instead of received value in state - "answerReading:1,0 " . #allows FHEM to answer a read telegram - "stateRegex:textField-long " .#modifies state value - "stateCmd:textField-long " . #modify state value - "putCmd:textField-long " . #called when the KNX bus asks for a -put reading - "format " . #supplies post-string - "listenonly:1,0 " . #DEPRECATED - "readonly:1,0 " . #DEPRECATED - "slider " . #DEPRECATED - "useSetExtensions:1,0 " . #DEPRECATED - "$readingFnAttributes "; #standard attributes + $hash->{Match} = "^$TULid.*"; + $hash->{DefFn} = \&KNX_Define; + $hash->{UndefFn} = \&KNX_Undef; + $hash->{SetFn} = \&KNX_Set; + $hash->{GetFn} = \&KNX_Get; + $hash->{StateFn} = \&KNX_State; + $hash->{ParseFn} = \&KNX_Parse; + $hash->{NotifyFn} = \&KNX_Notify; + $hash->{AttrFn} = \&KNX_Attr; + $hash->{DbLog_splitFn} = \&KNX_DbLog_split; +#04.66 $hash->{FingerprintFn} = \&KNX_FingerPrint; + + $hash->{AttrList} = "IODev " . #tells the module the IO-Device to communicate with. Optionally set within definition. + "disable:1 " . #device disabled + "showtime:1,0 " . #shows time instead of received value in state + "answerReading:1,0 " . #allows FHEM to answer a read telegram + "stateRegex:textField-long " . #modifies state value + "stateCmd:textField-long " . #modify state value + "putCmd:textField-long " . #called when the KNX bus asks for a -put reading + "format " . #supplies post-string + "KNX_toggle:textField " . #toggle source : + "listenonly:1,0 " . #DEPRECATED + "readonly:1,0 " . #DEPRECATED + "slider " . #DEPRECATED + "$readingFnAttributes "; #standard attributes + $hash->{noAutocreatedFilelog} = 1; # autocreate devices create no FileLog + $hash->{AutoCreate} = {"KNX_.*" => { ATTR => "disable:1"} }; # autocreate devices are disabled by default + return $UNDEF; } #Define this device #Is called at every define ############################# -sub -KNX_Define($$) { - my ($hash, $def) = @_; +sub KNX_Define { + my $hash = shift // return; + my $def = shift; #enable newline within define with \ - $def =~ s/\n/ /g; - my @a = split("[ \t][ \t]*", $def); + my @a = split(/[ \t\n]+/x, $def); #device name my $name = $a[0]; - - #set verbose to 5, if debug enabled - $attr{$name}{verbose} = 5 if ($debug eq 1); - my $tempStr = join (", ", @a); - Log3 ($name, 5, "define $name: enter $hash, attributes: $tempStr"); + $hash->{NAME} = $name; + $hash->{FVERSIONE} = $Eversion; ###MH Evolution version + $hash->{NOTIFYDEV} = "global,$name"; # limit notifies + + Log3 ($name, 5, "KNX_define -enter: $name, attributes: " . join (", ", @a)); #too less arguments - return "wrong syntax - define KNX [*] []" if (int(@a) < 3); - - #check for IODev - #is last argument not a group or a group:model pair? Then assign for IODev. - my $lastGroupDef = int(@a); - #if (($a[int(@a) - 1] !~ m/^[0-9]{1,2}\/[0-9]{1,2}\/[0-9]{1,3}$/i) and ($a[int(@a) - 1] !~ m/^[0-9a-f]{4}$/i) and ($a[int(@a) - 1] !~ m/[0-9a-fA-F]:[dD][pP][tT]/i)) - if (($a[int(@a) - 1] !~ m/${PAT_GAD}/i) and ($a[int(@a) - 1] !~ m/${PAT_GAD_HEX}/i) and ($a[int(@a) - 1] !~ m/[0-9a-fA-F]:[dpt]/i)) - { - $attr{$name}{IODev} = $a[int(@a) - 1]; - $lastGroupDef--; + return 'KNX_define: $name -wrong syntax "define KNX [*] []" ' if (int(@a) < 3); + + # check if the last arg matches any IO-Device - and assign it - else use the automatic mechanism + my @tulList = devspec2array('TYPE=(TUL|KNXTUL|KNXIO)',$hash); + foreach my $tuls (@tulList) { + if ($tuls eq $a[int(@a) - 1]) { + $attr{$name}{IODev} = pop(@a); + last; + } } - + AssignIoPort($hash); # AssignIoPort will take device from $attr{$name}{IODev} if defined + #reset - my $firstrun = 1; $hash->{GADDETAILS} = {}; $hash->{GADTABLE} = {}; + + #delete all defptr entries for this device (defmod & copy problem) bug is still in SVN version! 09-02-2021 + KNX_delete_defptr($hash) if ($init_done); # verify with: {PrintHash($modules{KNX}{defptr},3) } on FHEM-cmdline #create groups and models, iterate through all possible args - for (my $i = 2; $i < $lastGroupDef; $i++) - { - #backup actual GAD - my $gadDef = $a[$i]; - my ($gad, $gadModel, $gadArg3, $gadArg4, $gadArg5) = split /:/, $gadDef; + foreach my $i (2 .. $#a) { my $gadCode = undef; - my $gadName = undef; my $gadOption = undef; - my $gadNoSuffix = undef; - my $rdNameGet = undef; - my $rdNameSet = undef; - my $rdNamePut = undef; + my $gadNoSuffix = undef; - Log3 ($name, 5, "define $name: argCtr $i, string: $a[$i]"); + Log3 ($name, 5, "KNX_define: $name, argCtr $i, string: $a[$i]"); #G-nr my $gadNo = $i - 1; - - #GAD not defined - return "GAD not defined for group-number $gadNo" if (!defined($gad)); - - #GAD wrong syntax - #either 1/2/3 or 1203 - return "wrong group name format in group-number $gadNo: specify as 0-15/0-15/0-255 or as hex" if (($gad !~ m/${PAT_GAD}/i) and ($gad !~ m/${PAT_GAD_HEX}/i)); - - #check if model supplied - return "no model defined for group-number $gadNo" if (!defined($gadModel)); - - if (defined ($gadArg3) and defined ($gadArg4) and defined ($gadArg5)) - { - Log3 ($name, 5, "define $name: found GAD: $gad, MODEL: $gadModel, Arg3: $gadArg3, Arg4: $gadArg4, Arg5: $gadArg5") - } - elsif (defined ($gadArg3) and defined ($gadArg4)) - { - Log3 ($name, 5, "define $name: found GAD: $gad, MODEL: $gadModel, Arg3: $gadArg3, Arg4: $gadArg4"); - } - elsif (defined ($gadArg3)) - { - Log3 ($name, 5, "define $name: found GAD: $gad, MODEL: $gadModel, Arg3: $gadArg3"); - } - - #within autocreate no model is supplied - throw warning - if ($gadModel eq $modelErr) - { - Log3 ($name, 2, "define $name: autocreate defines no model - only restricted functions are available"); - } - else - { - #check model-type - return "invalid model for group-number $gadNo. Use " .join(",", keys %dpttypes) if (!defined($dpttypes{$gadModel})); - } - - #convert to string, if supplied in Hex - #old syntax - #$group = KNX_hexToName ($group) if ($group =~ m/^[0-9a-f]{4}$/i); + my $gadName = 'g' . $gadNo; # old syntax + + my ($gad, $gadModel, @gadArgs) = split(/:/x, $a[$i]); + $gadCode = $gad // return "GAD not defined for group-number $gadNo"; + return "KNX_define: $name -wrong GA format in group-number $gadNo: specify as 0-31/0-15/0-255 or as hex \nor invalid IO-Device specified" if (($gad !~ m/^$PAT_GAD$/ix) and ($gad !~ m/^$PAT_GAD_HEX$/ix)); + #new syntax for extended adressing - $gad = KNX_hexToName ($gad) if ($gad =~ m/^[0-9a-f]{5}$/i); + $gad = KNX_hexToName ($gad) if ($gad =~ m/^$PAT_GAD_HEX$/ix); #convert it vice-versa, just to be sure $gadCode = KNX_nameToHex ($gad); + if(! defined($gadModel)) { + return "KNX_define: $name -no model defined for group-number $gadNo"; + } + else { + #within autocreate no model is supplied - throw warning + if ($gadModel eq $modelErr) { + Log3 ($name, 3, "KNX_define: $name -autocreate device will be disabled, correct def with valid dpt and enable device") if ($init_done); + } + elsif (!defined($dpttypes{$gadModel})) { #check model-type + return "KNX_define: $name -invalid model: $gadModel for group-number $gadNo. Please consult commanref - available DPT for correct model definition."; + } + } + + if (@gadArgs) { + if ($gadArgs[0] =~ m/^$PAT_GAD_OPTIONS$/ix) { # no gadname given + unshift ( @gadArgs , 'dummy' ); # shift option up in array + } + elsif ($gadArgs[0] =~ m/^$PAT_GAD_NONAME.*/ix) { # check for forbidden names + return "KNX_define: $name -forbidden gad-name: $gadArgs[0]"; + } + else { + $gadName = $gadArgs[0]; # new syntax + } + + $gadOption = $gadArgs[1] if(defined($gadArgs[1]) && $gadArgs[1] =~ m/$PAT_GAD_OPTIONS/ix); + $gadNoSuffix = 'noSuffix' if (join(q{ },@gadArgs) =~ m/nosuffix/ix); + + return "KNX_define: $name -invalid option for group-number $gadNo. Use $PAT_GAD_OPTIONS" if (defined($gadOption) && ($gadOption !~ m/$PAT_GAD_OPTIONS/ix)); + return "KNX_define: $name -invalid suffix for group-number $gadNo. Use $PAT_GAD_SUFFIX" if (defined($gadNoSuffix) && ($gadNoSuffix !~ m/$PAT_GAD_SUFFIX/ix)); + } + + #save 1st gadName for later backwardCompatibility + $hash->{FIRSTGADNAME} = $gadName if ($gadNo == 1); + ###GADTABLE #create a hash with gadCode and gadName for later mapping my $tableHashRef = $hash->{GADTABLE}; #if not defined yet, define a new hash - if (not(defined($tableHashRef))) - { + if (not(defined($tableHashRef))) { $tableHashRef={}; $hash->{GADTABLE}=$tableHashRef; - } - ###GADTABLE - - return "GAD $gad may be supplied only once per device." if (defined ($tableHashRef->{$gadCode})); - - #Arg3 supplied? May be name or option. If not --> Error! - if (defined ($gadArg3)) - { - #Arg3 is an option - if ($gadArg3 =~ m/$PAT_GAD_OPTIONS/i) - { - $gadOption = $gadArg3; - } - #Arg3 is a fordbidden name (set-command) - elsif (defined ($sets{$gadArg3})) - { - return "invalid name: $gadArg3. Forbidden names: " .join(",", keys %sets) ; - } - elsif ($gadArg3 =~ m/$PAT_GAD_SUFFIX/i) - { - return "not allowed: supplied \"nosuffix\" without \"name\"" ; - } - #Arg3 is a name -> assign it - else - { - $gadName = $gadArg3; - } } - - #Arg4 supplied? May be option or nosuffix. If not --> Error! - if (defined ($gadArg4)) - { - #Arg4 is an option - if ($gadArg4 =~ m/$PAT_GAD_OPTIONS/i) - { - $gadOption = $gadArg4; - } - elsif ($gadArg4 =~ m/$PAT_GAD_SUFFIX/i) - { - $gadNoSuffix = $gadArg4; - } - #Arg4 is unknown - else - { - return "invalid option for group-number $gadNo. Use $PAT_GAD_OPTIONS or $PAT_GAD_SUFFIX"; - } + ###GADTABLE + + return "KNX_define: $name -GAD $gad may be supplied only once per device." if (defined ($tableHashRef->{$gadCode})); + + #cache suffixes + my $suffixGet = q{-get}; + my $suffixSet = q{-set}; + my $suffixPut = q{-put}; + if (defined ($gadNoSuffix)) { + $suffixGet = q{}; + $suffixSet = q{}; + $suffixPut = q{}; + } + # new syntax readingNames + my $rdNameGet = $gadName . $suffixGet; + my $rdNameSet = $gadName . $suffixSet; + my $rdNamePut = $gadName . $suffixPut; + + if (($gadName =~ /^g$gadNo/ix) && (! defined($gadNoSuffix))) { # old syntax + $rdNameGet = "getG" . $gadNo; + $rdNameSet = "setG" . $gadNo; + $rdNamePut = "putG" . $gadNo; } - #Arg5 supplied? Must be preventSuffix. If not --> Error! - if (defined ($gadArg5)) - { - if ($gadArg5 =~ m/$PAT_GAD_SUFFIX/i) - { - $gadNoSuffix = $gadArg5; - } - #Arg5 is unknown - else - { - return "invalid option for group-number $gadNo. Use $PAT_GAD_SUFFIX"; - } - } - - #cache suffixes - my $suffixGet = "-get"; - my $suffixSet = "-set"; - my $suffixPut = "-put"; - - if (defined ($gadNoSuffix) and not ($gadNoSuffix eq "")) - { - $suffixGet = ""; - $suffixSet = ""; - $suffixPut = ""; - } - - if (defined ($gadName) and not ($gadName eq "")) - { - if (defined ($gadOption) and not ($gadOption eq "")) - { - #get - prohibit set - if ($gadOption =~ m/(get)|(listenonly)/i) - { - $rdNameGet = $gadName . $suffixGet; - $rdNameSet = ""; - $rdNamePut = $gadName . $suffixPut;; - } - #listenonly - prohibit set and put - elsif ($gadOption =~ m/(get)|(listenonly)/i) - { - $rdNameGet = $gadName . $suffixGet; - $rdNameSet = ""; - $rdNamePut = ""; - } - #set - prohibit put and get - elsif ($gadOption =~ m/(set)/i) - { - $rdNameGet = ""; - $rdNameSet = $gadName . $suffixSet; - $rdNamePut = ""; - } - } - else - { - $rdNameGet = $gadName . $suffixGet; - $rdNameSet = $gadName . $suffixSet; - $rdNamePut = $gadName . $suffixPut; - } - } - else - { - if (defined ($gadOption) and not ($gadOption eq "")) - { - #get - prohibit set - if ($gadOption =~ m/(get)|(listenonly)/i) - { - $rdNameGet = "getG" . $gadNo; - $rdNameSet = ""; - $rdNamePut = "putG" . $gadNo; - } - #listenonly - prohibit set and put - elsif ($gadOption =~ m/(get)|(listenonly)/i) - { - $rdNameGet = "getG" . $gadNo; - $rdNameSet = ""; - $rdNamePut = ""; - } - #set - prohibit put and get - elsif ($gadOption =~ m/(set)/i) - { - $rdNameGet = ""; - $rdNameSet = "setG" . $gadNo; - $rdNamePut = ""; - } - } - else - { - $rdNameGet = "getG" . $gadNo; - $rdNameSet = "setG" . $gadNo; - $rdNamePut = "putG" . $gadNo; - } - } - - #assuming name in old syntax, if not given... - $gadName = "g" . $gadNo if (!defined ($gadName)); - - my $log = "define $name: found GAD: $gad, NAME: $gadName NO: $gadNo, HEX: $gadCode, DPT: $gadModel"; - $log .= ", OPTION: $gadOption" if (defined ($gadOption)); - Log3 ($name, 5, "$log"); - + my $log = "KNX_define: $name -found GAD: $gad, NAME: $gadName NO: $gadNo, HEX: $gadCode, DPT: $gadModel"; + $log .= ", OPTION: $gadOption" if (defined ($gadOption)); + Log3 ($name, 5, "$log"); + #determint dpt-details my $dptDetails = $dpttypes{$gadModel}; my $setlist; #case list is given, pass it through - if (defined ($dptDetails->{SETLIST})) - { - $setlist = ":" . $dptDetails->{SETLIST}; + if (defined ($dptDetails->{SETLIST})) { + $setlist = q{:} . $dptDetails->{SETLIST}; } #case number - place slider - elsif (defined ($dptDetails->{MIN}) and ($dptDetails->{MIN} =~ m/0|[+-]?\d*[(.|,)\d*]/)) - { + elsif (defined ($dptDetails->{MIN}) and ($dptDetails->{MIN} =~ m/0|[+-]?\d*[(.|,)\d*]/x)) { my $min = $dptDetails->{MIN}; my $max = $dptDetails->{MAX}; my $interval = int(($max-$min)/100); $interval = 1 if ($interval == 0); - $setlist = ":slider," . $min . "," . $interval . "," . $max; + $setlist = ':slider,' . $min . q{,} . $interval . q{,} . $max; } #on/off/... - elsif (defined ($dptDetails->{MIN})) - { + elsif (defined ($dptDetails->{MIN})) { my $min = $dptDetails->{MIN}; my $max = $dptDetails->{MAX}; - $setlist = ":" . $min . "," . $max; + $setlist = q{:} . $min . q{,} . $max; } #plain input field - else - { - $setlist = ""; - } - + else { + $setlist = q{}; + } + Log3 ($name, 5, "define $name, Estimated reading-names: $rdNameGet, $rdNameSet, $rdNamePut"); Log3 ($name, 5, "define $name, SetList: $setlist") if (defined ($setlist)); @@ -548,1418 +505,1178 @@ KNX_Define($$) { #add key and value to GADTABLE $tableHashRef->{$gadCode} = $gadName; - + ###DEFPTR my @devList = (); - #Restore list, if at least one GAD is installed + #get list, if at least one GAD is installed @devList = @{$modules{KNX}{defptr}{$gadCode}} if (defined ($modules{KNX}{defptr}{$gadCode})); #push actual hash to list push (@devList, $hash); - #backup list - @{$modules{KNX}{defptr}{$gadCode}} = @devList; + #restore list + @{$modules{KNX}{defptr}{$gadCode}} = @devList; ###DEFPTR - - #in firstrun backup gadName for later backwardCompatibility - $hash->{FIRSTGADNAME} = $gadName if ($firstrun == 1); - - #create getlist for getFn - $hash->{GETSTRING} = join (":noArg ", keys %{$hash->{GADDETAILS}}) . ":noArg"; - - #create setlist for setFn - my $setString = ""; - foreach my $key (keys %{$hash->{GADDETAILS}}) - { - #no set-command for listenonly or get + + #create setlist/getlist for setFn / getFn + my $setString = q{}; + my $getString = q{}; + foreach my $key (keys %{$hash->{GADDETAILS}}) { + #no set-command for listenonly or get / no get cmds for set my $option = $hash->{GADDETAILS}{$key}{OPTION}; - if (defined ($option) and ($option =~ m/(get)|(listenonly)/i)) - { - #readonly, do nothing + if (defined ($option)) { + if ($option eq 'get') { + $getString .= q{ } . $key . ':noArg'; + } + elsif ($option eq 'set') { + $setString .= ' on:noArg off:noArg' if (($hash->{GADDETAILS}{$key}{NO} == 1) && ($hash->{GADDETAILS}{$key}{MODEL} =~ /^(dpt1|dpt1.001)$/x)); + $setString .= q{ } . $key . $hash->{GADDETAILS}{$key}{SETLIST}; + } + # must be listenonly, do nothing } - else - { - $setString .= " " if (length ($setString) > 1); - $setString = $setString . $key . $hash->{GADDETAILS}{$key}{SETLIST}; + else { # no option def, select all + $getString .= q{ } . $key . ':noArg'; + $setString .= ' on:noArg off:noArg' if (($hash->{GADDETAILS}{$key}{NO} == 1) && ($hash->{GADDETAILS}{$key}{MODEL} =~ /^(dpt1|dpt1.001)$/x)); + $setString .= q{ } . $key . $hash->{GADDETAILS}{$key}{SETLIST}; } } + $setString =~ s/^[\s?](.*)/$1/ix; # trim leading blank + $getString =~ s/^[\s?](.*)/$1/ix; $hash->{SETSTRING} = $setString; - - Log3 ($name, 5, "GETSTR: " . $hash->{GETSTRING} . ", SETSTR: " . $hash->{SETSTRING}); - - $firstrun = 0; + $hash->{GETSTRING} = $getString; + + Log3 ($name, 5, "KNX_define: $name -GETSTR: " . $hash->{GETSTRING} . ", SETSTR: " . $hash->{SETSTRING}); } - - #common name - $hash->{NAME} = $name; + #backup name for a later rename - $hash->{DEVNAME} = $name; - - #assign io-dev automatically, if not given via definition - AssignIoPort($hash); - - Log3 ($name, 5, "exit define"); - - #debug GAD-codes - if (0) - { - foreach my $gd (keys %{$modules{KNX}{defptr}}) - { - Log3 ($name, 5, "GAD: $gd"); - foreach my $dv (@{$modules{KNX}{defptr}{$gd}}) - { - Log3 ($name, 5, "DEV: " . $dv->{NAME} . " (GAD: $gd)"); - } - } - } - - return undef; + $hash->{DEVNAME} = $name; # wer braucht das? + + Log3 ($name, 5, "KNX_define: $name -exit"); + + return $UNDEF; } #Release this device #Is called at every delete / shutdown ############################# -sub -KNX_Undef($$) { - my ($hash, $name) = @_; +sub KNX_Undef { + my $hash = shift; + my $name = shift; - Log3 ($name, 5, "enter undef $name: hash: $hash name: $name"); + Log3 ($name, 5, "KNX_undef -enter: $name"); - #remove hash-pointer from available devices-list - #parse through all valid GAD in this deive - foreach my $gadCode (keys %{$hash->{GADTABLE}}) - { - my $gadName = $hash->{GADTABLE}{$gadCode}; - Log3 ($name, 5, "undef $name: remove $gadName, $gadCode"); - - #get list of hash-pointers - my @oldDeviceList = @{$modules{KNX}{defptr}{$gadCode}}; - my @newDeviceList = (); - #create new list without this device - foreach my $devHash (@oldDeviceList) - { - push (@newDeviceList, $devHash) if (not ($devHash == $hash)); - } - - #backup new list - @{$modules{KNX}{defptr}{$gadCode}} = @newDeviceList; - } + #delete all defptr entries for this device. this bug is still in SVN version! 09-02-2021 + KNX_delete_defptr($hash); # verify with: {PrintHash($modules{KNX}{defptr},3) } on FHEM-cmdline - Log3 ($name, 5, "exit undef"); - return undef; + Log3 ($name, 5, "KNX_undef -exit"); + return $UNDEF; } #Places a "read" Message on the KNX-Bus #The answer is treated as regular telegram ############################# -sub -KNX_Get($@) { +sub KNX_Get { my ($hash, @a) = @_; my $name = $hash->{NAME}; - my $groupnr = 1; - my $tempStr = join (", ", @a); - Log3 ($name, 5, "enter get $name: hash: $hash, attributes: $tempStr"); - - #not necessary any more - was used to get rid of the "-" from the checkboxes - #splice(@a, 1, 1) if (defined ($a[1]) and ($a[1] =~ m/-/)); - my $na = int(@a); - - - #not more then 2 arguments allowed - Log3 ($name, 2, "get: too much arguments. Only one argument allowed (group-address). Other Arguments are discarded.") if ($na > 2); - #FHEM asks with a ? at startup - no action, no log - - return "Unknown argument, choose one of " . $hash->{GETSTRING} if(defined($a[1]) and ($a[1] =~ m/\?/)); - - #determine gadName to read - #ask for first defined GAD if no argument is supplied - my $gadName; - if (defined ($a[1])) - { + return "unknown argument $a[1] choose one of " . $hash->{GETSTRING} if(defined($a[1]) && ($a[1] =~ m/\?/x)); + return "KNX_Get device: $name is disabled" if (IsDisabled($name) == 1); + + Log3 ($name, 5, "KNX_Get -enter: $name, " . join(", ", @a)); + + #no more than 1 argument allowed + Log3 ($name, 2, "KNX_Get: too much arguments. Only one argument allowed (group-address). Other Arguments are discarded.") if (int(@a) > 2); + + #determine gadName to read - use first defined GAD if no argument is supplied + my $gadName; + if (defined ($a[1])) { $gadName = $a[1]; } - else - { - $gadName = $hash->{FIRSTGADNAME}; + else { + $gadName = $hash->{FIRSTGADNAME}; } - + #get groupCode my $groupc = $hash->{GADDETAILS}{$gadName}{CODE}; #get groupAddress my $group = $hash->{GADDETAILS}{$gadName}{GROUP}; #get option my $option = $hash->{GADDETAILS}{$gadName}{OPTION}; - + #return, if unknown group - return "no valid address stored for gad: $gadName" if(!$groupc); - - #exit, if read is prohibited - #return "did not request a value - \"listenonly\" is set." if (AttrVal ($name, "listenonly", 0) =~ m/1/); - + return "KNX_Get: no valid address stored for gad: $gadName" if(!$groupc); + #exit if get is prohibited - return "did not request a value - \"listenonly\" is set." if (defined ($option) and ($option =~ m/listenonly/i)); - return "did not request a value - \"set\" is set." if (defined ($option) and ($option =~ m/set/i)); - + return 'KNX_Get: did not request a value - "set" or "listenonly" option is defined.' if (defined ($option) and ($option =~ m/(set|listenonly)/ix)); + #send read-request to the bus - Log3 ($name, 5, "get $name: request value for GAD: $group, GAD-NAME: $gadName"); - IOWrite($hash, $id, "r" . $groupc); - - Log3 ($name, 5, "exit get"); - - return "current value for $name ($group) requested"; + Log3 ($name, 5, "KNX_Get-exit: $name request value for GAD: $group, GAD-NAME: $gadName"); + + IOWrite($hash, $TULid, 'r' . $groupc); + + FW_directNotify("FILTER=" . $FW_detail, '#FHEMWEB:' . $FW_wname, 'FW_errmsg(" current value for ' . $name . ' - ' . $group . ' requested",5000)', qq{}); + + return; } #Does something according the given cmd... ############################# -sub -KNX_Set($@) { +sub KNX_Set { my ($hash, @a) = @_; my $name = $hash->{NAME}; - my $ret = ""; - my $na = int(@a); - - my $tempStr = join (", ", @a); - #log only, if not called with cmd = ? - Log3 ($name, 5, "enter set $name: hash: $hash, attributes: $tempStr") if ((defined ($a[1])) and (not ($a[1] eq "?"))); + my $ret = q{}; + my $na = scalar(@a); + + #identify this sub + my @ca = caller(0); + (my $thisSub = $ca[3]) =~ s/.+[:]+//gx; - #return, if no set value specified - return "no set value specified" if($na < 2); - - #backup values - my $arg1 = $a[1]; - my $arg2 = $a[2] if defined ($a[2]); - #remove whitespaces - $arg1 =~ s/^\s+|\s+$//gi; - #FHEM asks with a "?" at startup or any reload of the device-detail-view #return string for enabling webfrontend to show boxes, ... - #Log3 ($name, 5, "Unknown argument, choose one of " . $hash->{SETSTRING}) if(defined($arg1) and ($arg1 =~ m/\?/)); - return "Unknown argument, choose one of " . $hash->{SETSTRING} if(defined($arg1) and ($arg1 =~ m/\?/)); - + return "unknown argument $a[1] choose one of " . $hash->{SETSTRING} if(defined($a[1]) && ($a[1] =~ m/\?/x)); + return "$thisSub: device $name is disabled" if (IsDisabled($name) == 1); + + Log3 ($name, 5, "$thisSub -enter: $name, " . join(", ", @a[1 .. $na-1])) if (defined ($a[1])); + + #return, if no cmd specified + return "$thisSub: no gadname specified for set cmd" if((!defined($a[1])) || ($a[1] eq q{})); + #return, if no set value specified + return "$thisSub: no value specified for set cmd" if($na < 2); + + #remove whitespaces + (my $targetGadName = $a[1]) =~ s/^\s+|\s+$//gix; # gad-name or cmd (in old syntax) + my @arg = @a[2 .. $na-1]; # copy cmd & arguments + #contains gadNames to be executed - my $targetGadName = undef; my $cmd = undef; - my @arg = (); - + #check, if old or new syntax - #new syntax, if first arg is a valid gadName - if (defined ($hash->{GADDETAILS}{$arg1})) - { - $targetGadName = $arg1; - $cmd = $arg2; - - #backup args - for (my $i = 3; $i <= scalar(@a); $i++) - { - push (@arg, $a[$i]) if (defined ($a[$i])); - } + if (defined ($hash->{GADDETAILS}{$targetGadName})) { # #new syntax, if first arg is a valid gadName + #shift backup args as with newsyntax $a[2] is cmd + $cmd = shift(@arg); } - #oldsyntax - else - { - #the command can be send to any of the defined groups indexed starting by 1 - #optional last argument starting with g indicates the group - #default - my $groupnr = 1; - my $lastArg = $na - 1; - #select another group, if the last arg starts with a g - if($na > 2 && $a[$lastArg]=~ m/${PAT_GNO}/i) - { - $groupnr = $a[$lastArg]; - #remove "g" - $groupnr =~ s/^g//gi; - - $lastArg--; - } - - #unknown groupnr - return "group-no. not found" if(!defined($groupnr)); - - foreach my $key (keys %{$hash->{GADDETAILS}}) - { - $targetGadName = $key if (int ($hash->{GADDETAILS}{$key}{NO}) == int ($groupnr)); - } - - $cmd = $arg1; - - #backup args - for (my $i = 2; $i <= $lastArg; $i++) - { - push (@arg, $a[$i]) if (defined ($a[$i])); - } - - if ($cmd =~ m/$RAW/i) - { - return "no data for cmd $cmd" if ($lastArg < 2); - - #check for 1-16 hex-digits - if ($a[2] =~ m/[0-9A-F]{1,16}/i) - { - $cmd = $a[2]; - } - else - { - return "$a[2] has wrong syntax. Use hex-format only."; - } - } - elsif ($cmd =~ m/$VALUE/i) - { - my $code = $hash->{GADDETAILS}{$targetGadName}{MODEL}; - return "\"value\" not allowed for dpt1, dpt16 and dpt232" if ($code =~ m/(dpt1$)|(dpt16$)|(dpt232$)/i); - return "no data for cmd $cmd" if ($lastArg < 2); - - $cmd = $a[2]; - $cmd =~ s/,/\./g; - } - #set string - elsif ($cmd =~ m/$STRING/i) - { - my $code = $hash->{GADDETAILS}{$targetGadName}{MODEL}; - return "\"string\" only allowed for dpt16" if (not($code =~ m/dpt16/i)); - return "no data for cmd $cmd" if ($lastArg < 2); - - $cmd = $a[2]; - for (my $i=3; $i<=$lastArg; $i++) - { - $cmd.= " ".$a[$i]; - } - } - #set RGB - elsif ($cmd =~ m/$RGB/i) - { - my $code = $hash->{GADDETAILS}{$targetGadName}{MODEL}; - return "\"RGB\" only allowed for dpt232" if (not($code =~ m/(dpt232$)/i)); - return "no data for cmd $cmd" if ($lastArg < 2); - - #check for 1-16 hex-digits - if ($a[2] =~ m/[0-9A-F]{6}/i) - { - $cmd = lc($a[2]); - } - else - { - return "$a[2] has wrong syntax. Use hex-format only."; - } - } + else { #oldsyntax + (my $err, $targetGadName, $cmd) = KNX_Set_oldsyntax($hash,$targetGadName,@arg); ## process old syntax + return $err if defined($err); } - return "no target and cmd found" if(!defined($targetGadName) and !defined($cmd)); - return "no cmd found" if(!defined($cmd)); - return "no target found" if(!defined($targetGadName)); + return "$thisSub: no target and cmd found" if((!defined($targetGadName)) && (!defined($cmd))); + return "$thisSub: no cmd found" if(!defined($cmd)); + return "$thisSub: no target found" if(!defined($targetGadName)); + + Log3 ($name, 5, "$thisSub: set $name: desired target is gad: $targetGadName, command: $cmd, args: " . join (q{ }, @arg)); - $tempStr = join (" ", @arg); - Log3 ($name, 5, "set $name: desired target is gad $targetGadName, command: $cmd, args: $tempStr"); - #get details my $groupCode = $hash->{GADDETAILS}{$targetGadName}{CODE}; - my $option = $hash->{GADDETAILS}{$targetGadName}{OPTION}; - my $rdString = $hash->{GADDETAILS}{$targetGadName}{RDNAMESET}; - #This contains the input - my $value = ""; - - return "did not set a value - \"listenonly\" is set." if (defined ($option) and ($option =~ m/listenonly/i)); - return "did not set a value - \"get\" is set." if (defined ($option) and ($option =~ m/get/i)); - + my $option = $hash->{GADDETAILS}{$targetGadName}{OPTION}; + my $rdName = $hash->{GADDETAILS}{$targetGadName}{RDNAMESET}; + my $model = $hash->{GADDETAILS}{$targetGadName}{MODEL}; + + return $thisSub . ': did not set a value - "get" or "listenonly" option is defined.' if (defined ($option) and ($option =~ m/(get|listenonly)/ix)); + ############################## #process set command with $value as output - # - $value = $cmd; + my $value = $cmd; #Text neads special treatment - additional args may be blanked words - $value .= " " . join (" ", @arg) if (($hash->{GADDETAILS}{$targetGadName}{MODEL} =~ m/dpt16$/i) and (scalar (@arg) > 0)); - #Special commands for dpt1 and dpt1.001 - if ($hash->{GADDETAILS}{$targetGadName}{MODEL} =~ m/((dpt1)|(dpt1.001))$/i) - { - #delete any running timers - #on-for-timer - if ($hash->{"ON-FOR-TIMER_$groupCode"}) - { - CommandDelete(undef, $name . "_timer_$groupCode"); - delete $hash->{"ON-FOR-TIMER_$groupCode"}; - } - #on-until - if($hash->{"ON-UNTIL_$groupCode"}) - { - CommandDelete(undef, $name . "_until_$groupCode"); - delete $hash->{"ON-UNTIL_$groupCode"}; - } - #off-for-timer - if ($hash->{"OFF-FOR-TIMER_$groupCode"}) - { - CommandDelete(undef, $name . "_timer_$groupCode"); - delete $hash->{"OFF-FOR-TIMER_$groupCode"}; - } - #off-until - if($hash->{"OFF-UNTIL_$groupCode"}) - { - CommandDelete(undef, $name . "_until_$groupCode"); - delete $hash->{"OFF-UNTIL_$groupCode"}; - } - - #set on-for-timer / off-for-timer - if ($cmd =~ m/($ONFORTIMER)|($OFFFORTIMER)/i) - { - #get duration - my $duration = sprintf("%02d:%02d:%02d", $arg[0]/3600, ($arg[0]%3600)/60, $arg[0]%60); - Log3 ($name, 5, "set $name: \"on-for-timer\" for $duration"); - #create local marker - $hash->{"ON-FOR-TIMER_$groupCode"} = $duration; - #place at-command for switching off - CommandDefine(undef, $name . "_timer_$groupCode at +$duration set $name $targetGadName off"); - #switch on or off... - if ($cmd =~ m/on/i) - { - $value = "on"; - } - else - { - $value = "off"; - } - } - #set on-until / off-until - elsif ($cmd =~ m/($ONUNTIL)|($OFFUNTIL)/i) - { - #get off-time - my ($err, $hr, $min, $sec, $fn) = GetTimeSpec($arg[0]); - - return "Error trying to parse timespec for $arg[0]: $err" if (defined($err)); - - #build of-time - my @lt = localtime; - my $hms_til = sprintf("%02d:%02d:%02d", $hr, $min, $sec); - my $hms_now = sprintf("%02d:%02d:%02d", $lt[2], $lt[1], $lt[0]); - - return "Won't switch - now ($hms_now) is later than $hms_til" if($hms_now ge $hms_til); + $value .= q{ } . join (q{ }, @arg) if (($model =~ m/^dpt16/ix) and (scalar (@arg) > 0)); - Log3 ($name, 5, "set $name: \"on-until\" up to $hms_til"); - #create local marker - $hash->{"ON-UNTIL_$groupCode"} = $hms_til; - #place at-command for switching off - CommandDefine(undef, $name . "_until_$groupCode at $hms_til set $name $targetGadName off"); - #switch on or off... - if ($cmd =~ m/on/i) - { - $value = "on"; - } - else - { - $value = "off"; - } - } - #toggle - elsif ($cmd =~ m/$TOGGLE/i) - { - if (ReadingsVal($name, $hash->{GADDETAILS}{$targetGadName}{RDNAMEGET}, "") =~ m/off/i) - { - $value = "on"; - } - else - { - $value = "off"; - } - } + #Special commands for dpt1 and dpt1.001 + if ($model =~ m/((dpt1)|(dpt1.001))$/ix) { + (my $err, $value) = KNX_Set_dpt1($hash, $targetGadName, $cmd, @arg); + return $err if defined($err); } - + + ############################## #check and cast value - my $transval = KNX_checkAndClean($hash, $value, $targetGadName); + my $transval = KNX_checkAndClean($hash, $value, $targetGadName); #if cast not successful - return "invalid value: $value" if (!defined($transval)); + return "$thisSub: invalid value= $value" if (!defined($transval)); - # - # - #/process set command - ############################## - - - #send value - $transval = KNX_encodeByDpt($hash, $transval, $targetGadName); - IOWrite($hash, $id, "w" . $groupCode . $transval); + #process set command + my $transvale = KNX_encodeByDpt($hash, $transval, $targetGadName); + IOWrite($hash, $TULid, 'w' . $groupCode . $transvale); - Log3 ($name, 5, "set $name: cmd: $cmd, value: $value, translated: $transval"); + Log3 ($name, 4, "$thisSub: $name, cmd= $cmd, value= $value, translated= $transvale"); - #re-read value, do not modify variable name due to usage in cmdAttr - $transval = KNX_decodeByDpt($hash, $transval, $targetGadName); - #append post-string, if supplied - my $suffix = AttrVal($name, "format",undef); - $transval = $transval . " " . $suffix if (defined($suffix)); - #execute regex, if defined - my $regAttr = AttrVal($name, "stateRegex", undef); - my $state = KNX_replaceByRegex ($regAttr, $rdString . ":", $transval); - - Log3 ($name, 5, "set name: $name - replaced $rdString:$transval to $state") if (not ($transval eq $state)); + # decode again for values that have been changed in encode process + if ($model =~ m/^(dpt3|dpt10|dpt11|dpt19)/ix) { + $transval = KNX_decodeByDpt($hash, $transvale, $targetGadName); + } + else { + my $unit = $dpttypes{$model}{UNIT}; + $transval .= q{ } . $unit if (defined($unit) && ($unit ne q{})); # append units during set cmd + } + #apply post processing for state and set all readings + KNX_SetReadings($hash, $targetGadName, $transval, $rdName, undef); - if (defined($state)) - { - readingsBeginUpdate($hash); - readingsBulkUpdate($hash, $rdString, $transval); + Log3 ($name, 5, "$thisSub: -exit"); + return $UNDEF; +} - #execute state-command if defined - #must be placed after first reading, because it may have a reference - my $cmdAttr = AttrVal($name, "stateCmd", undef); - if (defined ($cmdAttr) and !($cmdAttr eq "")) - { - $state = KNX_eval ($hash, $targetGadName, $state, $cmdAttr); - Log3 ($name, 5, "set name: $name - state replaced via command, result: state:$state"); +# Process set command for old syntax +# calling param: $hash, $cmd, arg array +# returns ($err, targetgadname, $cmd) +sub KNX_Set_oldsyntax { + my ($hash, $cmd, @a) = @_; + my $name = $hash->{NAME}; + my $na = scalar(@a); + + #contains gadNames to be executed + my $targetGadName = undef; + + #default + my $groupnr = 1; + #select another group, if the last arg starts with a g + if($na >= 1 && $a[$na - 1] =~ m/$PAT_GNO/ix) { + $groupnr = pop (@a); + Log3 $name, 3, q{KNX_Set_oldsyntax: you are still using "old syntax", pls. change to "set } . "$name $groupnr $cmd " . join(q{ },@a) . q{"}; + $groupnr =~ s/^g//gix; #remove "g" + } + + #unknown groupnr + return "KNX_Set_oldsyntax: group-no. not found" if((!defined($groupnr)) || ($groupnr eq q{})); + + foreach my $key (keys %{$hash->{GADDETAILS}}) { + $targetGadName = $key if (int ($hash->{GADDETAILS}{$key}{NO}) == int ($groupnr)); + } + return "KNX_Set_oldsyntax: gadName not found for $groupnr" if(!defined($targetGadName)); + + # all of the following cmd's need at least 1 Argument (or more) + return ($UNDEF, $targetGadName, $cmd) if (scalar(@a) <= 0); + + my $value = "$cmd " . join(q{ },@a); # default + if ($cmd =~ m/$RAW/ix) { # perlcritic (ControlStructures::ProhibitCascadingIfElse) ? + + #check for 1-16 hex-digits + return "KNX_Set_oldsyntax: $cmd $a[0] has wrong syntax. Use hex-format only." if ($a[0] !~ m/[0-9A-F]{1,16}/ix); + $value = $a[0]; + } + elsif ($cmd =~ m/$VALUE/ix) { + my $code = $hash->{GADDETAILS}{$targetGadName}{MODEL}; + return 'KNX_Set_oldsyntax: "value" not allowed for dpt1, dpt16 and dpt232' if ($code =~ m/(dpt1$)|(dpt16$)|(dpt232$)/ix); + + $value = $a[0]; + $value =~ s/,/\./gx; + } + #set string + elsif ($cmd =~ m/$STRING/ix) { + my $code = $hash->{GADDETAILS}{$targetGadName}{MODEL}; + return 'KNX_Set_oldsyntax: "string" only allowed for dpt16' if ($code !~ m/dpt16/ix); + + $value = q{}; # will be joined in KNX_Set + } + #set RGB + elsif ($cmd =~ m/$RGB/ix) { + my $code = $hash->{GADDETAILS}{$targetGadName}{MODEL}; + return 'KNX_Set_oldsyntax: "RGB" only allowed for dpt232' if ($code !~ m/dpt232$/ix); + + #check for 6 hex-digits + return "KNX_Set_oldsyntax: $cmd $a[0] has wrong syntax. Use 6 hex-digits only." if ($a[0] !~ m/[0-9A-F]{6}/ix); + $value = lc($a[0]); + } + return ($UNDEF, $targetGadName, $value); +} + +# process special dpt1, dpt1.001 set +# calling: $hash, $targetGadName, $cmd, @arg +# return: $err, $value +sub KNX_Set_dpt1 { + my ($hash, $targetGadName, $cmd, @arg) = @_; + my $name = $hash->{NAME}; + + my $groupCode = $hash->{GADDETAILS}{$targetGadName}{CODE}; + + #delete any running timers + if ($hash->{"TIMER_$groupCode"}) { + CommandDelete(undef, $name . "_TIMER_$groupCode"); + delete $hash->{"TIMER_$groupCode"}; + } + + # the defaults + my $value = 'off'; # default + if (($cmd eq 'on') || ($cmd eq '1')) {$value = 'on';} +# if (($cmd eq 'on') || ($cmd eq 'off')) {$value = $cmd;} +# elsif ($cmd eq '0') {$value = 'off';} +# elsif ($cmd eq '1') {$value = 'on';} + + #set on-for-timer / off-for-timer + elsif ($cmd =~ m/($ONFORTIMER)|($OFFFORTIMER)/ix) { + #get duration + my $duration = sprintf("%02d:%02d:%02d", $arg[0]/3600, ($arg[0]%3600)/60, $arg[0]%60); + Log3 ($name, 5, "KNX_Set_dpt1 $name: \"on-for-timer\" for $duration"); + #create local marker + $hash->{"TIMER_$groupCode"} = $duration; + #place at-command for switching off + #switch on or off... + if ($cmd =~ m/on/ix) { + $value = "on"; + CommandDefine(undef, $name . "_TIMER_$groupCode at +$duration set $name $targetGadName off"); + } else { + $value = "off"; + CommandDefine(undef, $name . "_TIMER_$groupCode at +$duration set $name $targetGadName on"); } - - readingsBulkUpdate($hash, "state", $state); - readingsBulkUpdate($hash, "last-sender", "fhem"); - readingsEndUpdate($hash, 1); - } - - Log3 ($name, 5, "exit set"); - return undef; + } + #set on-until / off-until + elsif ($cmd =~ m/($ONUNTIL)|($OFFUNTIL)/ix) { + #get off-time + my ($err, $hr, $min, $sec, $fn) = GetTimeSpec($arg[0]); ## fhem.pl + return "KNX_Set_dpt1: Error trying to parse timespec for $arg[0]: $err" if (defined($err)); + + #do like (on|off)-until-overnight in at cmd ! + my $hms_til = sprintf("%02d:%02d:%02d", $hr, $min, $sec); + + Log3 ($name, 5, "KNX_Set_dpt1 $name: \"$cmd $hms_til\" "); + #create local marker + $hash->{"TIMER_$groupCode"} = $hms_til; + #place at-command for switching off + #switch on or off... + if ($cmd =~ m/on/ix) { + $value = "on"; + CommandDefine(undef, $name . "_TIMER_$groupCode at $hms_til set $name $targetGadName off"); + } else { + $value = "off"; + CommandDefine(undef, $name . "_TIMER_$groupCode at $hms_til set $name $targetGadName on"); + } + } + #toggle + elsif ($cmd =~ m/$TOGGLE/ix) { + my $togglereading = 'dummy'; + my $toggleOldVal = 'dontknow'; + my $tDev = $name; # default + + if (defined($hash->{'.TOGGLESRC'})) { # prio1: use Attr. KNX_toggle: format: : + ($tDev, $togglereading) = split(qr/:/x,$hash->{'.TOGGLESRC'}); + $toggleOldVal = ReadingsVal($tDev, $togglereading, 'dontknow'); + } + else { + $togglereading = $hash->{GADDETAILS}{$targetGadName}{RDNAMEGET}; + $toggleOldVal = ReadingsVal($tDev, $togglereading, undef); #prio2: use get-reading + if (! defined($toggleOldVal)) { + $togglereading = $hash->{GADDETAILS}{$targetGadName}{RDNAMESET}; #prio3: use set-reading + $toggleOldVal = ReadingsVal($tDev, $togglereading, 'dontknow'); + } + } + # if (ReadingsVal($name, $hash->{GADDETAILS}{$targetGadName}{RDNAMEGET}, 'on') =~ m/off/ix) { # SVN-Version + + Log3 ($name, 3, 'KNX_Set_dpt1: initial value for "set ' . "$name $targetGadName" . ' TOGGLE is not "on" or "off" - ' . "$targetGadName will be switched off") if ($toggleOldVal !~ /^(?:on|off)/ix); + if ($toggleOldVal =~ m/^off/ix) { + $value = "on"; + } + else { + $value = "off"; # this is the default + } + } + + return ($UNDEF,$value); } #In case setstate is executed, a readingsupdate is initiated ############################# -sub -KNX_State($$$$) { +sub KNX_State { my ($hash, $time, $reading, $value) = @_; my $name = $hash->{NAME}; - my $tempStr = join (", ", @_); - Log3 ($name, 5, "enter state: hash: $hash name: $name, attributes: $tempStr"); - - #in some cases state is submitted within value - if found, take only the stuff after state - #my @strings = split("[sS][tT][aA][tT][eE]", $val); - #$val = $strings[int(@strings) - 1]; - - return undef if (not (defined($value))); - return undef if (not (defined($reading))); - - #remove whitespaces - $value =~ s/^\s+|\s+$//gi; - $reading =~ s/^\s+|\s+$//gi; + return if (not (defined($value))); + return if (not (defined($reading))); + + #remove whitespaces + $value =~ s/^\s+|\s+$//gix; + $reading =~ s/^\s+|\s+$//gix; - #$reading = $reading if ($reading =~ m/state/i); #workaround for STATE in capitol letters (caused by unknown external function) - $reading = "state" if ($reading =~ m/state/i); - - Log3 ($name, 5, "state $name: update $reading with value: $value"); + $reading = "state" if ($reading eq 'STATE'); + Log3 ($name, 5, "KNX_State $name: update $reading with value: $value"); + #write value and update reading readingsSingleUpdate($hash, $reading, $value, 1); - return undef; + return $UNDEF; } #Get the chance to qualify attributes ############################# -sub -KNX_Attr(@) { +sub KNX_Attr { my ($cmd,$name,$aName,$aVal) = @_; - - #if($cmd eq "set") - #{ - # if(($attr_name eq "debug") and (($attr_value eq "1") or ($attr_value eq "true"))) - # { - # } - #} - - Log3 ($name, 2, "Attribut \"listenonly\" is deprecated. Please supply in definition - see commandref for details.") if ($aName =~ m/listenonly/i); - Log3 ($name, 2, "Attribut \"readonly\" is deprecated. Please supply \"get\" in definition - see commandref for details.") if ($aName =~ m/readonly/i); - Log3 ($name, 2, "Attribut \"slider\" is deprecated. Please use widgetOverride in Combination with WebCmd instead. See commandref for details.") if ($aName =~ m/slider/i); - Log3 ($name, 2, "Attribut \"useSetExtensions\" is deprecated.") if ($aName =~ m/useSetExtensions/i); + my $hash = $defs{$name}; - return undef; + my $value = undef; + if ($cmd eq 'set') { + Log3 ($name, 2, 'Attribut "listenonly" is deprecated. Please supply in definition - see commandref for details.') if ($aName =~ m/listenonly/ix); + Log3 ($name, 2, 'Attribut "readonly" is deprecated. Please supply "get" in definition - see commandref for details.') if ($aName =~ m/readonly/ix); + Log3 ($name, 2, 'Attribut "slider" is deprecated. Please use widgetOverride in Combination with WebCmd instead. See commandref for details.') if ($aName =~ m/slider/ix); + Log3 ($name, 2, 'Attribut "useSetExtensions" is deprecated.') if ($aName =~ m/useSetExtensions/ix); + + if ($aName eq 'KNX_toggle') { # validate device/reading + my ($srcDev,$srcReading) = split(qr/:/x,$aVal); # format: : + $srcDev = $name if ($srcDev eq '$self'); + return 'no valid device for attr: KNX_toggle' if (!IsDevice($srcDev)); + $value = ReadingsVal($srcDev,$srcReading,undef) if (defined($srcReading)); #test for value + return 'no valid device/reading value for attr: KNX_toggle' if (!defined($value) && $init_done); # maybe device/reading not defined during starrtup + $hash->{'.TOGGLESRC'} = $srcDev . q{:} . $srcReading; # save for later processing + } + if (($aName eq 'disable') && (defined($aVal)) && ($aVal == 1)) { + $hash->{"SETSTRING"} = q{}; # remove set & get options from UI + $hash->{"GETSTRING"} = q{}; + } + } + + if ($cmd eq 'del') { + delete $hash->{'.TOGGLESRC'} if ($aName eq 'KNX_toggle'); + CommandModify(undef, "$name $hash->{'DEF'}") if ($aName eq 'disable'); # do a defmod ... + } + + return $UNDEF; } #Split reading for DBLOG ############################# -sub KNX_DbLog_split($) { - my ($event) = @_; +sub KNX_DbLog_split { + my ($event, $device) = @_; my ($reading, $value, $unit); - my $tempStr = join (", ", @_); - Log (5, "splitFn - enter, attributes: $tempStr"); - - #detect reading - real reading or state? - my $isReading = "false"; - $isReading = "true" if ($event =~ m/: /); - - #split input-string - my @strings = split (" ", $event); - - my $startIndex = undef; - $unit = ""; - - return undef if (not defined ($strings[0])); + Log3 $device, 5, "KNX_DbLog_split -enter: device= $device event= $event"; - #real reading? - if ($isReading =~ m/true/i) - { - #first one is always reading - $reading = $strings[0]; - $reading =~ s/:?$//; - $startIndex = 1; + #split input-string + my @strings = split (q{ }, $event); + return $UNDEF if (not defined ($strings[0])); + + #detect reading - real reading or state? + if ($strings[0] =~ m/.*:$/x) { # real reading + $reading = shift(@strings); + $reading =~ s/:$//x; } - #plain state - else - { - #for reading state nothing is supplied - $reading = "state"; - $startIndex = 0; + else { + $reading = 'state'; } - - return undef if (not defined ($strings[$startIndex])); #per default join all single pieces - $value = join(" ", @strings[$startIndex..(int(@strings) - 1)]); - - #numeric value? - #if ($strings[$startIndex] =~ /^[+-]?\d*[.,]?\d+/) - if ($strings[$startIndex] =~ /^[+-]?\d*[.,]?\d+$/) - { - $value = $strings[$startIndex]; - #single numeric value? Assume second par is unit... - if ((defined ($strings[$startIndex + 1])) && !($strings[$startIndex+1] =~ /^[+-]?\d*[.,]?\d+/)) - { - $unit = $strings[$startIndex + 1] if (defined ($strings[$startIndex + 1])); - } - } + $value = join(q{ }, @strings); - #numeric value? - #if ($strings[$startIndex] =~ /^[+-]?\d*[.,]?\d+/) - #{ - # $value = $strings[$startIndex]; - # $unit = $strings[$startIndex + 1] if (defined ($strings[$startIndex + 1])); - #} - #string or raw - #else - #{ - # $value = join(" ", @strings[$startIndex..(int(@strings) - 1)]); - #} - - Log (5, "splitFn - READING: $reading, VALUE: $value, UNIT: $unit"); - + #numeric value? and last value non numeric? - assume unit + if (looks_like_number($strings[0]) && (! looks_like_number($strings[scalar(@strings)-1]))) { + $value = join(q{ },@strings[0 .. (scalar(@strings)-2)]); + $unit = $strings[scalar(@strings)-1]; + } + $unit = q{} if (!defined($unit)); + + Log3 $device, 5, "KNX_DbLog_split -exit: device= $device, reading= $reading, value= $value, unit= $unit"; return ($reading, $value, $unit); } #Handle incoming messages ############################# -sub -KNX_Parse($$) { - my ($hash, $msg) = @_; - my $name = $hash->{NAME}; - - #Msg format: - #C(w/r/p) i.e. Bw00000101 - #we will also take reply telegrams into account, - #as they will be sent if the status is asked from bus - #split message into parts +sub KNX_Parse { + my $iohash = shift; # this is IO-Device hash ! + my $msg = shift; + my $ioName = $iohash->{NAME}; + + return q{} if ((IsDisabled($ioName) == 1) || IsDummy($ioName)); # IO - device is disabled or dummy + + #Msg format: + #C[wrp] i.e. Cw00000101 + #we will also take reply telegrams into account, + #as they will be sent if the status is asked from bus - #old syntax - #$msg =~ m/^$id(.{4})(.{1})(.{4})(.*)$/; #new syntax for extended adressing - $msg =~ m/^$id(.{5})(.{1})(.{5})(.*)$/; - my $src = $1; - my $cmd = $2; - my $dest = $3; - my $val = $4; - my $gadCode = $dest; - + my ($src,$cmd,$gadCode,$val) = $msg =~ m/^$TULid([0-9a-f]{5})([prw])([0-9a-f]{5})(.*)$/ix; + my @foundMsgs; - - Log3 ($name, 5, "enter parse: hash: $hash name: $name, dest: $dest, msg: $msg"); + + Log3 ($ioName, 5, "KNX_Parse -enter: IO-name: $ioName, dest: $gadCode, msg: $msg"); #gad not defined yet, give feedback for autocreate - if (not (exists $modules{KNX}{defptr}{$gadCode})) - { - #format gat - my $gad = KNX_hexToName($gadCode); + if (not (exists $modules{KNX}{defptr}{$gadCode})) { + #format gad + my $gad = KNX_hexToName($gadCode); #create name - my ($line, $area, $device) = split ("/", $gad); - my $newDevName = sprintf("KNX_%.2d%.2d%.3d", $line, $area, $device); - - return "UNDEFINED $newDevName KNX $gad:$modelErr"; + my $newDevName = sprintf("KNX_%.2d%.2d%.3d",split (/\//x, $gad)); + return "UNDEFINED $newDevName KNX $gad:$modelErr"; } - + #get list from device-hashes using given gadCode (==destination) - my @deviceList = @{$modules{KNX}{defptr}{$gadCode}}; + my @deviceList = @{$modules{KNX}{defptr}{$gadCode}}; + #process message for all affected devices and gad's - - #debug GAD-codes - if (0) - { - Log3 ($name, 5, "GAD: $gadCode"); - foreach my $dv (@{$modules{KNX}{defptr}{$gadCode}}) - { - Log3 ($name, 5, "DEV: " . $dv->{NAME} . " (GAD: $gadCode)"); - } - } - - foreach my $deviceHash (@deviceList) - { + foreach my $deviceHash (@deviceList) { #get details my $deviceName = $deviceHash->{NAME}; my $gadName = $deviceHash->{GADTABLE}{$gadCode}; - my $model = $deviceHash->{GADDETAILS}{$gadName}{MODEL}; - my $option = $deviceHash->{GADDETAILS}{$gadName}{OPTION}; - my $rdString = $deviceHash->{GADDETAILS}{$gadName}{RDNAMEGET}; - my $putString = $deviceHash->{GADDETAILS}{$gadName}{RDNAMEPUT}; - - Log3 ($deviceName, 5, "parse: process message, device-name: $deviceName, rd-name: $gadName, gadCode: $gadCode, model: $model"); - + + push(@foundMsgs, $deviceName); # save to list even if dev is disabled + + next if (IsDisabled($deviceName) == 1); # device is disabled + + Log3 ($deviceName, 4, "KNX_Parse -process: IO-name: $ioName, device-name: $deviceName, rd-name: $gadName, gadCode: $gadCode, cmd: $cmd"); + ######################### #process message - # #handle write and reply messages - if ($cmd =~ /[w|p]/i) - { + if ($cmd =~ /[w|p]/ix) { #decode message + my $getName = $deviceHash->{GADDETAILS}{$gadName}{RDNAMEGET}; my $transval = KNX_decodeByDpt ($deviceHash, $val, $gadName); #message invalid - if (not defined($transval) or ($transval eq "")) - { - readingsSingleUpdate($deviceHash, "last-sender", KNX_hexToName($src), 1); - Log3 ($deviceName, 2, "parse device hash (wpi): $deviceHash name: $deviceName, message could not be decoded - see log for details"); + if (not defined($transval) or ($transval eq q{})) { + Log3 ($deviceName, 2, "KNX_Parse (wp): $deviceName, READINGNAME: $getName, message $msg could not be decoded"); next; } + Log3 ($deviceName, 4, "KNX_Parse (wp): $deviceName, READINGNAME: $getName, VALUE: $transval, SENDER: $src"); - Log3 ($deviceName, 5, "received hash (wpi): $deviceHash name: $deviceName, STATE: $transval, READING: $gadName, SENDER: $src"); - - #append post-string, if supplied - my $suffix = AttrVal($deviceName, "format",undef); - $transval = $transval . " " . $suffix if (defined($suffix)); - #execute regex, if defined - my $regAttr = AttrVal($deviceName, "stateRegex", undef); - my $state = KNX_replaceByRegex ($regAttr, $rdString . ":", $transval); - - Log3 ($deviceName, 5, "parse device hash (wpi): $deviceHash name: $deviceName - replaced $rdString:$transval to $state") if (not ($transval eq $state)); - - if (defined($state)) - { - readingsBeginUpdate($deviceHash); - readingsBulkUpdate($deviceHash, $rdString, $transval); - readingsBulkUpdate($deviceHash, "last-sender", KNX_hexToName($src)); - - #execute state-command if defined - #must be placed after first readings, because it may have a reference - # - #hack for being backward compatible - serve $name - $name = $deviceName; - my $cmdAttr = AttrVal($deviceName, "stateCmd", undef); - if (defined ($cmdAttr) and !($cmdAttr eq "")) - { - - $state = KNX_eval ($deviceHash, $gadName, $state, $cmdAttr); - Log3 ($deviceName, 5, "parse device hash (wpi): $deviceHash name: $deviceName - state replaced via command $cmdAttr - state: $state"); - } - #reassign original name... - $name = $hash->{NAME}; - - readingsBulkUpdate($deviceHash, "state", $state); - readingsEndUpdate($deviceHash, 1); - } + #apply post processing for state and set all readings + KNX_SetReadings($deviceHash, $gadName, $transval, $getName, $src); } - #handle read messages - elsif ($cmd =~ /[r]/) - { - if (defined ($option) and ($option =~ m/listenonly/i)) - { - Log3 ($deviceName, 5, "received hash (r), ignored request due to option \"listenonly\""); - next; - } - Log3 ($deviceName, 5, "received hash (r): $deviceHash name: $deviceName, GET"); + #handle read messages + elsif ($cmd =~ /[r]/x) { + my $putName = $deviceHash->{GADDETAILS}{$gadName}{RDNAMEPUT}; + Log3 ($deviceName, 5, "KNX_Parse (r): $deviceName, GET"); my $transval = undef; #answer "old school" my $value = undef; - if (AttrVal($deviceName, "answerReading", 0) =~ m/1/) - { - my $putVal = ReadingsVal($deviceName, "putString", undef); + if (AttrVal($deviceName, 'answerReading', 0) =~ m/1/x) { + my $putVal = ReadingsVal($deviceName, $putName, undef); - if (defined ($putVal) and !($putVal eq "")) - { - #medium priority, overwrite $value - $value = $putVal; + if ((defined($putVal)) && ($putVal ne q{})) { + $value = $putVal; #medium priority, overwrite $value } - else - { - #lowest priority - use state - $value = ReadingsVal($deviceName, "state", undef) if (AttrVal($deviceName, "answerReading", 0) =~ m/1/); + else { + $value = ReadingsVal($deviceName, 'state', undef); #lowest priority - use state } } #high priority - eval - ### my $cmdAttr = AttrVal($deviceName, "putCmd", undef); - if (defined ($cmdAttr) and !($cmdAttr eq "")) - { - my $orgValue = $value; - + if ((defined($cmdAttr)) && ($cmdAttr ne q{})) { + $value = ReadingsVal($deviceName, 'state', undef); # get default value from state $value = KNX_eval ($deviceHash, $gadName, $value, $cmdAttr); - - #if ($orgValue ne $value) - #try to fix: answer only, if eval was successful - if (($orgValue ne $value) and ($value !~ m/ERROR/i)) - { - Log3 ($deviceName, 5, "parse device hash (r): $deviceHash name: $deviceName - put replaced via command $cmdAttr - value: $value"); - readingsSingleUpdate($deviceHash, $putString, $value,1); + if (defined($value) && ($value ne q{}) && ($value ne 'ERROR')) { # answer only, if eval was successful + Log3 ($deviceName, 5, "KNX_Parse (r): $deviceName - put replaced via command $cmdAttr - value: $value"); + readingsSingleUpdate($deviceHash, $putName, $value,1); } + else { + Log3 ($deviceName, 2, "KNX_parse error (r): $deviceName - no reply sent!"); + $value = undef; # dont send ! + } } - ###/ #send transval - if (defined($value)) - { + if (defined($value)) { $transval = KNX_encodeByDpt($deviceHash, $value, $gadName); - Log3 ($deviceName, 5, "received, send answer hash: $deviceHash name: $deviceName, GET: $transval, READING: $gadName"); - IOWrite ($deviceHash, "B", "p" . $gadCode . $transval); + Log3 ($deviceName, 4, "KNX_Parse send answer (r): $deviceName, GET: $transval, READING: $gadName"); + IOWrite ($deviceHash, $TULid, "p" . $gadCode . $transval); } } - - #skip, if this is ignored - next if (IsIgnored($deviceName)); - #save to list - push(@foundMsgs, $deviceName); - # #/process message - ######################### } - - Log3 ($name, 5, "exit parse"); - - #return values + + Log3 ($ioName, 5, "KNX_parse -exit"); + return @foundMsgs; } #Function is called at every notify ############################# -sub -KNX_Notify($$) -{ - my ($ownHash, $callHash) = @_; +sub KNX_Notify { + my $ownHash = shift; + my $callHash = shift; #own name / hash my $ownName = $ownHash->{NAME}; + return if(IsDisabled($ownName) == 1); # Return without any further action if the module is disabled + #Device that created the events my $callName = $callHash->{NAME}; - return undef; + my $events = deviceEvents($callHash, 1); + if($callName eq "global") { + foreach my $ev (@{$events}) { + if ($ev =~ /^INITIALIZED|REREADCFG$/x) { + # X_FunctionWhoNeedsAttr($hash); + } + } + } + return $UNDEF; } -#Private function to convert GAD from hex to readable version +# ignore duplicate messages (runs in TUL /KNXTUL context!) ############################# -sub -KNX_hexToName ($) -{ +sub KNX_FingerPrint { + my $ioname = shift; + my $buf = shift; + substr( $buf, 1, 5, '.....' ); # ignore src addr + Log3 $ioname, 5, 'KNX_FingerPrint: ' . $buf; +# return ( $ioname, $buf ); # ignore src addr only + return ( q{}, $buf ); # ignore ioname & src addr +} + +########## begin of private functions ########## + +# KNX_SetReadings is called from KNX_Set and KNX_Parse +# calling param: $hash, $gadName, $transval, $rdName, caller (set/parse) +sub KNX_SetReadings { + my ($hash, $gadName, $transval, $rdName, $src) = @_; + my $name = $hash->{NAME}; + + #append post-string, if supplied + my $suffix = AttrVal($name, "format",undef); + $transval .= q{ } . $suffix if (defined($suffix)); + #execute regex, if defined + my $regAttr = AttrVal($name, "stateRegex", undef); + my $state = KNX_replaceByRegex ($regAttr, $rdName, $transval); + + my $logstr = (defined($state))?$state:'UNDEFINED'; + Log3 ($name, 5, "KNX_SetReadings: $name - replaced $rdName value from: $transval to $logstr") if ($transval ne $logstr); + + my $lsvalue = 'fhem'; # called from set + $lsvalue = KNX_hexToName2($src) if (defined($src) && ($src ne q{})); # called from parse + + readingsBeginUpdate($hash); + readingsBulkUpdate($hash, 'last-sender', $lsvalue); + readingsBulkUpdate($hash, $rdName, $transval); + + if (defined($state)) { + #execute state-command if defined + #must be placed after first reading, because it may have a reference + my $deviceName = $name; #hack for being backward compatible - serve $name and $devname + my $cmdAttr = AttrVal($name, "stateCmd", undef); + + if ((defined($cmdAttr)) && ($cmdAttr ne q{})) { + my $newstate = KNX_eval ($hash, $gadName, $state, $cmdAttr); + if (defined($newstate) && ($newstate ne q{}) && ($newstate !~ m/ERROR/ix)) { + $state = $newstate; + Log3 ($name, 5, "KNX_SetReadings: $name - state replaced via stateCmd $cmdAttr - state: $state"); + } + else { + Log3 ($name, 3, "KNX_SetReadings: $name, gad: $gadName, error during stateCmd processing"); + } + } + + readingsBulkUpdate($hash, "state", $state); + } + readingsEndUpdate($hash, 1); + return; +} + +# delete all defptr entries for this device +# used in undefine & define (avoid defmod problem) 09-02-2021 +# calling param: $hash +# return param: none +sub KNX_delete_defptr { + my $hash = shift; + my $name = $hash->{NAME}; + + for my $gad (sort keys %{$modules{KNX}{defptr}}) { # get all gad for all KNX devices + my @olddefList = (); + @olddefList = @{$modules{KNX}{defptr}{$gad}} if (defined ($modules{KNX}{defptr}{$gad})); # get list of devices with this gad + my @newdefList = (); + foreach my $devHash (@olddefList) { + push (@newdefList, $devHash) if ($devHash != $hash); # remove previous definition for this device, but keep them for other devices! + } + #restore list if we have at least one entry left, or delete key! + if (scalar(@newdefList) == 0) { + delete $modules{KNX}{defptr}{$gad}; + } + else { + @{$modules{KNX}{defptr}{$gad}} = @newdefList; + } + } + return; +} + +# convert GAD from hex to readable version +sub KNX_hexToName { my $v = shift; - #old syntax - #my $p1 = hex(substr($v,0,1)); - #my $p2 = hex(substr($v,1,1)); - #my $p3 = hex(substr($v,2,2)); - - #new syntax for extended adressing + #new syntax - extended adressing my $p1 = hex(substr($v,0,2)); my $p2 = hex(substr($v,2,1)); my $p3 = hex(substr($v,3,2)); - + my $r = sprintf("%d/%d/%d", $p1,$p2,$p3); return $r; } -#Private function to convert GAD from readable version to hex -############################# -sub -KNX_nameToHex ($) -{ +# convert PHY from hex to readable version +sub KNX_hexToName2 { + my $v = KNX_hexToName(shift); + $v =~ s/\//\./gx; + return $v; +} + +# convert GAD from readable version to hex +sub KNX_nameToHex { my $v = shift; my $r = $v; - if($v =~ /^([0-9]{1,2})\/([0-9]{1,2})\/([0-9]{1,3})$/) - { - #old syntax - #$r = sprintf("%01x%01x%02x",$1,$2,$3); - #new syntax for extended adressing + if($v =~ /^([0-9]{1,2})\/([0-9]{1,2})\/([0-9]{1,3})$/x) { + #new syntax - extended adressing $r = sprintf("%02x%01x%02x",$1,$2,$3); } - #elsif($v =~ /^([0-9]{1,2})\.([0-9]{1,2})\.([0-9]{1,3})$/) - #{ - # $r = sprintf("%01x%01x%02x",$1,$2,$3); - #} - return $r; } -#Private function to clean input string according DPT -############################# -sub -KNX_checkAndClean ($$$) -{ +# clean input string according DPT +sub KNX_checkAndClean { my ($hash, $value, $gadName) = @_; my $name = $hash->{NAME}; my $orgValue = $value; - - Log3 ($name, 5, "check value: $value, gadName: $gadName"); - - #get model + + Log3 ($name, 5, "KNX_checkAndClean -enter: value= $value, gadName= $gadName"); + my $model = $hash->{GADDETAILS}{$gadName}{MODEL}; - + #return unchecked, if this is a autocreate-device return $value if ($model eq $modelErr); - - #get pattern + my $pattern = $dpttypes{$model}{PATTERN}; #trim whitespaces at the end - $value =~ s/^\s+|\s+$//gi; + $value =~ s/^\s+|\s+$//gix; + $value .= ':00' if ($model eq 'dpt10' && $value =~ /^[\d]{2}:[\d]{2}$/gix); # compatibility with widgetoverride :time #match against model pattern - my @tmp = ($value =~ m/$pattern/gi); +# my $pattern = qr/^($dpttypes{$model}{PATTERN})$/; +# ($value) = ($value =~ m/$pattern/ix); +# return $UNDEF if (!defined($value)); + + my @tmp = ($value =~ m/$pattern/gix); #loop through results my $found = 0; - foreach my $str (@tmp) - { + foreach my $str (@tmp) { #assign first match and exit loop - if (defined($str)) - { + if (defined($str)) { $found = 1; $value = $str; last; } } - - return undef if ($found == 0); - #get min - #my $min = $dpttypes{"$model"}{MIN}; - #if min is numeric, cast to min - #$value = $min if (defined ($min) and ($min =~ /^[+-]?\d*[.,]?\d+/) and ($value < $min)); + return $UNDEF if ($found == 0); - #get max - #my $max = $dpttypes{"$model"}{MAX}; - #if max is numeric, cast to max - #$value = $max if (defined ($max) and ($max =~ /^[+-]?\d*[.,]?\d+/) and ($value > $max)); - - $value = KNX_limit ($hash, $value, $gadName, undef); + $value = KNX_limit ($hash, $value, $gadName, undef); + + Log3 ($name, 3, "KNX_checkAndClean: value= $orgValue was casted to $value") if ($orgValue ne $value); + Log3 ($name, 5, "KNX_checkAndClean -exit: value= $value, gadName= $gadName, model= $model, pattern= $pattern"); - Log3 ($name, 3, "check value: input-value $orgValue was casted to $value") if (not($orgValue eq $value)); - Log3 ($name, 5, "check value: $value, gadName: $gadName, model: $model, pattern: $pattern"); - return $value; } - -#Private function to replace state-values -############################# -sub -KNX_replaceByRegex ($$$) { +# replace state-values Attribute: stateRegex +sub KNX_replaceByRegex { my ($regAttr, $prefix, $input) = @_; + + return $input if (! defined($regAttr)); + my $retVal = $input; #execute regex, if defined - if (defined($regAttr)) - { - #get array of given attributes - my @reg = split(" /", $regAttr); - - my $tempVal = $prefix . $input; - - #loop over all regex - foreach my $regex (@reg) - { - #trim leading and trailing slashes - $regex =~ s/^\/|\/$//gi; - #get pairs - my @regPair = split("\/", $regex); - - #skip if not at least 2 values supplied - #next if (int(@regPair < 2)); - next if (not defined($regPair[0])); - - if (not defined ($regPair[1])) - { - #cut value - $tempVal =~ s/$regPair[0]//gi; - } - else - { - #replace value - $tempVal =~ s/$regPair[0]/$regPair[1]/gi; - } - - #restore value - $retVal = $tempVal; + #get array of given attributes + my @reg = split(/\s\//x, $regAttr); + + $prefix .= q{:}; + my $tempVal = $prefix . $input; + + #loop over all regex + foreach my $regex (@reg) { + #trim leading and trailing slashes + $regex =~ s/^\/|\/$//gix; + #get pairs + my @regPair = split(/\//x, $regex); + + #skip if first part of regex not match readingName + next if ((not defined($regPair[0])) || ($regPair[0] eq q{}) || ($regPair[0] !~ /$prefix/ix)); + + if (not defined ($regPair[1])) { + #cut value + $tempVal = $UNDEF; } + else { + #replace value + $tempVal =~ s/$regPair[0]/$regPair[1]/gix; + } + + #restore value + $retVal = $tempVal; + last; } - return $retVal; } -#Private function to limit numeric values. Valid directions: encode, decode -############################# -sub -KNX_limit ($$$$) { +# limit numeric values. Valid directions: encode, decode +sub KNX_limit { my ($hash, $value, $gadName, $direction) = @_; - my $name = $hash->{NAME}; - my $model = $hash->{GADDETAILS}{$gadName}{MODEL}; + + #continue only if numeric value + return $value if (! looks_like_number ($value)); + return $value if (! defined($direction)); + + my $name = $hash->{NAME}; + my $model = $hash->{GADDETAILS}{$gadName}{MODEL}; my $retVal = $value; - + #get correction details my $factor = $dpttypes{$model}{FACTOR}; - my $offset = $dpttypes{$model}{OFFSET}; + my $offset = $dpttypes{$model}{OFFSET}; #get limits my $min = $dpttypes{$model}{MIN}; my $max = $dpttypes{$model}{MAX}; - #only execute, if nummeric value - if (looks_like_number ($value)) - { - #determine direction of scaling, do only if defined - if (defined ($direction)) - { - if ($direction =~ m/^encode/i) - { - #limitValue - $retVal = $min if (defined ($min) and ($retVal < $min)); - $retVal = $max if (defined ($max) and ($retVal > $max)); - - #correct value - $retVal /= $factor if (defined ($factor)); - $retVal -= $offset if (defined ($offset)); - } - elsif ($direction =~ m/^decode/i) - { - #correct value - $retVal += $offset if (defined ($offset)); - $retVal *= $factor if (defined ($factor)); - - #limitValue - $retVal = $min if (defined ($min) and ($retVal < $min)); - $retVal = $max if (defined ($max) and ($retVal > $max)); - } - - my $logString = "limit:"; - $logString .= " DIR: $direction" if (defined ($direction)); - $logString .= " FACTOR: $factor" if (defined ($factor)); - $logString .= " OFFSET: $factor" if (defined ($offset)); - $logString .= " MIN: $factor" if (defined ($min)); - $logString .= " MAX: $factor" if (defined ($max)); - Log3 ($name, 5, $logString); - Log3 ($name, 5, "limit: modified... Output: $retVal, Input: $value, Model: $model") if ($retVal != $value); - } + #determine direction of scaling, do only if defined + if ($direction =~ m/^encode/ix) { + #limitValue + $retVal = $min if (defined ($min) and ($retVal < $min)); + $retVal = $max if (defined ($max) and ($retVal > $max)); + + #correct value + $retVal /= $factor if (defined ($factor)); + $retVal -= $offset if (defined ($offset)); } - else - { - #Log3 ($name, 2, "limit: did not execute any action. Value should be numeric, but wasn't..."); + elsif ($direction =~ m/^decode/ix) { + #correct value + $retVal += $offset if (defined ($offset)); + $retVal *= $factor if (defined ($factor)); + + #limitValue + $retVal = $min if (defined ($min) and ($retVal < $min)); + $retVal = $max if (defined ($max) and ($retVal > $max)); } - + + my $logString = "DIR: $direction"; + $logString .= " FACTOR: $factor" if (defined ($factor)); + $logString .= " OFFSET: $offset" if (defined ($offset)); + $logString .= " MIN: $min" if (defined ($min)); + $logString .= " MAX: $max" if (defined ($max)); + Log3 ($name, 5, "KNX_limit: $gadName $logString"); + Log3 ($name, 4, "KNX_limit: $gadName modified... Output: $retVal, Input: $value, Model: $model") if ($retVal != $value); + return $retVal; } -#Private function to encode KNX-Message according DPT -############################# -sub -KNX_eval ($$$$) { +# process attributes stateCmd & putCmd +sub KNX_eval { my ($hash, $gadName, $state, $evalString) = @_; my $name = $hash->{NAME}; my $retVal = undef; - - Log3 ($name, 5, "Enter eval...name: $name, gadName: $gadName, evalString: \n$evalString\n"); - - $retVal = eval $evalString; - - Log3 ($name, 2, "set name: Eval error - $@") if $@; - Log3 ($name, 5, "Exit eval...result: $retVal"); + +#04.65 Log3 ($name, 5, "KNX_Eval-enter: $name, gadName: $gadName, evalString: $evalString"); + + my $code = EvalSpecials($evalString,("%hash" => $hash, '%name' => $name, '%gadName' => $gadName, '%state' => $state)); # prepare vars for AnalyzePerlCommand + $retVal = AnalyzePerlCommand(undef, $code); $retVal = "ERROR" if (not defined ($retVal)); - + + if ($retVal =~ /(^Forbidden|error)/ix) { # eval error or forbidden by Authorize + Log3 ($name, 2, "KNX_Eval-error: device= $name, gadName= $gadName, evalString= $evalString, result= $retVal"); #04.65 +#04.65 Log3 ($name, 2, "KNX_Eval-error: $retVal"); + $retVal = 'ERROR'; + } +#04.65 Log3 ($name, 5, "KNX_Eval-exit: result: $retVal"); return $retVal; } -#Private function to encode KNX-Message according DPT -############################# -sub -KNX_encodeByDpt ($$$) { +# encode KNX-Message according DPT +sub KNX_encodeByDpt { my ($hash, $value, $gadName) = @_; my $name = $hash->{NAME}; - - Log3 ($name, 5, "encode value: $value, gadName: $gadName"); - - #get model - my $model = $hash->{GADDETAILS}{$gadName}{MODEL}; + + my $model = $hash->{GADDETAILS}{$gadName}{MODEL}; my $code = $dpttypes{$model}{CODE}; - + #return unchecked, if this is a autocreate-device - return undef if ($model eq $modelErr); + return if ($model eq $modelErr); #this one stores the translated value (readble) my $numval = undef; #this one stores the translated hex-value my $hexval = undef; - - Log3 ($name, 5, "encode model: $model, code: $code, value: $value"); - + + Log3 ($name, 5, "KNX_encodeByDpt: $gadName model: $model, code: $code, value: $value"); + $value = KNX_limit ($hash, $value, $gadName, "ENCODE"); - + #Binary value - if ($code eq "dpt1") - { - $numval = "00" if ($value eq 0); - $numval = "01" if ($value eq 1); - $numval = "00" if ($value =~ m/off$/i); - $numval = "01" if ($value =~ m/on$/i); + if ($code eq "dpt1") { + $numval = "00" if ($value eq q{0}); + $numval = "01" if ($value eq q{1}); + $numval = "00" if ($value =~ m/off$/ix); + $numval = "01" if ($value =~ m/on$/ix); $numval = "00" if ($value eq $dpttypes{$model}{MIN}); $numval = "01" if ($value eq $dpttypes{$model}{MAX}); - + $hexval = $numval; } #Step value (two-bit) - elsif ($code eq "dpt2") - { - $numval = "00" if ($value =~ m/off/i); - $numval = "01" if ($value =~ m/on/i); - $numval = "02" if ($value =~ m/forceoff/i); - $numval = "03" if ($value =~ m/forceon/i); - - $hexval = $numval; - } + elsif ($code eq "dpt2") { + $numval = 0; # default + $numval = $value if ($value =~ m/^0?[0-3]$/ix); ## JoeALLb request + $numval = 0 if ($value =~ m/off/ix); + $numval = 1 if ($value =~ m/on/ix); + $numval = 2 if ($value =~ m/forceoff/i); + $numval = 3 if ($value =~ m/forceon/i); + + $hexval = sprintf("%.2x",$numval); + } #Step value (four-bit) - elsif ($code eq "dpt3") - { + elsif ($code eq "dpt3") { $numval = 0; - - #get dim-direction - my $sign = 0; - $sign = 1 if ($value >= 0); + my $sign = ($value >=0 )?1:0; + $value = abs($value); - #trim sign - $value =~ s/^-//g; - - #get dim-value - $numval = 7 if ($value >= 1); - $numval = 6 if ($value >= 3); - $numval = 5 if ($value >= 6); - $numval = 4 if ($value >= 12); - $numval = 3 if ($value >= 25); - $numval = 2 if ($value >= 50); - $numval = 1 if ($value >= 75); - - #assign dim direction + my @values = qw( 75 50 25 12 6 3 1 ); + my $i = 0; + foreach my $key (@values) { + $i++; + if ($value >= $key) { + $numval = $i; + last; + } + } $numval += 8 if ($sign == 1); - - #get hex representation $hexval = sprintf("%.2x",$numval); } #1-Octet unsigned value - elsif ($code eq "dpt5") - { + elsif ($code eq "dpt5") { $numval = $value; $hexval = sprintf("00%.2x",($numval)); } #1-Octet signed value - elsif ($code eq "dpt6") - { + elsif ($code eq "dpt6") { #build 2-complement - $numval = $value; - $numval += 0x100 if ($numval < 0); - $numval = 0x00 if ($numval < 0x00); - $numval = 0xFF if ($numval > 0xFF); - - #get hex representation + + $numval = unpack("C", pack("c", $value)); $hexval = sprintf("00%.2x",$numval); } #2-Octet unsigned Value - elsif ($code eq "dpt7") - { + elsif ($code eq "dpt7") { $numval = $value; - $hexval = sprintf("00%.4x",($numval)); + $hexval = sprintf("00%.4x",($numval)); } #2-Octet signed Value - elsif ($code eq "dpt8") - { + elsif ($code eq "dpt8") { #build 2-complement - $numval = $value; - $numval += 0x10000 if ($numval < 0); - $numval = 0x00 if ($numval < 0x00); - $numval = 0xFFFF if ($numval > 0xFFFF); - - #get hex representation - $hexval = sprintf("00%.4x",$numval); + + $numval = unpack("S", pack("s", $value)); + $hexval = sprintf("00%.4x",$numval); } #2-Octet Float value - elsif ($code eq "dpt9") - { + elsif ($code eq "dpt9") { my $sign = ($value <0 ? 0x8000 : 0); my $exp = 0; - my $mant = 0; - $mant = int($value * 100.0); - while (abs($mant) > 0x7FF) - { + my $mant = $value * 100; + while (abs($mant) > 0x07FF) { $mant /= 2; $exp++; } - $numval = $sign | ($exp << 11) | ($mant & 0x07ff); - - #get hex representation + $numval = $sign | ($exp << 11) | ($mant & 0x07FF); $hexval = sprintf("00%.4x",$numval); } #Time of Day - elsif ($code eq "dpt10") - { - if ($value =~ m/now/i) - { + elsif ($code eq "dpt10") { + if ($value =~ m/now/ix) { #get actual time my ($secs,$mins,$hours,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time); - my $hoffset; - + #add offsets $year+=1900; - $mon++; + $mon++; # calculate offset for weekday - $wday = 7 if ($wday eq "0"); - $hoffset = 32*$wday; - $hours += $hoffset; - + $wday = 7 if ($wday == 0); + $hours += 32 * $wday; + $value = "$hours:$mins:$secs"; - $numval = $secs + ($mins<<8) + ($hours<<16); - } else - { - my ($hh, $mm, $ss) = split (":", $value); - $numval = $ss + ($mm<<8) + (($hh)<<16); + $numval = $secs + ($mins << 8) + ($hours << 16); + } + else { + my ($hh, $mm, $ss) = split(/:/x, $value); + $numval = $ss + ($mm << 8) + ($hh << 16); } - - #get hex representation $hexval = sprintf("00%.6x",$numval); } #Date - elsif ($code eq "dpt11") - { - if ($value =~ m/now/i) - { + elsif ($code eq "dpt11") { + if ($value =~ m/now/ix) { #get actual time my ($secs,$mins,$hours,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time); - my $hoffset; - - #add offsets - $year+=1900; - $mon++; - # calculate offset for weekday - $wday = 7 if ($wday eq "0"); - - $value = "$mday.$mon.$year"; - $numval = ($year - 2000) + ($mon<<8) + ($mday<<16); - } else - { - my ($dd, $mm, $yyyy) = split (/\./, $value); - - if ($yyyy >= 2000) - { - $yyyy -= 2000; - } else - { - $yyyy -= 1900; - } - - $numval = ($yyyy) + ($mm<<8) + ($dd<<16); - } - - #get hex representation - $hexval = sprintf("00%.6x",$numval); - } - #4-Octet unsigned value (handled as dpt7) - elsif ($code eq "dpt12") - { - $numval = $value; - $hexval = sprintf("00%.8x",($numval)); - } - #4-Octet Signed Value - elsif ($code eq "dpt13") - { - #build 2-complement - $numval = $value; - $numval += 4294967296 if ($numval < 0); - $numval = 0x00 if ($numval < 0x00); - $numval = 0xFFFFFFFF if ($numval > 0xFFFFFFFF); - - #get hex representation - $hexval = sprintf("00%.8x",$numval); - } - #4-Octet single precision float - elsif ($code eq "dpt14") - { - $numval = unpack("L", pack("f", $value)); - - #get hex representation - $hexval = sprintf("00%.8x",$numval); - } - #14-Octet String - elsif ($code eq "dpt16") - { - #convert to latin-1 - $value = encode("iso-8859-1", decode("utf8", $value)); - - #convert to hex-string - my $dat = unpack "H*", $value; - #format for 14-byte-length - $dat = sprintf("%-028s",$dat); - #append leading zeros - $dat = "00" . $dat; - - $numval = $value; - $hexval = $dat; - } - #DateTime - elsif ($code eq "dpt19") - { - if ($value =~ m/now/i) - { - #get actual time - my ($secs,$mins,$hours,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time); - my $hoffset; - - #add offsets - #$year+=1900; - $mon++; - # calculate offset for weekday - $wday = 7 if ($wday eq "0"); - - $hexval = 0; - $hexval = sprintf ("00%.16x", (($secs<<16) + ($mins<<24) + ($hours<<32) + ($mday<<40) + ($mon<<48) + ($year<<56))); - - } else - { - my ($date, $time) = split ('_', $value); - my ($dd, $mm, $yyyy) = split (/\./, $date); - my ($hh, $mi, $ss) = split (':', $time); #add offsets - $yyyy -= 1900; # year is based on 1900 - my $wday = 0; - - $hexval = 0; - $hexval = sprintf ("00%.16x", (($ss<<16) + ($mi<<24) + ($hh<<32) + ($dd<<40) + ($mm<<48) + ($yyyy<<56))); + $year += 1900; + $mon++; + # calculate offset for weekday + $wday = 7 if ($wday eq "0"); + + $value = "$mday.$mon.$year"; + $numval = ($year - 2000) + ($mon << 8) + ($mday << 16); } + else { + my ($dd, $mm, $yyyy) = split (/\./x, $value); + if ($yyyy >= 2000) { + $yyyy -= 2000; + } + else { + $yyyy -= 1900; + } + $numval = ($yyyy) + ($mm << 8) + ($dd << 16); + } + $hexval = sprintf("00%.6x",$numval); + } + #4-Octet unsigned value + elsif ($code eq "dpt12") { + $numval = $value; + $hexval = sprintf("00%.8x",($numval)); + } + #4-Octet Signed Value + elsif ($code eq "dpt13") { + #build 2-complement + $numval = unpack("L", pack("l", $value)); + $hexval = sprintf("00%.8x",$numval); + } + #4-Octet single precision float + elsif ($code eq "dpt14") { + $numval = unpack("L", pack("f", $value)); + $hexval = sprintf("00%.8x",$numval); + } + #14-Octet String + elsif ($code eq "dpt16") { + #convert to latin-1 + $numval = encode("iso-8859-1", decode("utf8", $value)); + + #convert to hex-string + my $dat = unpack "H*", $numval; + + $dat = '00' if ($value =~ /^$PAT_DPT16_CLR/ix); # send all zero string if "clear line string" + + #format for 14-byte-length and replace trailing blanks with zeros + $hexval = sprintf("00%-28s",$dat); + $hexval =~ s/\s/0/gx; + } + #DateTime + elsif ($code eq "dpt19") { + my $ts = time; # default or when "now" is given + # if no match we assume now and use current date/time + $ts = fhemTimeLocal($6, $5, $4, $1, $2-1, $3 - 1900) if ($value =~ m/^$PAT_DATE$PAT_DTSEP$PAT_TIME/x); + my ($secs,$mins,$hours,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($ts); + $wday = 7 if ($wday eq "0"); # calculate offset for weekday + $hours += ($wday << 5); # add day of week + my $status1 = 0x20; # Fault=0, WD = 0, NWD = 1 (WD Field valid), NY = 0, ND = 0, NDOW= 0,NT=0, SUTI = 0 + $status1 += 1 if ($isdst == 1); + my $status0 = 0x00; # CLQ=0 + $mon++; $numval = 0; - } + $hexval = sprintf("00%02x%02x%02x%02x%02x%02x%02x%02x",$year,$mon,$mday,$hours,$mins,$secs,$status1,$status0); + } + # HVAC 1Byte + elsif ($code eq "dpt20") { + $numval = "00" if ($value =~ m/Auto/ix); + $numval = "01" if ($value =~ m/Comfort/ix); + $numval = "02" if ($value =~ m/Standby/ix); + $numval = "03" if ($value =~ m/Economy/ix); + $numval = "04" if ($value =~ m/Protection/ix); + $hexval = sprintf("00%.2x",($numval)); + } #RGB-Code - elsif ($code eq "dpt232") - { + elsif ($code eq "dpt232") { $hexval = "00" . $value; $numval = $value; } - else - { - Log3 ($name, 2, "encode model: $model, no valid model defined"); - return undef; + else { + Log3 ($name, 2, "KNX_encodeByDpt: $gadName, model: $model not valid"); + return $UNDEF; } - - Log3 ($name, 5, "encode model: $model, code: $code, value: $value, numval: $numval, hexval: $hexval"); + + Log3 ($name, 5, "KNX_encodeByDpt -exit: model: $model, code: $code, value: $value, numval: $numval, hexval: $hexval"); return $hexval; } -#Private function to decode KNX-Message according DPT -############################# -sub -KNX_decodeByDpt ($$$) { +# decode KNX-Message according DPT +sub KNX_decodeByDpt { my ($hash, $value, $gadName) = @_; my $name = $hash->{NAME}; - - Log3 ($name, 5, "decode value: $value, gadName: $gadName"); - + #get model my $model = $hash->{GADDETAILS}{$gadName}{MODEL}; my $code = $dpttypes{$model}{CODE}; - + #return unchecked, if this is a autocreate-device - return undef if ($model eq $modelErr); + return if ($model eq $modelErr); #this one stores the translated value (readble) my $numval = undef; #this one contains the return-value my $state = undef; - - Log3 ($name, 5, "decode model: $model, code: $code, value: $value"); - + + Log3 ($name, 5, "KNX_decodeByDpt -enter: model: $model, code: $code, value: $value"); + my $min = $dpttypes{"$model"}{MIN}; my $max = $dpttypes{"$model"}{MAX}; - + #Binary value - if ($code eq "dpt1") - { - $numval = $min if ($value =~ m/00/i); - $numval = $max if ($value =~ m/01/i); + if ($code eq "dpt1") { + $numval = $min; + $numval = $max if ($value =~ m/01/ix); $state = $numval; } #Step value (two-bit) - elsif ($code eq "dpt2") - { - #get numeric value + elsif ($code eq "dpt2") { $numval = hex ($value); - $state = "off" if ($numval == 0); - $state = "on" if ($numval == 1); - $state = "forceOff" if ($numval == 2); - $state = "forceOn" if ($numval == 3); - } - #Step value (four-bit) - elsif ($code eq "dpt3") - { - #get numeric value - $numval = hex ($value); - - #get dim-direction - my $sign = 1; - if ($numval >= 8) - { - $sign = 0; - $numval -= 8; + if ($model eq 'dpt2.000') { ## JoeALLb request + $state = $numval; } + else { + $state = "off" if ($numval == 0); + $state = "on" if ($numval == 1); + $state = "forceOff" if ($numval == 2); + $state = "forceOn" if ($numval == 3); + } + } + #Step value (four-bit) + elsif ($code eq "dpt3") { + $numval = hex ($value); - $state = 100 if ($numval >= 1); - $state = 50 if ($numval >= 2); - $state = 25 if ($numval >= 3); - $state = 12 if ($numval >= 4); - $state = 6 if ($numval >= 5); - $state = 3 if ($numval >= 6); - $state = 1 if ($numval >= 7); - - $state = 0 - $state if ($sign == 1); - - $state = sprintf ("%.0f", $state); + my $dir = ($numval & 0x08) >> 3; + my $step = ($numval & 0x07); + my $stepcode = 0; + if ($step > 0) { + $stepcode = int(100 / (2**($step-1))); + $stepcode *= -1 if ($dir == 0); + } + $state = sprintf ("%.0f", $stepcode); } #1-Octet unsigned value - elsif ($code eq "dpt5") - { + elsif ($code eq "dpt5") { $numval = hex ($value); $state = KNX_limit ($hash, $numval, $gadName, "DECODE"); $state = sprintf ("%.0f", $state); } #1-Octet signed value - elsif ($code eq "dpt6") - { + elsif ($code eq "dpt6") { $numval = hex ($value); - $numval -= 0x100 if ($numval >= 0x80); - $state = KNX_limit ($hash, $numval, $gadName, "DECODE"); - - $state = sprintf ("%.0f", $state); + $numval = unpack("c",pack("C",$numval)); + $state = KNX_limit ($hash, $numval, $gadName, "DECODE"); + + $state = sprintf ("%d", $state); } #2-Octet unsigned Value - elsif ($code eq "dpt7") - { + elsif ($code eq "dpt7") { $numval = hex ($value); $state = KNX_limit ($hash, $numval, $gadName, "DECODE"); - - $state = sprintf ("%.0f", $state); + + $state = sprintf ("%.0f", $state); } #2-Octet signed Value - elsif ($code eq "dpt8") - { + elsif ($code eq "dpt8") { $numval = hex ($value); - $numval -= 0x10000 if ($numval >= 0x8000); + $numval = unpack("s",pack("S",$numval)); $state = KNX_limit ($hash, $numval, $gadName, "DECODE"); - - $state = sprintf ("%.0f", $state); + + $state = sprintf ("%d", $state); } #2-Octet Float value - elsif ($code eq "dpt9") - { + elsif ($code eq "dpt9") { $numval = hex($value); my $sign = 1; $sign = -1 if(($numval & 0x8000) > 0); @@ -1969,22 +1686,23 @@ KNX_decodeByDpt ($$$) { $numval = (1 << $exp) * 0.01 * $mant; $numval = KNX_limit ($hash, $numval, $gadName, "DECODE"); - + $state = sprintf ("%.2f","$numval"); } #Time of Day - elsif ($code eq "dpt10") - { + elsif ($code eq "dpt10") { $numval = hex($value); - my $hours = ($numval & 0x1F0000)>>16; - my $mins = ($numval & 0x3F00)>>8; + my $hours = ($numval & 0x1F0000) >> 16; + my $mins = ($numval & 0x3F00) >> 8; my $secs = ($numval & 0x3F); + my $wday = ($numval & 0xE00000) >> 21; + my @wdays = (q{},'Monday, ','Tuesday, ','Wednesday, ','Thursday, ','Friday, ','Saturday, ','Sunday, '); $state = sprintf("%02d:%02d:%02d",$hours,$mins,$secs); + # $state = sprintf("%s%02d:%02d:%02d",$wdays[$wday],$hours,$mins,$secs); # new option ? } #Date - elsif ($code eq "dpt11") - { + elsif ($code eq "dpt11") { $numval = hex($value); my $day = ($numval & 0x1F0000) >> 16; my $month = ($numval & 0x0F00) >> 8; @@ -1996,393 +1714,524 @@ KNX_decodeByDpt ($$$) { $state = sprintf("%02d.%02d.%04d",$day,$month,$year); } #4-Octet unsigned value (handled as dpt7) - elsif ($code eq "dpt12") - { + elsif ($code eq "dpt12") { $numval = hex ($value); $state = KNX_limit ($hash, $numval, $gadName, "DECODE"); - - $state = sprintf ("%.0f", $state); - } + + $state = sprintf ("%.0f", $state); + } #4-Octet Signed Value - elsif ($code eq "dpt13") - { + elsif ($code eq "dpt13") { $numval = hex ($value); - $numval -= 4294967296 if ($numval >= 0x80000000); + $numval = unpack("l",pack("L",$numval)); $state = KNX_limit ($hash, $numval, $gadName, "DECODE"); - - $state = sprintf ("%.0f", $state); - } + + $state = sprintf ("%d", $state); + } #4-Octet single precision float - elsif ($code eq "dpt14") - { + elsif ($code eq "dpt14") { $numval = unpack "f", pack "L", hex ($value); - $numval = KNX_limit ($hash, $numval, $gadName, "DECODE"); - + $numval = KNX_limit ($hash, $numval, $gadName, "DECODE"); + $state = sprintf ("%.3f","$numval"); - } + } #14-Octet String - elsif ($code eq "dpt16") - { + elsif ($code eq "dpt16") { $numval = 0; - $state = ""; - - for (my $i = 0; $i < 14; $i++) - { - my $c = hex(substr($value, $i * 2, 2)); - - #exit at string terminator, otherwise append current char - if (($i != 0) and ($c eq 0)) - { - $i = 14; - } - else - { - $state .= sprintf("%c", $c); - } - } + $state = q{}; + $value =~ s/\s*$//gx; # strip trailing blanks + + $state = pack("H*",$value); #convert to latin-1 - $state = encode ("utf8", $state) if ($model =~ m/16.001/); + $state = encode ("utf8", $state) if ($model =~ m/16.001/x); + + $state = q{} if ($state =~ m/^[\x00]/ix); # case all zeros received #remove non printable chars - $state =~ s/[\x00-\x1F]+//g; + $state =~ s/[\x00-\x1F]+//gx; } #DateTime - elsif ($code eq "dpt19") - { - $numval = $value; - my $time = hex (substr ($numval, 8, 6)); - my $date = hex (substr ($numval, 2, 6)); + elsif ($code eq "dpt19") { + $numval = substr($value,-16); # strip off 1st byte + my $time = hex (substr ($numval, 6, 6)); + my $date = hex (substr ($numval, 0, 6)); my $secs = ($time & 0x3F) >> 0; my $mins = ($time & 0x3F00) >> 8; my $hours = ($time & 0x1F0000) >> 16; - #my $day = ($date & 0x1F) >> 0; - #my $month = ($date & 0x0F00) >> 8; - #my $year = ($date & 0xFFFF0000) >> 16; - my $day = ($date & 0xFF) >> 0; - my $month = ($date & 0xFF00) >> 8; - my $year = ($date & 0xFF0000) >> 16; - + my $day = ($date & 0x1F) >> 0; + my $month = ($date & 0x0F00) >> 8; + my $year = ($date & 0xFF0000) >> 16; + #extras + my $wday = ($time & 0xE00000) >> 21; # 0 = anyday/not valid, 1= Monday,... + $year += 1900; - $state = sprintf("%02d.%02d.%04d_%02d:%02d:%02d", $day, $month, $year, $hours, $mins, $secs); + $state = sprintf("%02d.%02d.%04d_%02d:%02d:%02d", $day, $month, $year, $hours, $mins, $secs); + } + elsif ($code eq "dpt20") { + $numval = hex ($value); + $state = "Auto" if ($numval >=0); + $state = "Comfort" if ($numval >=1); + $state = "Standby" if ($numval >=2); + $state = "Economy/Night" if ($numval >=3); + $state = "Protection/Frost/Heat" if ($numval >=4); } #RGB-Code - elsif ($code eq "dpt232") - { + elsif ($code eq "dpt232") { $numval = hex ($value); - $state = $numval; - - $state = sprintf ("%.6x", $state); - } - else - { - Log3 ($name, 2, "decode model: $model, no valid model defined"); - return undef; + $state = sprintf ("%.6x",$numval); } - + else { + Log3 ($name, 2, "KNX_decodeByDpt: $model, no valid model defined"); + return; + } + #append unit, if supplied - my $unit = $dpttypes{$model}{UNIT}; - $state = $state . " " . $unit if (defined ($unit) and not($unit eq "")); - - Log3 ($name, 5, "decode model: $model, code: $code, value: $value, numval: $numval, state: $state"); + my $unit = $dpttypes{$model}{UNIT}; + $state = $state . q{ } . $unit if (defined ($unit) && ($unit ne q{})); + + Log3 ($name, 5, "KNX_decodeByDpt -exit: model: $model, code: $code, value: $value, numval: $numval, state: $state"); return $state; } 1; =pod + +=encoding utf8 + +=item [device] +=item summary Devices communicate via the IO-Device TUL or KNXTUL with KNX-bus +=item summary_DE Geräte kommunizieren über IO-Gerät TUL / mit dem KNX-Bus + =begin html -

+ +

KNX

+ +
+ =end html -=device -=item summary Communicates to KNX via module TUL + +=begin html_DE + + +

KNX

+ + +=end html_DE =cut