############################################## # $Id$ # ABU 20180218 restructuring, removed older documentation # ABU 20180317 setExtensions reingebaut, set funktion # ABU 20180319 repaired "reply"-function # ABU 20180319 tuned "reply"-function # ABU 20180322 switch context for put-cmd, minor fixes # ABU 20180328 fixed get-name containing "-" # ABU 20180408 Added attriut screening, implemented set/get/listenonly, prevent to identical GADS in one device # ABU 20180411 Added timer functions, prevented two identical GAD in one device # ABU 20180413 Fixed some naming issues in defined, made en-doku, removed DE-Doku # ABU 20180416 corrected timedev in doku # ABU 20180418 removed spam-log in "get"; replaced "$value" by "undef" in encode and decode function if model not defined # ABU 20180419 fixed Doku, added nosuffix, added dpt1.000 # ABU 20180426 minor fixes in answering bus-requests # ABU 20180509 Added dpt14.033 # ABU 20180519 Added dpt17.001, adjustet $PAT_GAD_OPTIONS with boundaries and whitespace # ABU 20180523 Added dpt7.007 # ABU 20180528 Patched dpt1 in dpt-list and encodyByDpt for being backward-compatible # ABU 20180604 Set dpt17-offset to "0", added examples # ABU 20180605 Added dpt18, tuned doku # ABU 20180605 Corrected dpt18 # ABU 20180605 Added example for autogenerated devices # ABU 20180605 Added workaround for STATE # ABU 20180606 Fixed dpt18, fixed offset-addition in decode (was "-" instead of "+"), fixed issue with slider # ABU 20180607 seperated limit and scale from encode/decode in order to avoid warnings and clean up # ABU 20180613 fixed scaling algo # ABU 20180613 fixed scaling algo part 2 # ABU 20180624 no set-option for listenoly- or get-devices, warning for illegal EVAL # 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 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 31/15/255 #pattern for group-no my $PAT_GNO = '[gG][1-9][0-9]?'; #pattern for GAD-Options 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 . 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=>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=>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=>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=>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=>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=>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=>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=>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=>q{}, FACTOR=>undef, OFFSET=>undef, PATTERN=>qr/($PAT_TIME|now)/ix, MIN=>undef, MAX=>undef}, # Date "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=>q{}, FACTOR=>1, OFFSET=>0, PATTERN=>qr/[+-]?\d{1,10}/ix, MIN=>0, MAX=>4294967295}, # 4-Octet Signed Value "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=>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=>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=>q{}, FACTOR=>1, OFFSET=>0, PATTERN=>qr/[+-]?\d{1,3}/ix, MIN=>0, MAX=>63}, # Scene, 1-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=>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=>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 ############################# #04.65 sub KNX_Initialize { sub Initialize { my $hash = shift // return; $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 = shift // return; my $def = shift; #enable newline within define with \ my @a = split(/[ \t\n]+/x, $def); #device name my $name = $a[0]; $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 '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 $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 foreach my $i (2 .. $#a) { my $gadCode = undef; my $gadOption = undef; my $gadNoSuffix = undef; Log3 ($name, 5, "KNX_define: $name, argCtr $i, string: $a[$i]"); #G-nr my $gadNo = $i - 1; 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/^$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))) { $tableHashRef={}; $hash->{GADTABLE}=$tableHashRef; } ###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; } 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 = q{:} . $dptDetails->{SETLIST}; } #case number - place slider 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 . q{,} . $interval . q{,} . $max; } #on/off/... elsif (defined ($dptDetails->{MIN})) { my $min = $dptDetails->{MIN}; my $max = $dptDetails->{MAX}; $setlist = q{:} . $min . q{,} . $max; } #plain input field else { $setlist = q{}; } Log3 ($name, 5, "define $name, Estimated reading-names: $rdNameGet, $rdNameSet, $rdNamePut"); Log3 ($name, 5, "define $name, SetList: $setlist") if (defined ($setlist)); #add details to hash $hash->{GADDETAILS}{$gadName} = {GROUP => $gad, CODE => $gadCode, MODEL => $gadModel, NO => $gadNo, OPTION => $gadOption, RDNAMEGET => $rdNameGet, RDNAMESET => $rdNameSet, RDNAMEPUT => $rdNamePut, SETLIST => $setlist}; #add key and value to GADTABLE $tableHashRef->{$gadCode} = $gadName; ###DEFPTR my @devList = (); #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); #restore list @{$modules{KNX}{defptr}{$gadCode}} = @devList; ###DEFPTR #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)) { 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 { # 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; $hash->{GETSTRING} = $getString; Log3 ($name, 5, "KNX_define: $name -GETSTR: " . $hash->{GETSTRING} . ", SETSTR: " . $hash->{SETSTRING}); } #backup name for a later rename $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 = shift; my $name = shift; Log3 ($name, 5, "KNX_undef -enter: $name"); #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, "KNX_undef -exit"); return $UNDEF; } #Places a "read" Message on the KNX-Bus #The answer is treated as regular telegram ############################# sub KNX_Get { my ($hash, @a) = @_; my $name = $hash->{NAME}; #FHEM asks with a ? at startup - no action, no log 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}; } #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 "KNX_Get: no valid address stored for gad: $gadName" if(!$groupc); #exit if get is prohibited 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, "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 { my ($hash, @a) = @_; my $name = $hash->{NAME}; my $ret = q{}; my $na = scalar(@a); #identify this sub my @ca = caller(0); (my $thisSub = $ca[3]) =~ s/.+[:]+//gx; #FHEM asks with a "?" at startup or any reload of the device-detail-view #return string for enabling webfrontend to show boxes, ... 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 $cmd = undef; #check, if old or new syntax 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); } else { #oldsyntax (my $err, $targetGadName, $cmd) = KNX_Set_oldsyntax($hash,$targetGadName,@arg); ## process old syntax return $err if defined($err); } 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)); #get details my $groupCode = $hash->{GADDETAILS}{$targetGadName}{CODE}; 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 my $value = $cmd; #Text neads special treatment - additional args may be blanked words $value .= q{ } . join (q{ }, @arg) if (($model =~ m/^dpt16/ix) and (scalar (@arg) > 0)); #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); #if cast not successful return "$thisSub: invalid value= $value" if (!defined($transval)); #process set command my $transvale = KNX_encodeByDpt($hash, $transval, $targetGadName); IOWrite($hash, $TULid, 'w' . $groupCode . $transvale); Log3 ($name, 4, "$thisSub: $name, cmd= $cmd, value= $value, translated= $transvale"); # 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); Log3 ($name, 5, "$thisSub: -exit"); return $UNDEF; } # 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"); } } #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 { my ($hash, $time, $reading, $value) = @_; my $name = $hash->{NAME}; return if (not (defined($value))); return if (not (defined($reading))); #remove whitespaces $value =~ s/^\s+|\s+$//gix; $reading =~ s/^\s+|\s+$//gix; #workaround for STATE in capitol letters (caused by unknown external function) $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; } #Get the chance to qualify attributes ############################# sub KNX_Attr { my ($cmd,$name,$aName,$aVal) = @_; my $hash = $defs{$name}; 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, $device) = @_; my ($reading, $value, $unit); Log3 $device, 5, "KNX_DbLog_split -enter: device= $device event= $event"; #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; } else { $reading = 'state'; } #per default join all single pieces $value = join(q{ }, @strings); #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 $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 #new syntax for extended adressing my ($src,$cmd,$gadCode,$val) = $msg =~ m/^$TULid([0-9a-f]{5})([prw])([0-9a-f]{5})(.*)$/ix; my @foundMsgs; 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 gad my $gad = KNX_hexToName($gadCode); #create name 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}}; #process message for all affected devices and gad's foreach my $deviceHash (@deviceList) { #get details my $deviceName = $deviceHash->{NAME}; my $gadName = $deviceHash->{GADTABLE}{$gadCode}; 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]/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 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"); #apply post processing for state and set all readings KNX_SetReadings($deviceHash, $gadName, $transval, $getName, $src); } #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/x) { my $putVal = ReadingsVal($deviceName, $putName, undef); if ((defined($putVal)) && ($putVal ne q{})) { $value = $putVal; #medium priority, overwrite $value } else { $value = ReadingsVal($deviceName, 'state', undef); #lowest priority - use state } } #high priority - eval my $cmdAttr = AttrVal($deviceName, "putCmd", undef); if ((defined($cmdAttr)) && ($cmdAttr ne q{})) { $value = ReadingsVal($deviceName, 'state', undef); # get default value from state $value = KNX_eval ($deviceHash, $gadName, $value, $cmdAttr); 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)) { $transval = KNX_encodeByDpt($deviceHash, $value, $gadName); Log3 ($deviceName, 4, "KNX_Parse send answer (r): $deviceName, GET: $transval, READING: $gadName"); IOWrite ($deviceHash, $TULid, "p" . $gadCode . $transval); } } #/process message } Log3 ($ioName, 5, "KNX_parse -exit"); return @foundMsgs; } #Function is called at every notify ############################# 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}; my $events = deviceEvents($callHash, 1); if($callName eq "global") { foreach my $ev (@{$events}) { if ($ev =~ /^INITIALIZED|REREADCFG$/x) { # X_FunctionWhoNeedsAttr($hash); } } } return $UNDEF; } # ignore duplicate messages (runs in TUL /KNXTUL context!) ############################# 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; #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; } # 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})$/x) { #new syntax - extended adressing $r = sprintf("%02x%01x%02x",$1,$2,$3); } return $r; } # clean input string according DPT sub KNX_checkAndClean { my ($hash, $value, $gadName) = @_; my $name = $hash->{NAME}; my $orgValue = $value; 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); my $pattern = $dpttypes{$model}{PATTERN}; #trim whitespaces at the end $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 $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) { #assign first match and exit loop if (defined($str)) { $found = 1; $value = $str; last; } } return $UNDEF if ($found == 0); $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"); return $value; } # replace state-values Attribute: stateRegex sub KNX_replaceByRegex { my ($regAttr, $prefix, $input) = @_; return $input if (! defined($regAttr)); my $retVal = $input; #execute regex, if defined #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; } # limit numeric values. Valid directions: encode, decode sub KNX_limit { my ($hash, $value, $gadName, $direction) = @_; #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}; #get limits my $min = $dpttypes{$model}{MIN}; my $max = $dpttypes{$model}{MAX}; #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)); } 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; } # process attributes stateCmd & putCmd sub KNX_eval { my ($hash, $gadName, $state, $evalString) = @_; my $name = $hash->{NAME}; my $retVal = undef; #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; } # encode KNX-Message according DPT sub KNX_encodeByDpt { my ($hash, $value, $gadName) = @_; my $name = $hash->{NAME}; my $model = $hash->{GADDETAILS}{$gadName}{MODEL}; my $code = $dpttypes{$model}{CODE}; #return unchecked, if this is a autocreate-device 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, "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 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 = 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") { $numval = 0; my $sign = ($value >=0 )?1:0; $value = abs($value); 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); $hexval = sprintf("%.2x",$numval); } #1-Octet unsigned value elsif ($code eq "dpt5") { $numval = $value; $hexval = sprintf("00%.2x",($numval)); } #1-Octet signed value elsif ($code eq "dpt6") { #build 2-complement $numval = unpack("C", pack("c", $value)); $hexval = sprintf("00%.2x",$numval); } #2-Octet unsigned Value elsif ($code eq "dpt7") { $numval = $value; $hexval = sprintf("00%.4x",($numval)); } #2-Octet signed Value elsif ($code eq "dpt8") { #build 2-complement $numval = unpack("S", pack("s", $value)); $hexval = sprintf("00%.4x",$numval); } #2-Octet Float value elsif ($code eq "dpt9") { my $sign = ($value <0 ? 0x8000 : 0); my $exp = 0; my $mant = $value * 100; while (abs($mant) > 0x07FF) { $mant /= 2; $exp++; } $numval = $sign | ($exp << 11) | ($mant & 0x07FF); $hexval = sprintf("00%.4x",$numval); } #Time of Day elsif ($code eq "dpt10") { if ($value =~ m/now/ix) { #get actual time my ($secs,$mins,$hours,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time); #add offsets $year+=1900; $mon++; # calculate offset for weekday $wday = 7 if ($wday == 0); $hours += 32 * $wday; $value = "$hours:$mins:$secs"; $numval = $secs + ($mins << 8) + ($hours << 16); } else { my ($hh, $mm, $ss) = split(/:/x, $value); $numval = $ss + ($mm << 8) + ($hh << 16); } $hexval = sprintf("00%.6x",$numval); } #Date elsif ($code eq "dpt11") { if ($value =~ m/now/ix) { #get actual time my ($secs,$mins,$hours,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time); #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 (/\./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") { $hexval = "00" . $value; $numval = $value; } else { Log3 ($name, 2, "KNX_encodeByDpt: $gadName, model: $model not valid"); return $UNDEF; } Log3 ($name, 5, "KNX_encodeByDpt -exit: model: $model, code: $code, value: $value, numval: $numval, hexval: $hexval"); return $hexval; } # decode KNX-Message according DPT sub KNX_decodeByDpt { my ($hash, $value, $gadName) = @_; my $name = $hash->{NAME}; #get model my $model = $hash->{GADDETAILS}{$gadName}{MODEL}; my $code = $dpttypes{$model}{CODE}; #return unchecked, if this is a autocreate-device 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, "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; $numval = $max if ($value =~ m/01/ix); $state = $numval; } #Step value (two-bit) elsif ($code eq "dpt2") { $numval = hex ($value); 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); 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") { $numval = hex ($value); $state = KNX_limit ($hash, $numval, $gadName, "DECODE"); $state = sprintf ("%.0f", $state); } #1-Octet signed value elsif ($code eq "dpt6") { $numval = hex ($value); $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") { $numval = hex ($value); $state = KNX_limit ($hash, $numval, $gadName, "DECODE"); $state = sprintf ("%.0f", $state); } #2-Octet signed Value elsif ($code eq "dpt8") { $numval = hex ($value); $numval = unpack("s",pack("S",$numval)); $state = KNX_limit ($hash, $numval, $gadName, "DECODE"); $state = sprintf ("%d", $state); } #2-Octet Float value elsif ($code eq "dpt9") { $numval = hex($value); my $sign = 1; $sign = -1 if(($numval & 0x8000) > 0); my $exp = ($numval & 0x7800) >> 11; my $mant = ($numval & 0x07FF); $mant = -(~($mant-1) & 0x07FF) if($sign == -1); $numval = (1 << $exp) * 0.01 * $mant; $numval = KNX_limit ($hash, $numval, $gadName, "DECODE"); $state = sprintf ("%.2f","$numval"); } #Time of Day elsif ($code eq "dpt10") { $numval = hex($value); 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") { $numval = hex($value); my $day = ($numval & 0x1F0000) >> 16; my $month = ($numval & 0x0F00) >> 8; my $year = ($numval & 0x7F); #translate year (21st cent if <90 / else 20th century) $year += 1900 if($year >= 90); $year += 2000 if($year < 90); $state = sprintf("%02d.%02d.%04d",$day,$month,$year); } #4-Octet unsigned value (handled as dpt7) elsif ($code eq "dpt12") { $numval = hex ($value); $state = KNX_limit ($hash, $numval, $gadName, "DECODE"); $state = sprintf ("%.0f", $state); } #4-Octet Signed Value elsif ($code eq "dpt13") { $numval = hex ($value); $numval = unpack("l",pack("L",$numval)); $state = KNX_limit ($hash, $numval, $gadName, "DECODE"); $state = sprintf ("%d", $state); } #4-Octet single precision float elsif ($code eq "dpt14") { $numval = unpack "f", pack "L", hex ($value); $numval = KNX_limit ($hash, $numval, $gadName, "DECODE"); $state = sprintf ("%.3f","$numval"); } #14-Octet String elsif ($code eq "dpt16") { $numval = 0; $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/x); $state = q{} if ($state =~ m/^[\x00]/ix); # case all zeros received #remove non printable chars $state =~ s/[\x00-\x1F]+//gx; } #DateTime 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 & 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); } 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") { $numval = hex ($value); $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 . 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 =begin html_DE

KNX

=end html_DE =cut