98_Modbus.pm 119 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502250325042505250625072508250925102511251225132514251525162517251825192520252125222523252425252526252725282529253025312532253325342535253625372538253925402541254225432544254525462547254825492550255125522553255425552556255725582559256025612562256325642565256625672568256925702571257225732574257525762577257825792580258125822583258425852586258725882589259025912592259325942595259625972598259926002601260226032604260526062607260826092610261126122613261426152616261726182619262026212622262326242625262626272628262926302631263226332634263526362637263826392640264126422643264426452646264726482649265026512652265326542655265626572658265926602661266226632664266526662667266826692670267126722673267426752676267726782679268026812682268326842685268626872688268926902691269226932694269526962697269826992700270127022703270427052706270727082709271027112712271327142715271627172718271927202721272227232724272527262727272827292730273127322733273427352736273727382739274027412742274327442745274627472748274927502751275227532754275527562757275827592760276127622763276427652766276727682769277027712772277327742775277627772778277927802781278227832784278527862787278827892790279127922793279427952796279727982799280028012802280328042805280628072808280928102811281228132814281528162817281828192820282128222823282428252826282728282829283028312832283328342835283628372838283928402841284228432844284528462847284828492850285128522853285428552856285728582859286028612862286328642865286628672868286928702871287228732874287528762877
  1. ##############################################################################
  2. # $Id: 98_Modbus.pm 15871 2018-01-13 16:24:22Z StefanStrobel $
  3. #
  4. # fhem Modul für Geräte mit Modbus-Interface -
  5. # Basis für logische Geräte-Module wie zum Beispiel ModbusSET.pm
  6. #
  7. # This file is part of fhem.
  8. #
  9. # Fhem is free software: you can redistribute it and/or modify
  10. # it under the terms of the GNU General Public License as published by
  11. # the Free Software Foundation, either version 2 of the License, or
  12. # (at your option) any later version.
  13. #
  14. # Fhem is distributed in the hope that it will be useful,
  15. # but WITHOUT ANY WARRANTY; without even the implied warranty of
  16. # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  17. # GNU General Public License for more details.
  18. #
  19. # You should have received a copy of the GNU General Public License
  20. # along with fhem. If not, see <http://www.gnu.org/licenses/>.
  21. #
  22. ##############################################################################
  23. # Changelog:
  24. #
  25. # 2014-07-07 initial version
  26. # 2015-01-25 optimized many details, changed some function parameters, moved fCodeMap to the
  27. # logical device, changed the meaning of the type charaters in fCodeMap
  28. # (holding register is now h instead of r, discrete is d and input register is i)
  29. # added fcode 4
  30. # 2015-01-26 added fcode 16 for writing multiple registers at once (to be tested carefully!)
  31. # (if the device supports it and it is put it in the fcode Map at the client module)
  32. # added parseInfo key format, corrected the packing of data types
  33. # (now use the unpack code defined in the parseInfo hash)
  34. # 2015-01-27 defLen im Modul-hash des logischen Moduls als Default
  35. # 2015-01-31 changed the way GET and SET send data. Special handling s needed in case a read request has not been
  36. # answered by the device or in case the necessary delay are not over.
  37. # new deviceInfo structure for device specific settings replaces fCodeMap and other defaults
  38. # 2015-02-07 added clear text error codes, fixed wrong length in fcode 16, removed return code for successful set
  39. # 2015-02-11 added missing code to handle defUnpack when sending a write function code
  40. # 2015-02-16 support for defPoll und defShowGet in deviceInfo,
  41. # defaultpoll in parseInfo, defPoll in deviceInfo und das entsprechende Attribut können auch auf "once"
  42. # gesetzt werden
  43. # defaultpolldelay bzw. das Attribut kann mit x beginnen und ist dann Multiplikator des Intervalls
  44. # 2015-02-26 defaultpoll in poll und defaultpolldelay in polldelay umbenannt
  45. # attribute für timing umbenannt
  46. # 2015-03-8 added coils / discrete inputs
  47. #
  48. # 2015-04-13 Statistics for bus usage
  49. # 2015-05-15 fixed bugs in SetIODev
  50. # 2015-05-18 alternative statistics / profiling
  51. # fixed delays, to be taken from logical device - not physical
  52. # added missing dev-x-defExpr attribute to DevAttrList
  53. # 2015-07-05 added revRegs / defRevRegs attributes
  54. # 2015-07-17 added bswapRegs to reverse Byte-order on arbitrary length string (thanks to Marco)
  55. # 2015-07-22 added encode and decode
  56. # 2015-08-17 allow register 0, delete unused variable assignments
  57. # 2016-03-28 check if $po is valid before doing Win USB stuff in _Ready
  58. # 2016-04-07 added some logging, added tid checking
  59. # 2016-04-07 check if there is a good frame after one with wrong tid, add noArg for get - prevents wrong readings ...
  60. # 2016-06-14 new delay handling, new attrs on the physical device:
  61. # busDelay, clientSwitchDelay, dropQueueDoubles
  62. # new attrs on the logical device: alignTime, enableControlSet
  63. # 2016-06-30 use non blocking open, new attrs: nextOpenDelay, maxTimeoutsToReconnect, disable
  64. # 2016-08-13 textArg, fehler bei showGet, umstellung der Prüfungen bei Get und Set (controlSet, ?, ...)
  65. # open / reconnect handling komplett überarbeitet
  66. # 2016-08-20 textArg fehlte noch in der Liste der erlaubten Attribute
  67. # 2016-09-20 fixed bug in define when destination was undefined (introduced in preparation for Modbus ASCII)
  68. # 2016-10-02 first version with Modbus ASCII support, disable attribute closes Modbus connections over TCP
  69. # 2016-10-08 revRegs und bswapRegs in Send eingebaut, bugs bei revRegs / bswapRegs behoben
  70. # validate interval in define and set interval, restructured Opening of connections
  71. # 2016-11-17 fixed missing timer set in Notify when rereadcfg is seen,
  72. # accept Responses from different ID after a broadcast
  73. # 3.5.1 restructure set / send for unpack and revRegs / swapRegs
  74. # 2016-11-20 restructured parseFrames and its calls / returns
  75. # optimized logging, fixed bugs with RevRegs
  76. # 2016-11-26 first trial of new scanner
  77. # 2016-12-01 ID Scanner, fixes for disable (delete queue), Logging enhancements
  78. # 2016-12-04 remove Blanks in set if textArg is not set, Attribute dev-h-brokenFC3
  79. # fixed a bug when writing coils
  80. # 2016-12-10 more checks, more logging (include Version in Log of Send), added silentReconnect
  81. # 2016-12-17 fixed a bug when a modbus device was defined without path to a serial device
  82. # 2016-12-18 attribute to set log level for timeouts (timeoutLogLevel), openTimeout
  83. # 2016-12-21 fixed $ret in OpenDev
  84. # 2016-12-27 check for undefined $val in ParseObj and Log with timeoutLogLevel
  85. # 2016-12-28 removed RAWBUFFER and added some initiualisation for $ioHash->{helper}{buffer}, fixed logging for timeouts
  86. # 2017-01-02 new attribute allowShortResponses
  87. #
  88. # 2017-01-06 removed misleading log "destination device" at define when IODev Attr is not knon yet.
  89. # 2017-01-10 call Modbus_Statistics($ioHash, "Timeouts", 0); in EndBusy to keep Reading updated even if no timeout occured
  90. # 2017-01-11 allow reconnect also for serial (add getIOHash in controlSet reconnect) in preparation for a common open
  91. # 2017-01-14 fix timeoutLogLevel usage in ReadAnswer to use physical device attrs instaed of logical device attrs
  92. # use IsDisabled instead of AttrVal, restructure Open calls,
  93. # common NotifyFN for physical and logical devices
  94. # disable for physical devices will even close a serial interface
  95. # fix Module type checking for "Modbus" insted of "MODBUS"
  96. # skip garbage in frames
  97. # 2017-01-18 support for leading zeros in adresses in obj- attributes
  98. # 2017-01-22 check that skipGarbage is only defined for physical device attrs or TCP devices
  99. # parseframes now logs tid only for TCP where it makes sense
  100. # 2017-01-25 changed all expression evals to use a common function and catch warnings
  101. # new attribute ignoreExpr
  102. # 2017-02-11 optimize logging
  103. # 2017-03-12 fix disable for logical attribues (disable ist in PhysAttrs ...) - introduce more global vars for attributes
  104. # 2017-04-15 added some debug logging and explicit return 0 in checkDelays
  105. # 2017-04-21 optimize call to _send in GetUpdate, new attribute nonPrioritizedSet
  106. # remove unused variables for devInfo / parseInfo in ParseObj
  107. # 2017-05-08 better warning handler restore (see $oldSig)
  108. # 2017-07-15 new attribute sortUpdate to sort the requests by their object address
  109. # new attribute brokenFC5 for misbehaving devices that don't understand the normal ff00 to set a coil to 1
  110. # set this attr e.g. to 0100 if the device wants 0100 instead of ff00
  111. # 2017-07-18 started implementing data types (3.6.0)
  112. # 2017-07-25 set saveAsModule
  113. # 2017-08-17 nicer logging of timeouts
  114. # 2017-09-17 extended check for missing len attribute with unpack that expects > 16 bits
  115. # in _send
  116. # 2017-12-06 little fixes
  117. # 2017-12-22 remember timeout time in $hash instead of reading it from intAt
  118. # 2018-01-11 fix bug where defptr pointed to ioHash instead of logical hash when seting IODev Attr
  119. #
  120. # ToDo / Ideas :
  121. # get reading key (type / adr)
  122. # filterEcho (wie in private post im Forum vorgeschlagen)
  123. # set saveAsModule to save attr definitions as module
  124. # define data types VT_R4 -> revregs, len2, unpack f> ...
  125. # async output for scan? table? with revregs etc.?
  126. # get object-interpretations h123 -> Alle Variationen mit revregs und bswap und unpacks ...
  127. # nonblocking disable attr für xp
  128. #
  129. # attr with a lits of set commands / requests to launch when polling (Helios support)
  130. #
  131. # passive listening to other modbus traffic (state machine, parse requests of others in special queue
  132. #
  133. # set definition with multiple requests as raw containig opt. readings / input
  134. # map mit spaces wie bei HTTPMOD
  135. # :noArg etc. für Hintlist und userattr wie in HTTPMOD optimieren
  136. #
  137. # Autoconfigure? (Combine testweise erhöhen, Fingerprinting -> DB?, ...?)
  138. # Modbus Slave? separate module?
  139. # Modbus GW feature to translate TCP requests to serial RTU / ASCII requests in Fhem
  140. #
  141. #
  142. package main;
  143. use strict;
  144. use warnings;
  145. # return time as float, not just full seconds
  146. use Time::HiRes qw( gettimeofday tv_interval);
  147. use POSIX qw(strftime);
  148. use Encode qw(decode encode);
  149. sub Modbus_Initialize($);
  150. sub Modbus_Define($$);
  151. sub Modbus_Undef($$);
  152. sub Modbus_Read($);
  153. sub Modbus_Ready($);
  154. sub Modbus_ParseObj($$$;$$);
  155. sub Modbus_ParseFrames($);
  156. sub Modbus_HandleSendQueue($;$);
  157. sub Modbus_TimeoutSend($);
  158. sub Modbus_CRC($);
  159. sub ModbusLD_ObjInfo($$$;$$);
  160. # functions to be used from logical modules
  161. sub ModbusLD_ExpandParseInfo($);
  162. sub ModbusLD_Initialize($);
  163. sub ModbusLD_Define($$);
  164. sub ModbusLD_Undef($$);
  165. sub ModbusLD_Get($@);
  166. sub ModbusLD_Set($@);
  167. sub ModbusLD_ReadAnswer($;$);
  168. sub ModbusLD_GetUpdate($);
  169. sub ModbusLD_GetIOHash($);
  170. sub ModbusLD_Send($$$;$$$);
  171. my $Modbus_Version = '3.7.3 - 22.12.2017';
  172. my $Modbus_PhysAttrs =
  173. "queueDelay " .
  174. "busDelay " .
  175. "clientSwitchDelay " .
  176. "dropQueueDoubles:0,1 " .
  177. "profileInterval " .
  178. "openTimeout " .
  179. "nextOpenDelay " .
  180. "maxTimeoutsToReconnect " . # for Modbus over TCP/IP only
  181. "skipGarbage:0,1 " .
  182. "timeoutLogLevel:3,4 " .
  183. "silentReconnect:0,1 ";
  184. my $Modbus_LogAttrs =
  185. "queueMax " .
  186. "IODev " . # fhem.pl macht dann $hash->{IODev} = $defs{$ioname}
  187. "alignTime " .
  188. "enableControlSet:0,1 " .
  189. "nonPrioritizedSet:0,1 " .
  190. "sortUpdate:0,1 " .
  191. "scanDelay ";
  192. my $Modbus_CommonAttrs =
  193. "disable:0,1 ";
  194. my %Modbus_errCodes = (
  195. "01" => "illegal function",
  196. "02" => "illegal data address",
  197. "03" => "illegal data value",
  198. "04" => "slave device failure",
  199. "05" => "acknowledge",
  200. "06" => "slave device busy",
  201. "08" => "memory parity error",
  202. "0a" => "gateway path unavailable",
  203. "0b" => "gateway target failed to respond"
  204. );
  205. my %Modbus_defaultFCode = (
  206. "c" => {
  207. read => 1,
  208. write => 5,
  209. },
  210. "d" => {
  211. read => 2,
  212. },
  213. "i" => {
  214. read => 4,
  215. },
  216. "h" => {
  217. read => 3,
  218. write => 6,
  219. },
  220. );
  221. #####################################
  222. # _initialize für das physische Basismodul
  223. sub Modbus_Initialize($)
  224. {
  225. my ($modHash) = @_;
  226. require "$attr{global}{modpath}/FHEM/DevIo.pm";
  227. $modHash->{ReadFn} = "Modbus_Read";
  228. $modHash->{ReadyFn} = "Modbus_Ready";
  229. $modHash->{DefFn} = "Modbus_Define";
  230. $modHash->{UndefFn} = "Modbus_Undef";
  231. $modHash->{NotifyFn} = "Modbus_Notify";
  232. $modHash->{AttrFn} = "Modbus_Attr";
  233. $modHash->{AttrList} = "do_not_notify:1,0 " .
  234. $Modbus_PhysAttrs .
  235. $Modbus_CommonAttrs .
  236. $readingFnAttributes;
  237. return;
  238. }
  239. #####################################
  240. # Define für das physische serielle Basismodul
  241. # modbus id, Intervall etc. gibt es hier nicht
  242. # sondern im logischen Modul.
  243. #
  244. # entsprechend wird auch getUpdate im
  245. # logischen Modul aufgerufen.
  246. #
  247. # Modbus over TCP is opened in the logical open
  248. #
  249. sub Modbus_Define($$)
  250. {
  251. my ($ioHash, $def) = @_;
  252. my @a = split("[ \t]+", $def);
  253. my ($name, $type, $dev) = @a;
  254. return "wrong syntax: define <name> $type [tty-devicename|none]"
  255. if(@a < 1);
  256. DevIo_CloseDev($ioHash);
  257. $ioHash->{BUSY} = 0;
  258. $ioHash->{helper}{buffer} = ""; # clear Buffer for reception
  259. if(!$dev || $dev eq "none") {
  260. Log 1, "$name: device is none, commands will be echoed only";
  261. return undef;
  262. }
  263. $ioHash->{DeviceName} = $dev; # needed by DevIo to get Device, Port, Speed etc.
  264. $ioHash->{TIMEOUT} = AttrVal($name, "openTimeout", 3);
  265. #DevIo_OpenDev($ioHash, 0, 0); # will be opened later in NotifyFN
  266. delete $ioHash->{TIMEOUT};
  267. return;
  268. }
  269. #####################################
  270. # delete physical Device # todo: check other callback functions (undef, delete, shutdown)
  271. sub Modbus_Undef($$)
  272. {
  273. my ($ioHash, $arg) = @_;
  274. my $name = $ioHash->{NAME};
  275. DevIo_CloseDev($ioHash);
  276. RemoveInternalTimer ("timeout:$name");
  277. RemoveInternalTimer ("queue:$name");
  278. delete $ioHash->{nextTimeout};
  279. # lösche auch die Verweise aus logischen Modulen auf dieses physische.
  280. foreach my $d (values %{$ioHash->{defptr}}) {
  281. Log3 $name, 3, "$name: Undef is removing IO device for $d->{NAME}";
  282. delete $d->{IODev};
  283. RemoveInternalTimer ("update:$d->{NAME}");
  284. }
  285. return;
  286. }
  287. ########################################################
  288. # Notify for INITIALIZED -> Open defined logical device
  289. #
  290. # Bei jedem Define erzeugt Fhem.pl ein $hash{NTFY_ORDER} für das
  291. # Device falls im Modul eine NotifyFn gesetzt ist.
  292. #
  293. # bei jedem Define, Rename oder Modify wird der interne Hash %ntfyHash
  294. # gelöscht und beim nächsten Event in createNtfyHash() neu erzeugt
  295. # wenn er nicht existiert.
  296. #
  297. # Im %ntfyHash wird dann für jede mögliche Event-Quelle als Key auf die Liste
  298. # der Event-Empfänger verwiesen.
  299. #
  300. # die createNtfyHash() Funktion schaut für jedes Device nach $hash{NOTIFYDEV}
  301. # falls existent wird das Gerät nur für die in $hash{NOTIFYDEV} aufgelisteten
  302. # Event-Erzeuger in deren ntfyHash-Eintrag es Evet-Empfänger aufgenommen.
  303. #
  304. # Um ein Gerät als Event-Empfänger aus den Listen mit Event-Empfängern zu entfernen
  305. # könnte man $hash{NOTIFYDEV} auf "," setzen und %ntfyHash auf () löschen...
  306. #
  307. # im Modul die NotifyFn zu entfernen würde den Aufruf verhindern, aber
  308. # $hash{NTFY_ORDER} bleibt und daher erzeugt auch createNtfyHash() immer wieder verweise
  309. # auf das Gerät, obwohl die NotifyFn nicht mehr regisrtiert ist ...
  310. #
  311. #
  312. sub Modbus_Notify($$) # both for physical and logical devices
  313. {
  314. my ($hash, $source) = @_;
  315. my $name = $hash->{NAME}; # my Name
  316. my $sName = $source->{NAME}; # Name of Device that created the events
  317. return if($sName ne "global"); # only interested in global Events
  318. my $events = deviceEvents($source, 1);
  319. return if(!$events); # no events
  320. # Log3 $name, 5, "$name: Notify called for source $source->{NAME} with events: @{$events}";
  321. return if (!grep(m/^INITIALIZED|REREADCFG|(MODIFIED $name)$/, @{$events}));
  322. if (IsDisabled($name)) {
  323. Log3 $name, 3, "$name: Notify / Init: device is disabled";
  324. return;
  325. }
  326. if ($hash->{TYPE} eq "Modbus" || $hash->{DEST}) { # physical device or Modbus TCP -> open connection
  327. Log3 $name, 3, "$name: Notify / Init: opening connection";
  328. Modbus_Open($hash);
  329. } else { # logical device and not Modbus TCP -> check for IO Device
  330. my $ioHash = ModbusLD_GetIOHash($hash);
  331. my $ioName = $ioHash->{NAME};
  332. if ($ioName) {
  333. Log3 $name, 3, "$name: Notify / Init: using $ioName for communication";
  334. } else {
  335. Log3 $name, 3, "$name: Notify / Init: no IODev for communication";
  336. }
  337. }
  338. if ($hash->{TYPE} ne "Modbus") {
  339. ModbusLD_SetTimer($hash, 1); # logical device -> first Update in 1 second or aligned if interval is defined
  340. }
  341. return;
  342. }
  343. ################################################
  344. # Get Object Info from Attributes,
  345. # parseInfo Hash or default from deviceInfo Hash
  346. sub ModbusLD_ObjInfo($$$;$$) {
  347. my ($hash, $key, $oName, $defName, $lastDefault) = @_;
  348. # Device h123 unpack defUnpack
  349. my $name = $hash->{NAME};
  350. my $modHash = $modules{$hash->{TYPE}};
  351. my $parseInfo = $modHash->{parseInfo};
  352. my $reading = ($parseInfo->{$key} && $parseInfo->{$key}{reading} ?
  353. $parseInfo->{$key}{reading} : "");
  354. $reading = AttrVal($name, "obj-".$key."-reading", $reading);
  355. return (defined($lastDefault) ? $lastDefault : "") if (!$reading);
  356. if (defined($attr{$name})) {
  357. # check for explicit attribute for this object
  358. my $aName = "obj-".$key."-".$oName;
  359. return $attr{$name}{$aName}
  360. if (defined($attr{$name}{$aName}));
  361. if ($hash->{LeadingZeros}) {
  362. # attr for object with leading zeros in address detected
  363. if ($key =~ /([cdih])0*([0-9]+)/) {
  364. my $type = $1;
  365. my $adr = $2;
  366. while (length($adr) <= 5) {
  367. $aName = "obj-".$type.$adr."-".$oName;
  368. Log3 $name, 5, "$name: Check $aName";
  369. return $attr{$name}{$aName}
  370. if (defined($attr{$name}{$aName}));
  371. $adr = '0' . $adr;
  372. }
  373. }
  374. }
  375. # check for special case: attribute can be name of reading with prefix like poll-reading
  376. return $attr{$name}{$oName."-".$reading}
  377. if (defined($attr{$name}{$oName."-".$reading}));
  378. }
  379. # parseInfo for object $oName if special Fhem module using parseinfoHash
  380. return $parseInfo->{$key}{$oName}
  381. if (defined($parseInfo->{$key}) && defined($parseInfo->{$key}{$oName}));
  382. # check for type entry / attr ...
  383. if ($oName ne "type") {
  384. my $dType = ModbusLD_ObjInfo($hash, $key, 'type', 'noDefaultDevAttrForType', '***NoTypeInfo***');
  385. if ($dType ne '***NoTypeInfo***') {
  386. #Log3 $name, 5, "$name: ObjInfo for $key and $oName found type $dType";
  387. my $typeSpec = ModbusLD_DevInfo($hash, "type-$dType", $oName, '***NoTypeInfo***');
  388. if ($typeSpec ne '***NoTypeInfo***') {
  389. #Log3 $name, 5, "$name: $dType specifies $typeSpec for $oName";
  390. return $typeSpec;
  391. }
  392. }
  393. }
  394. # default for object type in deviceInfo / in attributes for device / type
  395. if ($defName) {
  396. my $type = substr($key, 0, 1);
  397. if (defined($attr{$name})) {
  398. # check for explicit attribute for this object type
  399. my $daName = "dev-".$type."-".$defName;
  400. return $attr{$name}{$daName}
  401. if (defined($attr{$name}{$daName}));
  402. # check for default attribute for all object types
  403. my $dadName = "dev-".$defName;
  404. return $attr{$name}{$dadName}
  405. if (defined($attr{$name}{$dadName}));
  406. }
  407. my $devInfo = $modHash->{deviceInfo};
  408. return $devInfo->{$type}{$defName}
  409. if (defined($devInfo->{$type}) && defined($devInfo->{$type}{$defName}));
  410. }
  411. return (defined($lastDefault) ? $lastDefault : "");
  412. }
  413. ################################################
  414. # Get Type Info from Attributes,
  415. # or deviceInfo Hash
  416. sub ModbusLD_DevInfo($$$;$) {
  417. my ($hash, $type, $oName, $lastDefault) = @_;
  418. # Device h read
  419. my $name = $hash->{NAME};
  420. my $modHash = $modules{$hash->{TYPE}};
  421. my $devInfo = $modHash->{deviceInfo};
  422. my $aName = "dev-".$type."-".$oName;
  423. my $adName = "dev-".$oName;
  424. if (defined($attr{$name})) {
  425. # explicit attribute for this object type
  426. return $attr{$name}{$aName}
  427. if (defined($attr{$name}{$aName}));
  428. # default attribute for all object types
  429. return $attr{$name}{$adName}
  430. if (defined($attr{$name}{$adName}));
  431. }
  432. # default for object type in deviceInfo
  433. return $devInfo->{$type}{$oName}
  434. if (defined($devInfo->{$type}) && defined($devInfo->{$type}{$oName}));
  435. return (defined($lastDefault) ? $lastDefault : "");
  436. }
  437. ##################################################
  438. # Get Type/Adr for a reading name from Attributes,
  439. # or parseInfo Hash
  440. sub ModbusLD_ObjKey($$) {
  441. my ($hash, $reading) = @_;
  442. my $name = $hash->{NAME};
  443. my $modHash = $modules{$hash->{TYPE}};
  444. my $parseInfo = $modHash->{parseInfo};
  445. foreach my $a (keys %{$attr{$name}}) {
  446. if ($a =~ /obj-([cdih][0-9]+)-reading/ && $attr{$name}{$a} eq $reading) {
  447. return $1;
  448. }
  449. }
  450. foreach my $k (keys %{$parseInfo}) {
  451. return $k if ($parseInfo->{$k}{reading} && ($parseInfo->{$k}{reading} eq $reading));
  452. }
  453. return "";
  454. }
  455. sub Modbus_CheckEval($$$$$) {
  456. my ($hash, $val, $expr, $context, $eName) = @_;
  457. # context e.g. "ParseObj", eName e.g. "ignoreExpr for $reading"
  458. my $name = $hash->{NAME};
  459. my $result;
  460. my $inCheckEval = 1;
  461. my $oldSig = ($SIG{__WARN__} ? $SIG{__WARN__} : 'DEFAULT');
  462. Log3 $name, 5, "$name: $context evaluates $eName, val=$val, expr $expr";
  463. $SIG{__WARN__} = sub { Log3 $name, 3, "$name: $context warning evaluating $eName, val=$val, expr $expr: @_"; };
  464. $result = eval($expr);
  465. $SIG{__WARN__} = $oldSig;
  466. if ($@) {
  467. Log3 $name, 3, "$name: $context error evaluating $eName, val=$val, expr=$expr: $@";
  468. } else {
  469. Log3 $name, 5, "$name: $context eval result is $result";
  470. }
  471. return $result;
  472. }
  473. #################################################
  474. # Parse holding / input register / coil Data
  475. # only called from parseframes
  476. # which is only called from read / readanswer
  477. #
  478. # with logical device hash, data string
  479. # and the object type/adr to start with
  480. sub Modbus_ParseObj($$$;$$) {
  481. my ($logHash, $data, $objCombi, $quantity, $op) = @_;
  482. my $name = $logHash->{NAME};
  483. my $type = substr($objCombi, 0, 1);
  484. my $startAdr = substr($objCombi, 1);
  485. my $lastAdr = ($quantity ? $startAdr + $quantity -1 : 0);
  486. my ($unpack, $format, $expr, $ignExpr, $map, $rest, $len, $encode, $decode);
  487. Log3 $name, 5, "$name: ParseObj called with " . unpack ("H*", $data) . " and start $startAdr" . ($quantity ? ", quantity $quantity" : "") . ($op ? ", op $op" : "");;
  488. if ($type =~ "[cd]") {
  489. # quantity is only used for coils / discrete inputs
  490. $quantity = 1 if (!$quantity);
  491. $rest = unpack ("b$quantity", $data); # convert binary data to bit string
  492. Log3 $name, 5, "$name: ParseObj shortened bit string: " . $rest . " and start adr $startAdr, quantity $quantity";
  493. } else {
  494. $rest = $data;
  495. }
  496. use bytes;
  497. readingsBeginUpdate($logHash);
  498. while (length($rest) > 0) {
  499. # einzelne Felder verarbeiten
  500. my $key = $type . $startAdr;
  501. my $reading = ModbusLD_ObjInfo($logHash, $key, "reading"); # "" if nothing specified
  502. if ($op =~ /scanid([0-9]+)/) { # scanning for Modbus ID
  503. $reading = "scanId-" . $1 . "-Response-$key";
  504. $logHash->{MODBUSID} = $1;
  505. Log3 $name, 3, "$name: ScanIds got reply from Id $1 - set internal MODBUSID to $1";
  506. } elsif ($op eq 'scanobj') { # scan Modbus objects
  507. if (!$reading) {
  508. my $fKey = $type . sprintf ("%06d", $startAdr);
  509. $reading = "scan-$fKey";
  510. CommandAttr(undef, "$name obj-${fKey}-reading $reading");
  511. }
  512. if ($type =~ "[hi]") {
  513. my $l = length($rest) / 2;
  514. $l = 1 if ($l < 1);
  515. CommandAttr(undef, "$name dev-h-defLen $l")
  516. if (AttrVal($name, "dev-h-defLen", "") ne "$l");
  517. CommandAttr(undef, "$name dev-h-defUnpack a" . $l*2)
  518. if (AttrVal($name, "dev-h-defUnpack", "") ne ('a'.$l*2));
  519. CommandAttr(undef, "$name dev-h-defExpr ModbusLD_ScanFormat(\$hash, \$val)")
  520. if (AttrVal($name, "dev-h-defExpr", "") ne "ModbusLD_ScanFormat(\$hash, \$val)");
  521. }
  522. }
  523. if ($reading) {
  524. if ($type =~ "[cd]") {
  525. $unpack = "a"; # for coils just take the next 0/1 from the string
  526. $len = 1; # one byte contains one bit from the 01001100 string unpacked above
  527. } else {
  528. $unpack = ModbusLD_ObjInfo($logHash, $key, "unpack", "defUnpack", "n");
  529. $len = ModbusLD_ObjInfo($logHash, $key, "len", "defLen", 1); # default to 1 Reg / 2 Bytes
  530. $encode = ModbusLD_ObjInfo($logHash, $key, "encode", "defEncode"); # character encoding
  531. $decode = ModbusLD_ObjInfo($logHash, $key, "decode", "defDecode"); # character decoding
  532. my $revRegs = ModbusLD_ObjInfo($logHash, $key, "revRegs", "defRevRegs"); # do not reverse register order by default
  533. my $swpRegs = ModbusLD_ObjInfo($logHash, $key, "bswapRegs", "defBswapRegs"); # dont reverse bytes in registers by default
  534. $rest = Modbus_RevRegs($logHash, $rest, $len) if ($revRegs && $len > 1);
  535. $rest = Modbus_SwpRegs($logHash, $rest, $len) if ($swpRegs);
  536. };
  537. $format = ModbusLD_ObjInfo($logHash, $key, "format", "defFormat"); # no format if nothing specified
  538. $expr = ModbusLD_ObjInfo($logHash, $key, "expr", "defExpr");
  539. $ignExpr = ModbusLD_ObjInfo($logHash, $key, "ignoreExpr", "defIgnoreExpr");
  540. $map = ModbusLD_ObjInfo($logHash, $key, "map", "defMap"); # no map if not specified
  541. Log3 $name, 5, "$name: ParseObj ObjInfo for $key: reading=$reading, unpack=$unpack, expr=$expr, format=$format, map=$map";
  542. my $val = unpack ($unpack, $rest); # verarbeite so viele register wie passend (ggf. über mehrere Register)
  543. if (!defined($val)) {
  544. my $logLvl = AttrVal($name, "timeoutLogLevel", 3);
  545. Log3 $name, $logLvl, "$name: ParseObj unpack of " . unpack ('H*', $rest) . " with $unpack for $reading resulted in undefined value";
  546. } else {
  547. Log3 $name, 5, "$name: ParseObj unpacked " . unpack ('H*', $rest) .
  548. " with $unpack to hex " . unpack ('H*', $val) .
  549. ($val =~ /[[:print:]]/ ? " ($val)" : ""); # check for printable characters
  550. $val = decode($decode, $val) if ($decode);
  551. $val = encode($encode, $val) if ($encode);
  552. # Exp zur Ignorieren der Werte?
  553. my $ignore;
  554. $ignore = Modbus_CheckEval($logHash, $val, $ignExpr, "ParseObj", "ignoreExpr for $reading") if ($ignExpr);
  555. # Exp zur Nachbearbeitung der Werte?
  556. $val = Modbus_CheckEval($logHash, $val, $expr, "ParseObj", "expr for $reading") if ($expr);
  557. # Map zur Nachbereitung der Werte?
  558. if ($map) {
  559. my %map = split (/[,: ]+/, $map);
  560. Log3 $name, 5, "$name: ParseObj for $reading maps value to $val with " . $map;
  561. $val = $map{$val} if ($map{$val});
  562. }
  563. # Format angegeben?
  564. if ($format) {
  565. Log3 $name, 5, "$name: ParseObj for $reading does sprintf with format " . $format .
  566. " value is $val";
  567. $val = sprintf($format, $val);
  568. Log3 $name, 5, "$name: ParseObj for $reading sprintf result is $val";
  569. }
  570. if ($ignore) {
  571. Log3 $name, 4, "$name: ParseObj for $reading ignores $val because of ignoreExpr. Reading not updated";
  572. } else {
  573. Log3 $name, 4, "$name: ParseObj for $reading assigns $val";
  574. readingsBulkUpdate($logHash, $reading, $val);
  575. $logHash->{gotReadings}{$reading} = $val;
  576. $logHash->{lastRead}{$key} = gettimeofday();
  577. }
  578. }
  579. } else {
  580. Log3 $name, 5, "$name: ParseObj has no information about parsing $key";
  581. $len = 1;
  582. }
  583. # gehe zum nächsten Wert
  584. if ($type =~ "[cd]") {
  585. $startAdr++;
  586. if (length($rest) > 1) {
  587. $rest = substr($rest, 1);
  588. } else {
  589. $rest = "";
  590. }
  591. last if ($lastAdr && $startAdr > $lastAdr);
  592. } else {
  593. $startAdr += $len;
  594. if (length($rest) > ($len*2)) {
  595. $rest = substr($rest, $len * 2); # take rest of rest starting at len*2 until the end
  596. } else {
  597. $rest = "";
  598. }
  599. }
  600. Log3 $name, 5, "$name: ParseObj moves to next object, skip $len to $type$startAdr" if ($rest);
  601. }
  602. readingsEndUpdate($logHash, 1);
  603. return;
  604. }
  605. #####################################
  606. sub Modbus_Statistics($$$)
  607. {
  608. my ($hash, $key, $value) = @_;
  609. my $name = $hash->{NAME};
  610. my $pInterval = AttrVal($name, "profileInterval", 0);
  611. return if (!$pInterval);
  612. my $now = gettimeofday();
  613. my $pPeriod = int($now / $pInterval);
  614. if (!defined ($hash->{statistics}{lastPeriod}) || ($pPeriod != $hash->{statistics}{lastPeriod})) {
  615. readingsBeginUpdate($hash);
  616. foreach my $k (keys %{$hash->{statistics}{sums}}) {
  617. readingsBulkUpdate($hash, "Statistics_" . $k, $hash->{statistics}{sums}{$k});
  618. $hash->{statistics}{sums}{$k} = 0;
  619. }
  620. readingsEndUpdate($hash, 1);
  621. $hash->{statistics}{sums}{$key} = $value;
  622. $hash->{statistics}{lastPeriod} = $pPeriod;
  623. } else {
  624. if ($hash->{statistics}{sums}{$key}) {
  625. $hash->{statistics}{sums}{$key} += $value;
  626. } else {
  627. $hash->{statistics}{sums}{$key} = $value;
  628. }
  629. }
  630. return;
  631. }
  632. #####################################
  633. sub Modbus_Profiler($$)
  634. {
  635. my ($hash, $key) = @_;
  636. my $name = $hash->{NAME};
  637. my $pInterval = AttrVal($name, "profileInterval", 0);
  638. return if (!$pInterval);
  639. my $now = gettimeofday();
  640. my $pPeriod = int($now / $pInterval);
  641. #my $micros = $now - (int ($now));
  642. #my ($seconds, $minute, $hour, @rest) = localtime ($now);
  643. # erster Aufruf? dann lastKey setzen und Startzeit merken, lastPeriod setzen
  644. if (!defined ($hash->{profiler}{lastKey})) {
  645. $hash->{profiler}{lastKey} = $key;
  646. $hash->{profiler}{lastPeriod} = $pPeriod;
  647. $hash->{profiler}{start}{$key} = $now;
  648. $hash->{profiler}{sums}{$key} = 0 ;
  649. Log3 $name, 5, "$name: Profiling: $key initialized, start $now";
  650. return;
  651. }
  652. # merke letzten Key - für diesen ist bisher die Zeit vergangen
  653. my $lKey = $hash->{profiler}{lastKey};
  654. # für den letzten Key: Diff seit Start
  655. my $lDiff = ($now - $hash->{profiler}{start}{$lKey});
  656. $lDiff = 0 if (!$hash->{profiler}{start}{$lKey});
  657. # für den neuen Key: wenn noch kein start, dann startet die Messung jetzt
  658. if (!$hash->{profiler}{start}{$key}) {
  659. $hash->{profiler}{start}{$key} = $now;
  660. }
  661. Log3 $name, 5, "$name: Profiling: $key, before $lKey, now is $now, $key started at "
  662. . $hash->{profiler}{start}{$key} . ", $lKey started at " . $hash->{profiler}{start}{$lKey};
  663. # neue Minute
  664. if ($pPeriod != $hash->{profiler}{lastPeriod}) {
  665. my $overP = $now - ($pPeriod * $pInterval); # time over the pPeriod start
  666. $overP = 0 if ($overP > $lDiff); # if interval was modified things get inconsistant ...
  667. Log3 $name, 5, "$name: Profiling: pPeriod changed, last pPeriod was " . $hash->{profiler}{lastPeriod} .
  668. " now $pPeriod, total diff for $lKey is $lDiff, over $overP over the pPeriod";
  669. Log3 $name, 5, "$name: Profiling: add " . ($lDiff - $overP) . " to sum for $key";
  670. $hash->{profiler}{sums}{$lKey} += ($lDiff - $overP);
  671. readingsBeginUpdate($hash);
  672. foreach my $k (keys %{$hash->{profiler}{sums}}) {
  673. my $val = sprintf("%.2f", $hash->{profiler}{sums}{$k});
  674. Log3 $name, 5, "$name: Profiling: set reading for $k to $val";
  675. readingsBulkUpdate($hash, "Profiler_" . $k . "_sum", $val);
  676. $hash->{profiler}{sums}{$k} = 0;
  677. $hash->{profiler}{start}{$k} = 0;
  678. }
  679. readingsEndUpdate($hash, 0);
  680. $hash->{profiler}{start}{$key} = $now;
  681. Log3 $name, 5, "$name: Profiling: set new sum for $lKey to $overP";
  682. $hash->{profiler}{sums}{$lKey} = $overP;
  683. $hash->{profiler}{lastPeriod} = $pPeriod;
  684. $hash->{profiler}{lastKey} = $key;
  685. } else {
  686. if ($key eq $hash->{profiler}{lastKey}) {
  687. # nothing new - take time when key or pPeriod changes
  688. return;
  689. }
  690. Log3 $name, 5, "$name: Profiling: add $lDiff to sum for $lKey " .
  691. "(now is $now, start for $lKey was $hash->{profiler}{start}{$lKey})";
  692. $hash->{profiler}{sums}{$lKey} += $lDiff;
  693. $hash->{profiler}{start}{$key} = $now;
  694. $hash->{profiler}{lastKey} = $key;
  695. }
  696. return;
  697. }
  698. #####################################
  699. # Called from the read and readanswer functions with hash
  700. # of device that is reading (phys / log depending on TCP / RTU
  701. # $ioHash->{REQUEST} holds request that was last sent
  702. # log hash is taken from last request
  703. # return: "text" is error, 0 is ignore, 1 is finished with success
  704. sub Modbus_ParseFrames($)
  705. {
  706. my $ioHash = shift; # hash of io device given to function
  707. my $name = $ioHash->{NAME}; # name of io device
  708. my $frame = $ioHash->{helper}{buffer}; # frame is in buffer in io hash
  709. my $logHash = $ioHash->{REQUEST}{DEVHASH}; # logical device hash is saved in io hash (or points back to self)
  710. my $type = $ioHash->{REQUEST}{TYPE};
  711. my $adr = $ioHash->{REQUEST}{ADR};
  712. my $reqLen = $ioHash->{REQUEST}{LEN};
  713. my $reqId = $ioHash->{REQUEST}{MODBUSID};
  714. my $proto = $ioHash->{REQUEST}{PROTOCOL};
  715. my $op = $ioHash->{REQUEST}{OPERATION};
  716. my ($null, $dlen, $devAdr, $pdu, $fCode, $data, $eCRC, $CRC);
  717. my $tid = 0;
  718. return "got data but did not send a request - ignoring" if (!$ioHash->{REQUEST} || !$proto);
  719. Log3 $name, 5, "$name: ParseFrames got: " . unpack ('H*', $frame);
  720. use bytes;
  721. if ($proto eq "RTU") {
  722. if (AttrVal($name, "skipGarbage", 0)) {
  723. my $start = index($frame, pack('C', $reqId));
  724. if ($start) {
  725. my $skip = substr($frame, 0, $start);
  726. $frame = substr($frame, $start);
  727. Log3 $name, 4, "$name: ParseFrames skipped $start bytes (" .
  728. unpack ('H*', $skip) . " from " . unpack ('H*', $frame) . ")";
  729. $ioHash->{helper}{buffer} = $frame;
  730. }
  731. }
  732. if ($frame =~ /(..)(.+)(..)/s) { # (id fCode) (data) (crc) /s means treat as single line ...
  733. ($devAdr, $fCode) = unpack ('CC', $1);
  734. $data = $2;
  735. $eCRC = unpack ('v', $3); # Header CRC - thats what we expect to calculate
  736. $CRC = Modbus_CRC($1.$2); # calculated CRC of data
  737. } else {
  738. return undef; # data still incomplete - continue reading
  739. }
  740. } elsif ($proto eq "ASCII") {
  741. if (AttrVal($name, "skipGarbage", 0)) {
  742. my $start = index($frame, ':');
  743. if ($start) {
  744. my $skip = substr($frame, 0, $start);
  745. $frame = substr($frame, $start);
  746. Log3 $name, 4, "$name: ParseFrames skipped $start bytes ($skip from $frame)";
  747. $ioHash->{helper}{buffer} = $frame;
  748. }
  749. }
  750. if ($frame =~ /:(..)(..)(.+)(..)\r\n/) {# : (id) (fCode) (data) (lrc) \r\n
  751. $devAdr = hex($1);
  752. $fCode = hex($2);
  753. $data = pack('H*', $3);
  754. $eCRC = hex($4); # Header CRC (LRC)
  755. $CRC = Modbus_LRC(pack('C', $devAdr) . pack ('C', $fCode) . $data); # calculate LRC of data
  756. } else {
  757. return undef; # data still incomplete - continue reading
  758. }
  759. } elsif ($proto eq "TCP") {
  760. $CRC = 0; $eCRC = 0; # for later check for all protocols (not needed for TCP)
  761. if (length($frame) < 8) {
  762. Log3 $name, 5, "$name: ParseFrames: length too small: " . length($frame);
  763. return undef;
  764. }
  765. ($tid, $null, $dlen, $devAdr, $pdu) = unpack ('nnnCa*', $frame);
  766. if ($ioHash->{REQUEST}{TID} != $tid) {
  767. Log3 $name, 5, "$name: ParseFrames: wrong tid ($tid), dlen=$dlen, id=$devAdr, rest=" . unpack ('H*', $pdu);
  768. # maybe old response after timeount, maybe rest after wrong frame is the one we're looking for
  769. $frame = substr($frame, $dlen + 6); # remove wrong frame
  770. Log3 $name, 5, "$name: ParseFrames: takes rest after frame: " . unpack ('H*', $frame);
  771. if (length($frame) < 8) {
  772. Log3 $name, 5, "$name: ParseFrames: length of rest is too small: " . length($frame);
  773. return undef;
  774. }
  775. ($tid, $null, $dlen, $devAdr, $pdu) = unpack ('nnnCa*', $frame);
  776. Log3 $name, 5, "$name: ParseFrames: unpacked rest as tid=$tid, dlen=$dlen, id=$devAdr, pdu=" . unpack ('H*', $pdu);
  777. if ($ioHash->{REQUEST}{TID} != $tid) {
  778. return ("got wrong tid ($tid)");
  779. }
  780. }
  781. if (length($pdu) + 1 < $dlen) {
  782. Log3 $name, 5, "$name: ParseFrames: Modbus TCP PDU too small (expect $dlen): " . (length($pdu) + 1);
  783. return undef;
  784. }
  785. ($fCode, $data) = unpack ('Ca*', $pdu);
  786. } else {
  787. Log3 $name, 3, "$name: ParseFrames: request structure contains unknown protocol $proto";
  788. }
  789. Log3 $name, 3, "$name: ParseFrames got a copy of the request sent before - looks like an echo!"
  790. if ($frame eq $ioHash->{REQUEST}{FRAME} && $fCode < 5);
  791. return "recieved frame from unexpected Modbus Id $devAdr, " .
  792. "expecting fc $ioHash->{REQUEST}{FCODE} from $reqId for device $logHash->{NAME}"
  793. if ($devAdr != $reqId && $reqId != 0);
  794. return "unexpected function code $fCode from $devAdr, ".
  795. "expecting fc $ioHash->{REQUEST}{FCODE} from $reqId for device $logHash->{NAME}"
  796. if ($ioHash->{REQUEST}{FCODE} != $fCode && $fCode < 128);
  797. #
  798. # frame received, now handle pdu data
  799. #
  800. $logHash->{helper}{lrecv} = gettimeofday(); # logical module side
  801. Modbus_Profiler($ioHash, "Fhem");
  802. delete $logHash->{gotReadings}; # will be filled by ParseObj later
  803. my $values = $data; # real value part of data (typically after a length byte) - will be overwritten
  804. my $actualLen = length ($data); # actually read length of data part (registers / coils / ...) for comparison
  805. my $headerLen = 4; # expected len for some fcodes, will be overwritten for others
  806. my $parseAdr = $adr; # default, can be overwritten if adr is contained in reply
  807. my $quantity = 0; # only used for coils / di and fcode 1 or 2. If 0 parseObj ignores it
  808. if ($fCode == 1 || $fCode == 2) { # read coils / discrete inputs, pdu: bytes, coils
  809. ($headerLen, $values) = unpack ('Ca*', $data);
  810. $actualLen = length ($values);
  811. $quantity = $reqLen; # num of coils
  812. } elsif ($fCode == 3 || $fCode == 4) { # read holding/input registers, pdu: bytes, registers
  813. ($headerLen, $values) = unpack ('Ca*', $data);
  814. if (ModbusLD_DevInfo($logHash, "h", "brokenFC3", 0)) {
  815. Log3 $name, 5, "$name: ParseFrames uses fix for broken fcode 3";
  816. ($parseAdr, $values) = unpack ('na*', $data);
  817. $headerLen = 4;
  818. }
  819. $actualLen = length ($values);
  820. } elsif ($fCode == 5) { # write single coil, pdu: adr, coil (FF00)
  821. ($parseAdr, $values) = unpack ('nH4', $data);
  822. if (ModbusLD_DevInfo($logHash, "c", "brokenFC5", 0)) {
  823. Log3 $name, 5, "$name: ParseFrames uses fix for broken fcode 5";
  824. $values = ($values eq "0000" ? 0 : 1);
  825. } else {
  826. $values = ($values eq "ff00" ? 1 : 0);
  827. }
  828. $quantity = 1;
  829. # length of $data should be 4
  830. } elsif ($fCode == 6) { # write single (holding) register, pdu: adr, register
  831. ($parseAdr, $values) = unpack ('na*', $data);
  832. # length of $data should be 4
  833. } elsif ($fCode == 15 || $fCode == 16) { # write mult coils/hold. regis, pdu: adr, quantity
  834. ($parseAdr, $quantity) = unpack ('nn', $data);
  835. # quantity is only used for coils -> ignored for fcode 16 later
  836. # length of $data should be 4
  837. } elsif ($fCode < 128) { # other function code
  838. Log3 $name, 3, "$name: ParseFrames: function code $fCode not implemented";
  839. return "function code $fCode not implemented";
  840. }
  841. if ($fCode >= 128) { # error
  842. my $hexdata = unpack ("H2", $data);
  843. my $hexFCode = unpack ("H*", pack("C", $fCode));
  844. my $errCode = $Modbus_errCodes{$hexdata};
  845. Log3 $name, 4, "$name: ParseFrames got error code $hexFCode / $hexdata" .
  846. ($errCode ? ", $errCode" : "");
  847. return "device replied with exception code $hexFCode / $hexdata" . ($errCode ? ", $errCode" : "");
  848. } else {
  849. if ($headerLen > $actualLen) {
  850. if ($eCRC != $CRC) {
  851. Log3 $name, 5, "$name: ParseFrames: wait for more data ($actualLen / $headerLen)";
  852. return undef;
  853. } elsif (!ModbusLD_DevInfo($logHash, $type, "allowShortResponses", 0)) {
  854. Log3 $name, 5, "$name: ParseFrames: wait for more data ($actualLen / $headerLen)";
  855. return undef;
  856. }
  857. Log3 $name, 5, "$name: ParseFrames: frame seems incomplete ($actualLen / $headerLen) but checksum is fine and allowShortResponses is set ...";
  858. }
  859. return "ParseFrames got wrong Checksum (expect $eCRC, got $CRC)" if ($eCRC != $CRC);
  860. Log3 $name, 4, "$name: ParseFrames got fcode $fCode from $devAdr" .
  861. ($proto eq "TCP" ? ", tid $tid" : "") .
  862. ", values " . unpack ('H*', $values) . "HeaderLen $headerLen, ActualLen $actualLen" .
  863. ", request was for $type$adr ($ioHash->{REQUEST}{READING})".
  864. ", len $reqLen for module $logHash->{NAME}";
  865. if ($fCode < 15) {
  866. # nothing to parse after reply to 15 / 16
  867. Modbus_ParseObj($logHash, $values, $type.$parseAdr, $quantity, $op);
  868. Log3 $name, 5, "$name: ParseFrames got " . scalar keys (%{$logHash->{gotReadings}}) . " readings from ParseObj";
  869. } else {
  870. Log3 $name, 5, "$name: reply to fcode 15 and 16 does not contain values";
  871. }
  872. return 1;
  873. }
  874. return;
  875. }
  876. #####################################
  877. # End of BUSY
  878. # called with physical device hash
  879. sub Modbus_EndBUSY($)
  880. {
  881. my $hash = shift;
  882. my $name = $hash->{NAME};
  883. $hash->{helper}{buffer} = "";
  884. $hash->{BUSY} = 0;
  885. delete $hash->{REQUEST};
  886. delete $hash->{nextTimeout};
  887. Modbus_Profiler($hash, "Idle");
  888. Modbus_Statistics($hash, "Timeouts", 0); # damit bei Bedarf das Reading gesetzt wird
  889. RemoveInternalTimer ("timeout:$name");
  890. return;
  891. }
  892. #####################################
  893. # Called from the global loop, when the select for hash->{FD} reports data
  894. # hash is hash of the physical device ( = logical device for TCP)
  895. sub Modbus_Read($)
  896. {
  897. # physical layer function - read to common physical buffers ...
  898. my $hash = shift;
  899. my $name = $hash->{NAME};
  900. my $buf = DevIo_SimpleRead($hash);
  901. return if(!defined($buf));
  902. my $now = gettimeofday();
  903. Modbus_Profiler($hash, "Read");
  904. Log3 $name, 5, "$name: raw read: " . unpack ('H*', $buf);
  905. $hash->{helper}{buffer} .= $buf;
  906. $hash->{helper}{lrecv} = $now; # physical side
  907. my $code = Modbus_ParseFrames($hash);
  908. if ($code) {
  909. if ($code ne "1") {
  910. Log3 $name, 5, "$name: ParseFrames returned error: $code"
  911. }
  912. delete $hash->{TIMEOUTS};
  913. Modbus_EndBUSY ($hash); # set BUSY to 0, delete REQUEST, clear Buffer, do Profilig
  914. RemoveInternalTimer ("queue:$name");
  915. Modbus_HandleSendQueue ("direct:$name"); # don't wait for next regular handle queue slot
  916. }
  917. return;
  918. }
  919. ###########################
  920. # open connection
  921. # $hash is physical or both (TCP)
  922. # called from set reconnect, Attr (disable), Notify (initialized, rereadcfg, |(MODIFIED $name)), Ready
  923. sub Modbus_Open($;$)
  924. {
  925. my ($hash, $reopen) = @_;
  926. my $name = $hash->{NAME};
  927. my $now = gettimeofday();
  928. $reopen = 0 if (!$reopen);
  929. if ($hash->{BUSY_OPENDEV}) { # still waiting for callback to last open
  930. if ($hash->{LASTOPEN} && $now > $hash->{LASTOPEN} + (AttrVal($name, "openTimeout", 3) * 2)
  931. && $now > $hash->{LASTOPEN} + 15) {
  932. Log3 $name, 5, "$name: _Open - still waiting for open callback, timeout is over twice - this should never happen";
  933. Log3 $name, 5, "$name: _Open - stop waiting and reset the flag.";
  934. $hash->{BUSY_OPENDEV} = 0;
  935. } else {
  936. Log3 $name, 5, "$name: _Open - still waiting for open callback";
  937. return;
  938. }
  939. }
  940. if (!$reopen) { # not called from _Ready
  941. DevIo_CloseDev($hash);
  942. delete $hash->{NEXT_OPEN};
  943. delete $hash->{DevIoJustClosed};
  944. }
  945. Log3 $name, 4, "$name: trying to open connection to $hash->{DeviceName}" if (!$reopen);
  946. $hash->{IODev} = $hash if ($hash->{DEST}); # for TCP Log-Module itself is IODev (removed during CloseDev)
  947. $hash->{BUSY} = 0;
  948. $hash->{BUSY_OPENDEV} = 1;
  949. $hash->{LASTOPEN} = $now;
  950. $hash->{nextOpenDelay} = AttrVal($name, "nextOpenDelay", 60);
  951. $hash->{devioLoglevel} = (AttrVal($name, "silentReconnect", 0) ? 4 : 3);
  952. $hash->{TIMEOUT} = AttrVal($name, "openTimeout", 3);
  953. $hash->{helper}{buffer} = ""; # clear Buffer for reception
  954. DevIo_OpenDev($hash, $reopen, 0, \&Modbus_OpenCB);
  955. delete $hash->{TIMEOUT};
  956. return;
  957. }
  958. # ready fn for physical device
  959. # and logical device (in case of tcp when logical device opens connection)
  960. ###########################################################################
  961. sub Modbus_Ready($)
  962. {
  963. my ($hash) = @_;
  964. my $name = $hash->{NAME};
  965. if($hash->{STATE} eq "disconnected") {
  966. if (IsDisabled($name)) {
  967. Log3 $name, 3, "$name: _Reconnect: $name is disabled - don't try to reconnect";
  968. DevIo_CloseDev($hash);
  969. $hash->{BUSY} = 0;
  970. return;
  971. }
  972. Modbus_Open($hash, 1); # reopen, dont call DevIoClose before reopening
  973. return; # a return value only triggers direct read for windows - main loop will select for data
  974. }
  975. # This is relevant for windows/USB only
  976. my $po = $hash->{USBDev};
  977. if ($po) {
  978. my ($BlockingFlags, $InBytes, $OutBytes, $ErrorFlags) = $po->status;
  979. return ($InBytes>0); # tell fhem.pl to read when we return
  980. }
  981. return;
  982. }
  983. #####################################
  984. sub Modbus_CRC($) {
  985. use bytes;
  986. my $frame = shift;
  987. my $crc = 0xFFFF;
  988. my ($chr, $lsb);
  989. for my $i (0..bytes::length($frame)-1) {
  990. $chr = ord(bytes::substr($frame, $i, 1));
  991. $crc ^= $chr;
  992. for (1..8) {
  993. $lsb = $crc & 1;
  994. $crc >>= 1;
  995. $crc ^= 0xA001 if $lsb;
  996. }
  997. }
  998. no bytes;
  999. return $crc;
  1000. }
  1001. #####################################
  1002. sub Modbus_LRC($) {
  1003. use bytes;
  1004. my $frame = shift;
  1005. my $lrc = 0;
  1006. my $chr;
  1007. for my $i (0..bytes::length($frame)-1) {
  1008. $chr = ord(bytes::substr($frame, $i, 1));
  1009. $lrc = ($lrc + $chr) & 0xff;
  1010. }
  1011. return (0xff - $lrc) +1;
  1012. }
  1013. #######################################
  1014. sub Modbus_CountTimeouts($)
  1015. {
  1016. my ($hash) = @_;
  1017. my $name = $hash->{NAME};
  1018. if ($hash->{DEST}) {
  1019. # modbus TCP/RTU/ASCII over TCP
  1020. if ($hash->{TIMEOUTS}) {
  1021. $hash->{TIMEOUTS}++;
  1022. my $max = AttrVal($name, "maxTimeoutsToReconnect", 0);
  1023. if ($max && $hash->{TIMEOUTS} >= $max) {
  1024. Log3 $name, 3, "$name: $hash->{TIMEOUTS} successive timeouts, setting state to disconnected";
  1025. DevIo_Disconnected($hash);
  1026. }
  1027. } else {
  1028. $hash->{TIMEOUTS} = 1;
  1029. }
  1030. }
  1031. return;
  1032. }
  1033. #######################################
  1034. # Aufruf aus InternalTimer mit "timeout:$name"
  1035. # wobei name das physical device ist
  1036. sub Modbus_TimeoutSend($)
  1037. {
  1038. my $param = shift;
  1039. my (undef,$name) = split(':',$param);
  1040. my $ioHash = $defs{$name};
  1041. my $logLvl = AttrVal($name, "timeoutLogLevel", 3);
  1042. Log3 $name, $logLvl, "$name: timeout waiting for fc $ioHash->{REQUEST}{FCODE} " .
  1043. "from id $ioHash->{REQUEST}{MODBUSID}, " .
  1044. "Request was $ioHash->{REQUESTHEX}" .
  1045. " ($ioHash->{REQUEST}{TYPE}$ioHash->{REQUEST}{ADR} / $ioHash->{REQUEST}{READING}, len $ioHash->{REQUEST}{LEN})" .
  1046. ($ioHash->{helper}{buffer} ? ", Buffer contains " . unpack ("H*", $ioHash->{helper}{buffer}) : "");
  1047. Modbus_Statistics($ioHash, "Timeouts", 1);
  1048. Modbus_EndBUSY ($ioHash); # set BUSY to 0, delete REQUEST, clear Buffer, do Profilig, remove internalTimer
  1049. Modbus_CountTimeouts ($ioHash);
  1050. Modbus_HandleSendQueue ("direct:$name"); # verwaltet auch idle und busy time statistics variables
  1051. return;
  1052. };
  1053. #######################################
  1054. # prüfe delays vor dem Senden
  1055. sub Modbus_CheckDelay($$$$$$)
  1056. {
  1057. my ($ioHash, $devName, $force, $title, $delay, $last) = @_;
  1058. return if (!$delay);
  1059. my $now = gettimeofday();
  1060. my $name = $ioHash->{NAME};
  1061. my $t2 = $last + $delay;
  1062. my $rest = $t2 - $now;
  1063. Log3 $name, 5, "$name: handle queue check $title ($delay) for $devName: rest $rest";
  1064. if ($rest > 0) {
  1065. Modbus_Profiler($ioHash, "Delay");
  1066. if ($force) {
  1067. Log3 $name, 4, "$name: HandleSendQueue / CheckDelay $title ($delay) for $devName not over, sleep $rest forced";
  1068. sleep $rest if ($rest > 0 && $rest < $delay);
  1069. return 0;
  1070. } else {
  1071. InternalTimer($t2, "Modbus_HandleSendQueue", "queue:$name", 0);
  1072. Log3 $name, 4, "$name: HandleSendQueue / CheckDelay $title ($delay) for $devName not over, try again in $rest";
  1073. return 1;
  1074. }
  1075. }
  1076. return 0;
  1077. }
  1078. #######################################
  1079. # Aufruf aus InternalTimer mit "queue:$name"
  1080. # oder direkt mit "direkt:$name
  1081. # wobei name das physical device ist
  1082. # greift über den Request der Queue auf das logische Device zu
  1083. # um Timings und Zeitstempel zu verarbeiten
  1084. sub Modbus_HandleSendQueue($;$)
  1085. {
  1086. my (undef,$name) = split(':', shift);
  1087. my $force = shift;
  1088. my $ioHash = $defs{$name};
  1089. my $queue = $ioHash->{QUEUE};
  1090. my $now = gettimeofday();
  1091. #Log3 $name, 5, "$name: handle queue" . ($force ? ", force" : "");
  1092. RemoveInternalTimer ("queue:$name");
  1093. return if(!defined($queue) || @{$queue} == 0);
  1094. my $queueDelay = AttrVal($name, "queueDelay", 1);
  1095. if ($ioHash->{STATE} eq "disconnected") {
  1096. Log3 $name, 4, "$name: handle queue: device is disconnected, dropping requests in queue";
  1097. Modbus_Profiler($ioHash, "Idle");
  1098. delete $ioHash->{QUEUE};
  1099. return;
  1100. }
  1101. if (IsDisabled($name)) {
  1102. Log3 $name, 4, "$name: HandleSendQueue called but device is disabled. Dropping requests in queue";
  1103. Modbus_Profiler($ioHash, "Idle");
  1104. delete $ioHash->{QUEUE};
  1105. return;
  1106. }
  1107. if (!$init_done) { # fhem not initialized, wait with IO
  1108. InternalTimer($now+$queueDelay, "Modbus_HandleSendQueue", "queue:$name", 0);
  1109. Log3 $name, 3, "$name: handle queue: not available yet (init not done), try again in $queueDelay seconds";
  1110. return;
  1111. }
  1112. if ($ioHash->{BUSY}) { # still waiting for reply to last request
  1113. InternalTimer($now+$queueDelay, "Modbus_HandleSendQueue", "queue:$name", 0);
  1114. #Log3 $name, 5, "$name: handle queue: busy, try again in $queueDelay seconds";
  1115. #Modbus_Profiler($ioHash, "Wait");
  1116. return;
  1117. }
  1118. return if ((!$queue) || (!$queue->[0])); # nothing in queue
  1119. # get top element from Queue
  1120. my $request = $queue->[0];
  1121. if (!$request->{FCODE}) {
  1122. Log3 $name, 4, "$name: HandleSendQueue called with empty fcode entry. Dropping request";
  1123. shift(@{$queue}); # remove first element from queue
  1124. return;
  1125. }
  1126. my $reading = $request->{READING};
  1127. my $len = $request->{LEN};
  1128. my $tid = $request->{TID};
  1129. my $adr = $request->{ADR};
  1130. my $reqId = $request->{MODBUSID};
  1131. my $proto = $request->{PROTOCOL};
  1132. my $type = $request->{TYPE};
  1133. my $fCode = $request->{FCODE};
  1134. my $v1 = $request->{VALUE};
  1135. my $logHash = $request->{DEVHASH};
  1136. if (IsDisabled($logHash->{NAME})) {
  1137. Log3 $name, 4, "$name: HandleSendQueue called but logical device is disabled. Dropping request";
  1138. shift(@{$queue}); # remove first element from queue
  1139. #Modbus_Profiler($ioHash, "Idle");
  1140. # todo: profiler?
  1141. return;
  1142. }
  1143. # todo: check profiler setting in case delays not over
  1144. # check defined delays
  1145. if ($ioHash->{helper}{lrecv}) {
  1146. #Log3 $name, 5, "$name: check busDelay ...";
  1147. return if (Modbus_CheckDelay($ioHash, $name, $force,
  1148. "busDelay", AttrVal($name, "busDelay", 0),
  1149. $ioHash->{helper}{lrecv}));
  1150. #Log3 $name, 5, "$name: check clientSwitchDelay ...";
  1151. my $clSwDelay = AttrVal($name, "clientSwitchDelay", 0);
  1152. if ($clSwDelay && $ioHash->{helper}{lid}
  1153. && $reqId != $ioHash->{helper}{lid}) {
  1154. return if (Modbus_CheckDelay($ioHash, $name, $force,
  1155. "clientSwitchDelay", $clSwDelay,
  1156. $ioHash->{helper}{lrecv}));
  1157. }
  1158. }
  1159. if ($logHash->{helper}{lrecv}) {
  1160. return if (Modbus_CheckDelay($ioHash, $logHash->{NAME}, $force,
  1161. "commDelay", ModbusLD_DevInfo($logHash, "timing", "commDelay", 0.1),
  1162. $logHash->{helper}{lrecv}));
  1163. }
  1164. if ($logHash->{helper}{lsend}) {
  1165. return if (Modbus_CheckDelay($ioHash, $logHash->{NAME}, $force,
  1166. "sendDelay", ModbusLD_DevInfo($logHash, "timing", "sendDelay", 0.1),
  1167. $logHash->{helper}{lsend}));
  1168. }
  1169. Log3 $name, 5, "$name: HandleSendQueue: finished delay checking, proceed with sending";
  1170. my $data;
  1171. if ($fCode == 1 || $fCode == 2) { # read coils / discrete inputs, pdu: StartAdr, Len (=number of coils)
  1172. $data = pack ('nn', $adr, $len);
  1173. } elsif ($fCode == 3 || $fCode == 4) { # read holding/input registers, pdu: StartAdr, Len (=number of regs)
  1174. $data = pack ('nn', $adr, $len);
  1175. } elsif ($fCode == 5) { # write single coil, pdu: StartAdr, Value (1-bit as FF00)
  1176. if (ModbusLD_DevInfo($logHash, "c", "brokenFC5", 0)) {
  1177. my $oneCode = lc ModbusLD_DevInfo($logHash, "c", "brokenFC5");
  1178. $data = pack ('nH4', $adr, (unpack ('n',$v1) ? $oneCode : "0000"));
  1179. } else {
  1180. $data = pack ('nH4', $adr, (unpack ('n',$v1) ? "FF00" : "0000"));
  1181. }
  1182. } elsif ($fCode == 6) { # write single register, pdu: StartAdr, Value
  1183. $data = pack ('n', $adr) . $v1;
  1184. } elsif ($fCode == 15) { # write multiple coils, pdu: StartAdr, NumOfCoils, ByteCount, Values
  1185. $data = pack ('nnCC', $adr, int($len/8)+1, $len, $v1); # todo: test / fix
  1186. } elsif ($fCode == 16) { # write multiple regs, pdu: StartAdr, NumOfRegs, ByteCount, Values
  1187. $data = pack ('nnC', $adr, $len, $len*2) . $v1;
  1188. } else { # function code not implemented yet
  1189. Log3 $name, 3, "$name: Send function code $fCode not yet implemented";
  1190. return;
  1191. }
  1192. my $pdu = pack ('C', $fCode) . $data;
  1193. my $frame;
  1194. my $packedId = pack ('C', $reqId);
  1195. if ($proto eq "RTU") { # frame format: ID, (fCode, data), CRC
  1196. my $crc = pack ('v', Modbus_CRC($packedId . $pdu));
  1197. $frame = $packedId . $pdu . $crc;
  1198. } elsif ($proto eq "ASCII") { # frame format: ID, (fCode, data), LRC
  1199. my $lrc = uc(unpack ('H2', pack ('v', Modbus_LRC($packedId.$pdu))));
  1200. #Log3 $name, 5, "$name: LRC: $lrc";
  1201. $frame = ':' . uc(unpack ('H2', $packedId) . unpack ('H*', $pdu)) . $lrc . "\r\n";
  1202. } elsif ($proto eq "TCP") { # frame format: tid, 0, len, ID, (fCode, data)
  1203. my $dlen = bytes::length($pdu)+1; # length of pdu + Id
  1204. my $header = pack ('nnnC', ($tid, 0, $dlen, $reqId));
  1205. $frame = $header.$pdu;
  1206. }
  1207. $request->{FRAME} = $frame; # frame as data string for echo detection
  1208. $ioHash->{REQUEST} = $request; # save for later
  1209. Modbus_Profiler($ioHash, "Send");
  1210. $ioHash->{REQUESTHEX} = unpack ('H*', $frame); # for debugging / log
  1211. $ioHash->{BUSY} = 1; # modbus bus is busy until response is received
  1212. $ioHash->{helper}{buffer} = ""; # clear Buffer for reception
  1213. #Log3 $name, 3, "$name: insert Garbage for testing";
  1214. #$ioHash->{helper}{buffer} = pack ("C",0); # test / debug / todo: remove
  1215. Log3 $name, 4, "$name: HandleSendQueue sends fc $fCode to id $reqId, tid $tid for $reading ($type$adr), len $len" .
  1216. ", device $logHash->{NAME} ($proto), pdu " . unpack ('H*', $pdu) . ", V $Modbus_Version";
  1217. DevIo_SimpleWrite($ioHash, $frame, 0);
  1218. $now = gettimeofday();
  1219. $ioHash->{helper}{lsend} = $now; # remember when last send to this bus
  1220. $logHash->{helper}{lsend} = $now; # remember when last send to this device
  1221. $ioHash->{helper}{lid} = $reqId; # device id we talked to
  1222. Modbus_Statistics($ioHash, "Requests", 1);
  1223. Modbus_Profiler($ioHash, "Wait");
  1224. my $timeout = ModbusLD_DevInfo($logHash, "timing", "timeout", 2);
  1225. my $toTime = $now+$timeout;
  1226. RemoveInternalTimer ("timeout:$name");
  1227. InternalTimer($toTime, "Modbus_TimeoutSend", "timeout:$name", 0);
  1228. $ioHash->{nextTimeout} = $toTime;
  1229. shift(@{$queue}); # remove first element from queue
  1230. if(@{$queue} > 0) { # more items in queue -> schedule next handle
  1231. InternalTimer($now+$queueDelay, "Modbus_HandleSendQueue", "queue:$name", 0);
  1232. }
  1233. return;
  1234. }
  1235. ##################################################
  1236. #
  1237. # Funktionen für logische Geräte
  1238. # zum Aufruf aus anderen Modulen
  1239. #
  1240. ##################################################
  1241. #####################################
  1242. sub ModbusLD_Initialize($ )
  1243. {
  1244. my ($modHash) = @_;
  1245. $modHash->{DefFn} = "ModbusLD_Define"; # functions are provided by the Modbus base module
  1246. $modHash->{UndefFn} = "ModbusLD_Undef";
  1247. $modHash->{ReadFn} = "Modbus_Read";
  1248. $modHash->{ReadyFn} = "Modbus_Ready";
  1249. $modHash->{AttrFn} = "ModbusLD_Attr";
  1250. $modHash->{SetFn} = "ModbusLD_Set";
  1251. $modHash->{GetFn} = "ModbusLD_Get";
  1252. $modHash->{NotifyFn} = "Modbus_Notify";
  1253. $modHash->{AttrList}=
  1254. "do_not_notify:1,0 " .
  1255. $Modbus_LogAttrs .
  1256. $Modbus_CommonAttrs .
  1257. $readingFnAttributes;
  1258. $modHash->{ObjAttrList} =
  1259. "obj-[cdih][0-9]+-reading " .
  1260. "obj-[cdih][0-9]+-name " .
  1261. "obj-[cdih][0-9]+-min " .
  1262. "obj-[cdih][0-9]+-max " .
  1263. "obj-[cdih][0-9]+-hint " .
  1264. "obj-[cdih][0-9]+-map " .
  1265. "obj-[cdih][0-9]+-set " .
  1266. "obj-[cdih][0-9]+-setexpr " .
  1267. "obj-[cdih][0-9]+-textArg " .
  1268. "obj-[cdih][0-9]+-revRegs " .
  1269. "obj-[cdih][0-9]+-bswapRegs " .
  1270. "obj-[cdih][0-9]+-len " .
  1271. "obj-[cdih][0-9]+-unpack " .
  1272. "obj-[cdih][0-9]+-decode " .
  1273. "obj-[cdih][0-9]+-encode " .
  1274. "obj-[cdih][0-9]+-expr " .
  1275. "obj-[cdih][0-9]+-ignoreExpr " .
  1276. "obj-[cdih][0-9]+-format " .
  1277. "obj-[ih][0-9]+-type " .
  1278. "obj-[cdih][0-9]+-showGet " .
  1279. "obj-[cdih][0-9]+-poll " .
  1280. "obj-[cdih][0-9]+-polldelay ";
  1281. #"(get|set)([0-9]+)request([0-9]+) "
  1282. $modHash->{DevAttrList} =
  1283. "dev-([cdih]-)*read " .
  1284. "dev-([cdih]-)*write " .
  1285. "dev-([cdih]-)*combine " .
  1286. "dev-([cdih]-)*allowShortResponses " .
  1287. "dev-([cdih]-)*defRevRegs " .
  1288. "dev-([cdih]-)*defBswapRegs " .
  1289. "dev-([cdih]-)*defLen " .
  1290. "dev-([cdih]-)*defUnpack " .
  1291. "dev-([cdih]-)*defDecode " .
  1292. "dev-([cdih]-)*defEncode " .
  1293. "dev-([cdih]-)*defExpr " .
  1294. "dev-([cdih]-)*defIgnoreExpr " .
  1295. "dev-([cdih]-)*defFormat " .
  1296. "dev-([cdih]-)*defShowGet " .
  1297. "dev-([cdih]-)*defPoll " .
  1298. "dev-h-brokenFC3 " .
  1299. "dev-c-brokenFC5 " .
  1300. "dev-type-[A-Za-z0-9_]+-unpack " .
  1301. "dev-type-[A-Za-z0-9_]+-len " .
  1302. "dev-type-[A-Za-z0-9_]+-encode " .
  1303. "dev-type-[A-Za-z0-9_]+-decode " .
  1304. "dev-type-[A-Za-z0-9_]+-revRegs " .
  1305. "dev-type-[A-Za-z0-9_]+-bswapRegs " .
  1306. "dev-type-[A-Za-z0-9_]+-format " .
  1307. "dev-type-[A-Za-z0-9_]+-expr " .
  1308. "dev-type-[A-Za-z0-9_]+-map " .
  1309. "dev-timing-timeout " .
  1310. "dev-timing-sendDelay " .
  1311. "dev-timing-commDelay ";
  1312. return;
  1313. }
  1314. #####################################
  1315. sub ModbusLD_SetIODev($)
  1316. {
  1317. my ($hash) = @_;
  1318. my $name = $hash->{NAME};
  1319. my $ioName = AttrVal($name, "IODev", "");
  1320. my $ioHash;
  1321. if ($ioName) {
  1322. # handle IODev Attribute
  1323. if ($defs{$ioName}) { # gibt es den Geräte-Hash zum IODev Attribut?
  1324. $ioHash = $defs{$ioName};
  1325. } else {
  1326. Log3 $name, 3, "$name: SetIODev can't use $ioName from IODev attribute - device does not exist";
  1327. }
  1328. }
  1329. if (!$ioHash) {
  1330. # search for usable physical Modbus device
  1331. for my $p (sort { $defs{$b}{NR} <=> $defs{$a}{NR} } keys %defs) {
  1332. if ( $defs{$p}{TYPE} eq "Modbus") {
  1333. $ioHash = $defs{$p};
  1334. $attr{$name}{IODev} = $ioHash->{NAME}; # set IODev attribute
  1335. last;
  1336. }
  1337. }
  1338. }
  1339. if (!$ioHash) {
  1340. # still nothing found -> give up for now
  1341. Log3 $name, 3, "$name: SetIODev found no physical modbus device";
  1342. return undef;
  1343. }
  1344. $ioName = $ioHash->{NAME};
  1345. Log3 $name, 3, "$name: SetIODev registers $name with Id $hash->{MODBUSID} at $ioName";
  1346. $hash->{IODev} = $ioHash; # point internal IODev to io device hash
  1347. $hash->{IODev}{defptr}{$hash->{MODBUSID}} = $hash; # register device for given id at io hash (for removal at undef)
  1348. Log3 $name, 5, "$name: SetIODev is using $ioHash->{NAME}";
  1349. return $ioHash;
  1350. }
  1351. #########################################################################
  1352. # set internal Timer to call GetUpdate if necessary
  1353. # either at next interval
  1354. # or if start is passed in start seconds (e.g. 2 seconds after Fhem init)
  1355. sub ModbusLD_SetTimer($;$)
  1356. {
  1357. my ($hash, $start) = @_;
  1358. my $nextTrigger;
  1359. my $name = $hash->{NAME};
  1360. my $now = gettimeofday();
  1361. $start = 0 if (!$start);
  1362. if ($hash->{INTERVAL} && $hash->{INTERVAL} > 0) {
  1363. if ($hash->{TimeAlign}) {
  1364. my $count = int(($now - $hash->{TimeAlign} + $start) / $hash->{INTERVAL});
  1365. my $curCycle = $hash->{TimeAlign} + $count * $hash->{INTERVAL};
  1366. $nextTrigger = $curCycle + $hash->{INTERVAL};
  1367. } else {
  1368. $nextTrigger = $now + ($start ? $start : $hash->{INTERVAL});
  1369. }
  1370. $hash->{TRIGGERTIME} = $nextTrigger;
  1371. $hash->{TRIGGERTIME_FMT} = FmtDateTime($nextTrigger);
  1372. RemoveInternalTimer("update:$name");
  1373. InternalTimer($nextTrigger, "ModbusLD_GetUpdate", "update:$name", 0);
  1374. Log3 $name, 4, "$name: update timer modified: will call GetUpdate in " .
  1375. sprintf ("%.1f", $nextTrigger - $now) . " seconds at $hash->{TRIGGERTIME_FMT} - Interval $hash->{INTERVAL}";
  1376. } else {
  1377. $hash->{TRIGGERTIME} = 0;
  1378. $hash->{TRIGGERTIME_FMT} = "";
  1379. }
  1380. return;
  1381. }
  1382. #####################################
  1383. sub Modbus_OpenCB($$)
  1384. {
  1385. my ($hash, $msg) = @_;
  1386. my $name = $hash->{NAME};
  1387. if ($msg) {
  1388. Log3 $name, 5, "$name: Open callback: $msg" if ($msg);
  1389. }
  1390. delete $hash->{BUSY_OPENDEV};
  1391. delete $hash->{TIMEOUTS} if ($hash->{FD});
  1392. return;
  1393. }
  1394. #####################################
  1395. sub ModbusLD_Define($$)
  1396. {
  1397. my ($hash, $def) = @_;
  1398. my @a = split("[ \t]+", $def);
  1399. my ($name, $module, $id, $interval, $dest, $proto) = @a;
  1400. return "wrong syntax: define <name> $module [id] [interval] [host:port] [RTU|ASCII|TCP]"
  1401. if(@a < 2);
  1402. if ($proto) {
  1403. $proto = uc($proto);
  1404. return "wrong syntax: define <name> $module [id] [interval] [host:port] [RTU|ASCII|TCP]"
  1405. if ($proto !~ /RTU|ASCII|TCP/);
  1406. } else {
  1407. if ($dest && uc($dest) =~ /RTU|ASCII|TCP/) {
  1408. # no host but protocol given
  1409. $proto = uc($dest);
  1410. $dest = "";
  1411. }
  1412. }
  1413. # for TCP $id is an optional Unit ID that is ignored by most devices
  1414. # but some gateways may use it to select the device to forward to.
  1415. $id = 1 if (!defined($id));
  1416. $interval = 0 if (!defined($interval));
  1417. $proto = "RTU" if (!defined($proto));
  1418. $dest = "" if (!defined($dest));
  1419. return "Interval has to be numeric" if ($interval !~ /[0-9.]+/);
  1420. $hash->{NOTIFYDEV} = "global"; # NotifyFn nur aufrufen wenn global events (INITIALIZED etc.)
  1421. $hash->{ModuleVersion} = $Modbus_Version;
  1422. $hash->{MODBUSID} = $id;
  1423. $hash->{INTERVAL} = $interval;
  1424. $hash->{PROTOCOL} = $proto;
  1425. $hash->{'.getList'} = "";
  1426. $hash->{'.setList'} = "";
  1427. $hash->{".updateSetGet"} = 1;
  1428. if ($dest) { # Modbus über TCP mit IP Adresse angegeben (TCP oder auch RTU/ASCII über TCP)
  1429. $dest .= ":502" if ($dest !~ /.*:[0-9]/); # add default port if no port specified
  1430. $hash->{DEST} = $dest;
  1431. $hash->{IODev} = $hash; # Modul ist selbst IODev
  1432. $hash->{defptr}{$id} = $hash; # ID verweist zurück auf eigenes Modul
  1433. $hash->{DeviceName} = $dest; # needed by DevIo to get Device, Port, Speed etc.
  1434. $hash->{STATE} = "disconnected"; # initial value
  1435. my $modHash = $modules{$hash->{TYPE}};
  1436. $modHash->{AttrList} .= $Modbus_PhysAttrs; # affects all devices - even non TCP - sorry ...
  1437. #Log3 $name, 3, "$name: added attributes for physical devices for Modbus TCP";
  1438. } else {
  1439. $hash->{DEST} = ""; # logical device that uses a physical Modbus device
  1440. }
  1441. Log3 $name, 3, "$name: defined with id $id, interval $interval, protocol $proto" .
  1442. ($dest ? ", destination $dest" : "");
  1443. return;
  1444. }
  1445. #########################################################################
  1446. sub Modbus_Attr(@)
  1447. {
  1448. my ($cmd,$name,$aName,$aVal) = @_;
  1449. my $hash = $defs{$name}; # hash des physischen Devices
  1450. Log3 $name, 5, "$name: $cmd attr $aName" . (defined($aVal) ? ", $aVal" : "");
  1451. if ($aName eq 'disable' && $init_done) { # only after init_done, otherwise see NotifyFN
  1452. # disable on a physical serial device
  1453. if ($cmd eq "set" && $aVal) {
  1454. Log3 $name, 3, "$name: disable attribute set" . ($hash->{FD} ? ", closing connection" : "");
  1455. DevIo_CloseDev($hash) if ($hash->{FD});
  1456. $hash->{STATE} = "disconnected";
  1457. $hash->{BUSY} = 0;
  1458. } elsif ($cmd eq "del" || ($cmd eq "set" && !$aVal)) {
  1459. Log3 $name, 3, "$name: disable attribute removed";
  1460. Modbus_Open($hash);
  1461. }
  1462. }
  1463. return undef;
  1464. }
  1465. #########################################################################
  1466. sub ModbusLD_Attr(@)
  1467. {
  1468. my ($cmd,$name,$aName,$aVal) = @_;
  1469. my $hash = $defs{$name}; # hash des logischen Devices
  1470. my $inCheckEval = 0;
  1471. # todo: validate other attrs
  1472. # e.g. unpack not allowed for coils / discrete inputs, len not for coils,
  1473. # max combine, etc.
  1474. #
  1475. if ($cmd eq "set") {
  1476. if ($aName =~ "expr") { # validate all Expressions
  1477. my $val = 1;
  1478. eval $aVal;
  1479. if ($@) {
  1480. Log3 $name, 3, "$name: Attr with invalid Expression in attr $name $aName $aVal: $@";
  1481. return "Invalid Expression $aVal";
  1482. }
  1483. } elsif ($aName eq "IODev") { # defptr housekeeping
  1484. my $ioHash = $defs{$aVal};
  1485. if ($ioHash && $ioHash->{TYPE} eq "Modbus") { # gibt es den Geräte-Hash zum IODev Attribut?
  1486. $ioHash->{defptr}{$hash->{MODBUSID}} = $hash; # register logical device
  1487. Log3 $name, 5, "$name: Attr IODev - using $aVal";
  1488. } else {
  1489. Log3 $name, 5, "$name: Attr IODev can't use $aVal - device does not exist (yet?) or is not a physical Modbus Device";
  1490. }
  1491. } elsif ($aName eq 'alignTime') {
  1492. my ($alErr, $alHr, $alMin, $alSec, undef) = GetTimeSpec($aVal);
  1493. return "Invalid Format $aVal in $aName : $alErr" if ($alErr);
  1494. my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime();
  1495. $hash->{TimeAlign} = fhemTimeLocal($alSec, $alMin, $alHr, $mday, $mon, $year);
  1496. $hash->{TimeAlignFmt} = FmtDateTime($hash->{TimeAlign});
  1497. ModbusLD_SetTimer($hash); # change timer for alignment
  1498. } elsif (" $Modbus_PhysAttrs " =~ /\ $aName[: ]/) {
  1499. if (!$hash->{DEST}) {
  1500. Log3 $name, 3, "$name: attribute $aName is only valid for physical Modbus devices or Modbus TCP - please use this attribute for your physical IO device $hash->{IODev}{NAME}";
  1501. return "attribute $aName is only valid for physical Modbus devices or Modbus TCP - please use this attribute for your physical IO device $hash->{IODev}{NAME}";
  1502. }
  1503. } elsif ($aName =~ /(obj-[cdih])(0+([0-9]+))-/) {
  1504. # leading zero in obj-Attr detected
  1505. if (length($2) > 5) {
  1506. my $new = $1 . substr("00000", 5 - length ($3)) . $3;
  1507. $aName = $new;
  1508. Log3 $name, 3, "$name: Address in attribute $aName too long, shortened to $new";
  1509. }
  1510. if (!$hash->{LeadingZeros}) {
  1511. $hash->{LeadingZeros} = 1;
  1512. Log3 $name, 3, "$name: Support for leading zeros in object addresses enabled. This might slow down the fhem modbus module a bit";
  1513. }
  1514. }
  1515. addToDevAttrList($name, $aName);
  1516. } elsif ($cmd eq "del") {
  1517. #Log3 $name, 5, "$name: del attribute $aName";
  1518. if ($aName =~ /obj-[cdih]0[0-9]+-/) {
  1519. if (!(grep !/$aName/, grep (/obj-[cdih]0[0-9]+-/, keys %{$attr{$name}}))) {
  1520. delete $hash->{LeadingZeros}; # no more leading zeros
  1521. }
  1522. }
  1523. }
  1524. $hash->{".updateSetGet"} = 1;
  1525. if ($aName eq 'disable' && $init_done) { # if not init_done, nothing to be done here (see NotifyFN)
  1526. # disable on a logical device (not physical here!)
  1527. if ($cmd eq "set" && $aVal) {
  1528. if ($hash->{DEST}) { # Modbus TCP
  1529. Log3 $name, 3, "$name: disable attribute set" .
  1530. ($hash->{FD} ? ", closing TCP connection" : "");
  1531. DevIo_CloseDev($hash) if ($hash->{FD});
  1532. $hash->{BUSY} = 0;
  1533. }
  1534. RemoveInternalTimer("update:$name");
  1535. } elsif ($cmd eq "del" || ($cmd eq "set" && !$aVal)) {
  1536. Log3 $name, 3, "$name: disable attribute removed" .
  1537. ($hash->{DEST} ? ", opening TCP connection" : "");
  1538. if ($hash->{DEST}) { # Modbus TCP
  1539. Modbus_Open($hash); # should be called with hash of physical device but for TCP it's the same
  1540. } else {
  1541. my $ioHash = ModbusLD_GetIOHash($hash);
  1542. my $ioName = $ioHash->{NAME};
  1543. if ($ioName) {
  1544. Log3 $name, 3, "$name: using $ioName for communication";
  1545. } else {
  1546. Log3 $name, 3, "$name: no IODev for communication";
  1547. }
  1548. }
  1549. ModbusLD_SetTimer($hash, 1); # first Update in 1 second or aligned if interval is defined
  1550. }
  1551. }
  1552. return;
  1553. }
  1554. #####################################
  1555. sub ModbusLD_Undef($$)
  1556. {
  1557. my ($hash, $arg) = @_;
  1558. my $name = $hash->{NAME};
  1559. DevIo_CloseDev($hash) if ($hash->{DEST}); # logical Device over TCP - no underlying physical Device
  1560. RemoveInternalTimer ("update:$name");
  1561. RemoveInternalTimer ("timeout:$name");
  1562. RemoveInternalTimer ("queue:$name");
  1563. return;
  1564. }
  1565. #####################################
  1566. sub ModbusLD_UpdateGetSetList($)
  1567. {
  1568. my ($hash) = @_;
  1569. my $name = $hash->{NAME};
  1570. my $modHash = $modules{$hash->{TYPE}};
  1571. my $parseInfo = $modHash->{parseInfo};
  1572. if (AttrVal($name, "enableControlSet", undef)) { # spezielle Sets freigeschaltet?
  1573. $hash->{'.setList'} = "interval reread:noArg reconnect:noArg stop:noArg start:noArg ";
  1574. if ($hash->{PROTOCOL} =~ /RTU|ASCII/) {
  1575. $hash->{'.setList'} .= "scanModbusId ";
  1576. }
  1577. $hash->{'.setList'} .= "scanStop:noArg scanModbusObjects ";
  1578. } else {
  1579. $hash->{'.setList'} = "";
  1580. }
  1581. $hash->{'.getList'} = "";
  1582. my @ObjList = keys (%{$parseInfo});
  1583. foreach my $at (keys %{$attr{$name}}) {
  1584. if ($at =~ /^obj-(.*)-reading$/) {
  1585. push @ObjList, $1 if (!$parseInfo->{$1});
  1586. }
  1587. }
  1588. #Log3 $name, 5, "$name: UpdateGetSetList full object list: " . join (" ", @ObjList);
  1589. foreach my $objCombi (sort @ObjList) {
  1590. my $reading = ModbusLD_ObjInfo($hash, $objCombi, "reading");
  1591. my $showget = ModbusLD_ObjInfo($hash, $objCombi, "showGet", "defShowGet", 0); # default to 0
  1592. my $set = ModbusLD_ObjInfo($hash, $objCombi, "set", 0); # default to 0
  1593. my $map = ModbusLD_ObjInfo($hash, $objCombi, "map", "defMap");
  1594. my $hint = ModbusLD_ObjInfo($hash, $objCombi, "hint");
  1595. #my $type = substr($objCombi, 0, 1);
  1596. #my $adr = substr($objCombi, 1);
  1597. my $setopt;
  1598. $hash->{'.getList'} .= "$reading:noArg " if ($showget); # sichtbares get
  1599. if ($set) { # gibt es für das Reading ein SET?
  1600. if ($map){ # ist eine Map definiert, aus der Hints abgeleitet werden können?
  1601. my $hl = $map;
  1602. $hl =~ s/([^ ,\$]+):([^ ,\$]+,?) ?/$2/g;
  1603. $setopt = $reading . ":$hl";
  1604. } else {
  1605. $setopt = $reading; # nur den Namen für setopt verwenden.
  1606. }
  1607. if ($hint){ # hints explizit definiert? (überschreibt evt. schon abgeleitete hints)
  1608. $setopt = $reading . ":" . $hint;
  1609. }
  1610. $hash->{'.setList'} .= "$setopt "; # Liste aller Sets inkl. der Hints nach ":" für Rückgabe bei Set ?
  1611. }
  1612. }
  1613. #Log3 $name, 5, "$name: UpdateSetList: setList=$hash->{'.setList'}";
  1614. #Log3 $name, 5, "$name: UpdateSetList: getList=$hash->{'.getList'}";
  1615. $hash->{".updateSetGet"} = 0;
  1616. return;
  1617. }
  1618. #####################################
  1619. # Get Funktion für logische Geräte / Module
  1620. sub ModbusLD_Get($@)
  1621. {
  1622. my ($hash, @a) = @_;
  1623. return "\"get $a[0]\" needs at least one argument" if(@a < 2);
  1624. my $name = $hash->{NAME};
  1625. my $getName = $a[1];
  1626. my $objCombi;
  1627. if ($getName ne "?") {
  1628. $objCombi = ModbusLD_ObjKey($hash, $getName);
  1629. #Log3 $name, 5, "$name: Get: key for $getName = $objCombi";
  1630. }
  1631. if (!$objCombi) {
  1632. ModbusLD_UpdateGetSetList($hash) if ($hash->{".updateSetGet"});
  1633. Log3 $name, 5, "$name: Get: $getName not found, return list $hash->{'.getList'}"
  1634. if ($getName ne "?");
  1635. return "Unknown argument $a[1], choose one of $hash->{'.getList'}";
  1636. }
  1637. if (IsDisabled($name)) {
  1638. Log3 $name, 5, "$name: Get called with $getName but device is disabled";
  1639. return undef;
  1640. }
  1641. my $ioHash = ModbusLD_GetIOHash($hash);
  1642. return undef if (!$ioHash);
  1643. my ($err, $result);
  1644. Log3 $name, 5, "$name: Get: Called with $getName ($objCombi)";
  1645. if ($ioHash->{BUSY}) { # Answer for last function code has not yet arrived
  1646. Log3 $name, 5, "$name: Get: Queue is stil busy - taking over the read with ReadAnswer";
  1647. ModbusLD_ReadAnswer($hash); # finish last read and wait for the result before next request
  1648. Modbus_EndBUSY ($ioHash); # set BUSY to 0, delete REQUEST, clear Buffer, do Profilig
  1649. }
  1650. ModbusLD_Send($hash, $objCombi, "read", 0, 1); # add at beginning of queue and force send / sleep if necessary
  1651. ($err, $result) = ModbusLD_ReadAnswer($hash, $getName);
  1652. Modbus_EndBUSY ($ioHash); # set BUSY to 0, delete REQUEST, clear Buffer, do Profilig
  1653. return $err if ($err);
  1654. return $result;
  1655. }
  1656. sub Modbus_compObjAttrs ($$) {
  1657. my ($a, $b) = @_;
  1658. my $aType = substr($a, 4, 1);
  1659. my $aStart = substr($a, 5);
  1660. my $bType = substr($b, 4, 1);
  1661. my $bStart = substr($b, 5);
  1662. my $result = ($aType cmp $bType);
  1663. if ($result) {
  1664. return $result;
  1665. }
  1666. $result = $aStart <=> $bStart;
  1667. return $result;
  1668. }
  1669. #
  1670. # SET command - handle predifined control sets
  1671. ################################################
  1672. sub ModbusLD_ControlSet($$$)
  1673. {
  1674. my ($hash, $setName, $setVal) = @_;
  1675. my $name = $hash->{NAME};
  1676. if ($setName eq 'interval') {
  1677. if (!$setVal || $setVal !~ /[0-9.]+/) {
  1678. Log3 $name, 3, "$name: no valid interval (secs) specified in set, continuing with $hash->{INTERVAL} (sec)";
  1679. return "No valid Interval specified";
  1680. } else {
  1681. $hash->{INTERVAL} = $setVal;
  1682. Log3 $name, 3, "$name: timer interval changed to $hash->{INTERVAL} seconds";
  1683. ModbusLD_SetTimer($hash);
  1684. return "0";
  1685. }
  1686. } elsif ($setName eq 'reread') {
  1687. ModbusLD_GetUpdate("reread:$name");
  1688. return "0";
  1689. } elsif ($setName eq 'reconnect') {
  1690. if (IsDisabled($name)) {
  1691. Log3 $name, 3, "$name: set reconnect called but device is disabled";
  1692. return "set reconnect called but device is disabled";
  1693. }
  1694. if (!$hash->{DEST}) {
  1695. Log3 $name, 3, "$name: set reconnect called but device is not using Modbus TCP and the connection is going through another device so the connection can't be reconnected from here";
  1696. return "set reconnect called but device is connecting through another physical device";
  1697. }
  1698. Modbus_Open($hash); # should be called with hash of physical device but for TCP it's the same
  1699. return "0";
  1700. } elsif ($setName eq 'stop') {
  1701. RemoveInternalTimer("update:$name");
  1702. $hash->{TRIGGERTIME} = 0;
  1703. $hash->{TRIGGERTIME_FMT} = "";
  1704. Log3 $name, 3, "$name: internal interval timer stopped";
  1705. return "0";
  1706. } elsif ($setName eq 'start') {
  1707. ModbusLD_SetTimer($hash);
  1708. return "0";
  1709. } elsif ($setName eq 'scanStop') {
  1710. RemoveInternalTimer ("scan:$name");
  1711. delete $hash->{scanId};
  1712. delete $hash->{scanIdStart};
  1713. delete $hash->{scanIdEnd};
  1714. delete $hash->{scanOAdr};
  1715. delete $hash->{scanOStart};
  1716. delete $hash->{scanOEnd};
  1717. delete $hash->{scanOLen};
  1718. delete $hash->{scanOType};
  1719. return "0";
  1720. } elsif ($setName eq 'scanModbusId') {
  1721. delete $hash->{scanOStart};
  1722. delete $hash->{scanOEnd};
  1723. $hash->{scanIdStart} = 1;
  1724. $hash->{scanIdEnd} = 255;
  1725. $hash->{scanOType} = 'h';
  1726. $hash->{scanOAdr} = 100;
  1727. $hash->{scanOLen} = 1;
  1728. if ($setVal && $setVal =~ /([0-9]+) *- *([0-9]+) +([hicd][0-9]+)/) {
  1729. $hash->{scanIdStart} = $1;
  1730. $hash->{scanIdEnd} = $2;
  1731. $hash->{scanOType} = substr($3,0,1);
  1732. $hash->{scanOAdr} = substr($3,1);
  1733. }
  1734. Log3 $name, 3, "$name: Scan range specified as Modbus Id $hash->{scanIdStart} to $hash->{scanIdEnd}" .
  1735. " with $hash->{scanOType}$hash->{scanOAdr}, Len ";
  1736. delete $hash->{scanId};
  1737. my $now = gettimeofday();
  1738. my $scanDelay = AttrVal($name, "scanDelay", 1);
  1739. RemoveInternalTimer ("scan:$name");
  1740. InternalTimer($now+$scanDelay, "ModbusLD_ScanIds", "scan:$name", 0);
  1741. return "0";
  1742. } elsif ($setName eq 'scanModbusObjects') {
  1743. delete $hash->{scanId};
  1744. delete $hash->{scanIdStart};
  1745. delete $hash->{scanIdEnd};
  1746. $hash->{scanOType} = "h";
  1747. $hash->{scanOStart} = "1";
  1748. $hash->{scanOEnd} = "16384";
  1749. $hash->{scanOLen} = "1";
  1750. if ($setVal && $setVal =~ /([hicd][0-9]+) *- *([hicd]?([0-9]+)) ?(len)? ?([0-9]+)?/) {
  1751. $hash->{scanOType} = substr($1,0,1);
  1752. $hash->{scanOStart} = substr($1,1);
  1753. $hash->{scanOEnd} = $3;
  1754. $hash->{scanOLen} = ($5 ? $5 : 1);
  1755. }
  1756. Log3 $name, 3, "$name: Scan $hash->{scanOType} from $hash->{scanOStart} to $hash->{scanOEnd} len $hash->{scanOLen}";
  1757. delete $hash->{scanOAdr};
  1758. my $now = gettimeofday();
  1759. my $scanDelay = AttrVal($name, "scanDelay", 1);
  1760. RemoveInternalTimer ("scan:$name");
  1761. InternalTimer($now+$scanDelay, "ModbusLD_ScanObjects", "scan:$name", 0);
  1762. return "0";
  1763. } elsif ($setName eq 'saveAsModule') {
  1764. my $fName = $setVal;
  1765. my $out;
  1766. my $last = "x";
  1767. if (!open($out, ">", "/tmp/98_ModbusGen$fName.pm")) {
  1768. Log3 $name, 3, "$name: Cannot create output file $hash->{OUTPUT}";
  1769. return;
  1770. };
  1771. print $out "
  1772. ##############################################
  1773. # \$Id: 98_ModbusGen${fName}.pm \$
  1774. # von ModbusAttr generiertes Modul
  1775. package main;
  1776. use strict;
  1777. use warnings;
  1778. ";
  1779. print $out "sub ModbusGen${fName}_Initialize(\$);\n";
  1780. print $out "my %ModbusGen${fName}parseInfo = (\n";
  1781. foreach my $a (sort keys %{$attr{$name}}) {
  1782. if ($a =~ /^obj-([^\-]+)-(.*)$/) {
  1783. if ($1 ne $last) {
  1784. if ($last ne "x") {
  1785. # Abschluss des letzten Eintrags
  1786. printf $out "%26s", "},\n";
  1787. }
  1788. # Neuer Key
  1789. printf $out "%2s", " ";
  1790. printf $out "%16s%s", "\"$1\"", " => { ";
  1791. $last = $1;
  1792. } else {
  1793. printf $out "%25s", " ";
  1794. }
  1795. printf $out "%15s%s", "\'".$2."\'", " => \'$attr{$name}{$a}\',\n";
  1796. }
  1797. }
  1798. printf $out "%28s", "}\n";
  1799. print $out ");\n\n";
  1800. print $out "my %ModbusGen${fName}deviceInfo = (\n";
  1801. $last = "x";
  1802. foreach my $a (sort keys %{$attr{$name}}) {
  1803. if ($a =~ /^dev-((type-)?[^\-]+)-(.*)$/) {
  1804. if ($1 ne $last) {
  1805. if ($last ne "x") {
  1806. printf $out "%26s", "},\n";
  1807. }
  1808. printf $out "%2s", " ";
  1809. printf $out "%16s%s", "\"$1\"", " => { ";
  1810. $last = $1;
  1811. } else {
  1812. printf $out "%25s", " ";
  1813. }
  1814. printf $out "%15s%s", "\'".$3."\'", " => \'$attr{$name}{$a}\',\n";
  1815. }
  1816. }
  1817. printf $out "%28s", "}\n";
  1818. print $out ");\n\n";
  1819. print $out "
  1820. #####################################
  1821. sub ModbusGen${fName}_Initialize(\$)
  1822. {
  1823. my (\$modHash) = \@_;
  1824. require \"\$attr{global}{modpath}/FHEM/98_Modbus.pm\";
  1825. \$modHash->{parseInfo} = \\%ModbusGen${fName}parseInfo; # defines registers, inputs, coils etc. for this Modbus Defive
  1826. \$modHash->{deviceInfo} = \\%ModbusGen${fName}deviceInfo; # defines properties of the device like defaults and supported function codes
  1827. ModbusLD_Initialize(\$modHash); # Generic function of the Modbus module does the rest
  1828. \$modHash->{AttrList} = \$modHash->{AttrList} . \" \" . # Standard Attributes like IODEv etc
  1829. \$modHash->{ObjAttrList} . \" \" . # Attributes to add or overwrite parseInfo definitions
  1830. \$modHash->{DevAttrList} . \" \" . # Attributes to add or overwrite devInfo definitions
  1831. \"poll-.* \" . # overwrite poll with poll-ReadingName
  1832. \"polldelay-.* \"; # overwrite polldelay with polldelay-ReadingName
  1833. }
  1834. ";
  1835. return "0";
  1836. }
  1837. return undef; # no control set identified - continue with other sets
  1838. }
  1839. #####################################
  1840. # called via internal timer from
  1841. # logical device module with
  1842. # scan:name - name of logical device
  1843. #
  1844. sub ModbusLD_ScanObjects($) {
  1845. my $param = shift;
  1846. my ($calltype,$name) = split(':',$param);
  1847. my $hash = $defs{$name}; # hash des logischen Devices, da GetUpdate aus dem logischen Modul per Timer gestartet wird
  1848. my $now = gettimeofday();
  1849. my $scanDelay = AttrVal($name, "scanDelay", 1);
  1850. my $ioHash = ModbusLD_GetIOHash($hash);
  1851. my $queue = $ioHash->{QUEUE};
  1852. my $qlen = ($ioHash->{QUEUE} ? scalar(@{$ioHash->{QUEUE}}) : 0);
  1853. RemoveInternalTimer ("scan:$name");
  1854. if ($qlen && $qlen > AttrVal($name, "queueMax", 100) / 2) {
  1855. InternalTimer($now+$scanDelay, "ModbusLD_ScanObjects", "scan:$name", 0);
  1856. Log3 $name, 5, "$name: ScanObjects waits until queue gets smaller";
  1857. return;
  1858. }
  1859. if ($hash->{scanOAdr} || $hash->{scanOAdr} eq "0") {
  1860. if ($hash->{scanOAdr} < $hash->{scanOEnd}) {
  1861. $hash->{scanOAdr}++;
  1862. } else {
  1863. delete $hash->{scanOAdr};
  1864. delete $hash->{scanOStart};
  1865. delete $hash->{scanOEnd};
  1866. delete $hash->{scanOType};
  1867. delete $hash->{scanOLen};
  1868. return; # end
  1869. }
  1870. } else {
  1871. $hash->{scanOAdr} = $hash->{scanOStart};
  1872. }
  1873. ModbusLD_Send ($hash, $hash->{scanOType}.$hash->{scanOAdr}, 'scanobj', 0, 0, $hash->{scanOLen});
  1874. InternalTimer($now+$scanDelay, "ModbusLD_ScanObjects", "scan:$name", 0);
  1875. return;
  1876. }
  1877. #####################################
  1878. # called via internal timer from
  1879. # logical device module with
  1880. # scan:name - name of logical device
  1881. #
  1882. sub ModbusLD_ScanIds($) {
  1883. my $param = shift;
  1884. my ($calltype,$name) = split(':',$param);
  1885. my $hash = $defs{$name}; # hash des logischen Devices, da GetUpdate aus dem logischen Modul per Timer gestartet wird
  1886. my $now = gettimeofday();
  1887. my $scanDelay = AttrVal($name, "scanDelay", 1);
  1888. my $ioHash = ModbusLD_GetIOHash($hash);
  1889. my $queue = $ioHash->{QUEUE};
  1890. my $qLen = ($ioHash->{QUEUE} ? scalar(@{$ioHash->{QUEUE}}) : 0);
  1891. my $qMax = AttrVal($name, "queueMax", 100) / 2;
  1892. RemoveInternalTimer ("scan:$name");
  1893. if ($qLen && $qLen > $qMax) {
  1894. InternalTimer($now+$scanDelay, "ModbusLD_ScanIds", "scan:$name", 0);
  1895. Log3 $name, 5, "$name: ScanIds waits until queue gets smaller";
  1896. return;
  1897. }
  1898. if ($hash->{scanId}) {
  1899. if ($hash->{scanId} < $hash->{scanIdEnd}) {
  1900. $hash->{scanId}++;
  1901. } else {
  1902. delete $hash->{scanId};
  1903. delete $hash->{scanIdStart};
  1904. delete $hash->{scanIdEnd};
  1905. delete $hash->{scanOAdr};
  1906. delete $hash->{scanOLen};
  1907. delete $hash->{scanOType};
  1908. return; # end
  1909. }
  1910. } else {
  1911. $hash->{scanId} = $hash->{scanIdStart};
  1912. }
  1913. ModbusLD_Send ($hash, $hash->{scanOType}.$hash->{scanOAdr}, 'scanid'.$hash->{scanId}, 0, 0, $hash->{scanOLen});
  1914. InternalTimer($now+$scanDelay, "ModbusLD_ScanIds", "scan:$name", 0);
  1915. return;
  1916. }
  1917. #####################################
  1918. # called via expr
  1919. sub ModbusLD_ScanFormat($$)
  1920. {
  1921. my ($hash, $val) = @_;
  1922. my $name = $hash->{NAME};
  1923. use bytes;
  1924. my $len = length($val);
  1925. my $i = unpack("s", $val);
  1926. my $n = unpack("S", $val);
  1927. my $h = unpack("H*", $val);
  1928. Log3 $name, 5, "$name: ScanFormat: hex=$h, bytes=$len";
  1929. my $ret = "hex=$h, string=";
  1930. for my $c (split //, $val) {
  1931. if ($c =~ /[[:graph:]]/) {
  1932. $ret .= $c;
  1933. } else {
  1934. $ret .= ".";
  1935. }
  1936. }
  1937. $ret .= ", s=" . unpack("s", $val) .
  1938. ", s>=" . unpack("s>", $val) .
  1939. ", S=" . unpack("S", $val) .
  1940. ", S>=" . unpack("S>", $val);
  1941. if ($len > 2) {
  1942. $ret .= ", i=" . unpack("s", $val) .
  1943. ", i>=" . unpack("s>", $val) .
  1944. ", I=" . unpack("S", $val) .
  1945. ", I>=" . unpack("S>", $val);
  1946. $ret .= ", f=" . unpack("f", $val) .
  1947. ", f>=" . unpack("f>", $val);
  1948. #my $r1 = substr($h, 0, 4);
  1949. #my $r2 = substr($h, 4, 4);
  1950. #my $rev = pack ("H*", $r2 . $r1);
  1951. #$ret .= ", revf=" . unpack("f", $rev) .
  1952. #", revf>=" . unpack("f>", $rev);
  1953. }
  1954. return $ret;
  1955. }
  1956. #####################################
  1957. sub ModbusLD_Set($@)
  1958. {
  1959. my ($hash, @a) = @_;
  1960. return "\"set $a[0]\" needs at least an argument" if(@a < 2);
  1961. my ($name, $setName, @setValArr) = @a;
  1962. my $setVal = (@setValArr ? join(' ', @setValArr) : "");
  1963. my $rawVal = "";
  1964. if (AttrVal($name, "enableControlSet", undef)) { # spezielle Sets freigeschaltet?
  1965. my $error = ModbusLD_ControlSet($hash, $setName, $setVal);
  1966. return if (defined($error) && $error eq "0"); # control set found and done.
  1967. return $error if ($error); # error
  1968. # continue if function returned undef
  1969. }
  1970. my $objCombi;
  1971. if ($setName ne "?") {
  1972. $objCombi = ModbusLD_ObjKey($hash, $setName);
  1973. #Log3 $name, 5, "$name: Set: key for $setName = $objCombi";
  1974. }
  1975. if (!$objCombi) {
  1976. ModbusLD_UpdateGetSetList($hash) if ($hash->{".updateSetGet"});
  1977. Log3 $name, 5, "$name: Set: $setName not found, return list $hash->{'.setList'}"
  1978. if ($setName ne "?");
  1979. return "Unknown argument $a[1], choose one of $hash->{'.setList'}";
  1980. }
  1981. if (IsDisabled($name)) {
  1982. Log3 $name, 4, "$name: set called with $setName but device is disabled";
  1983. return;
  1984. }
  1985. my $ioHash = ModbusLD_GetIOHash($hash); # get or reconstruct ioHash. reconnecton is done in Queue handling if necessary
  1986. return if (!$ioHash);
  1987. my $type = substr($objCombi, 0, 1);
  1988. my ($err,$result);
  1989. # todo: noarg checking?
  1990. if (!defined($setVal)) {
  1991. Log3 $name, 3, "$name: No Value given to set $setName";
  1992. return "No Value given to set $setName";
  1993. }
  1994. Log3 $name, 5, "$name: Set called with $setName ($objCombi), setVal = $setVal";
  1995. if ($ioHash->{BUSY}) {
  1996. Log3 $name, 5, "$name: Set: Queue still busy - taking over the read with ReadAnswer";
  1997. # Answer for last function code has not yet arrived
  1998. ModbusLD_ReadAnswer($hash); # finish last read and wait for the result before next request
  1999. Modbus_EndBUSY ($ioHash); # set BUSY to 0, delete REQUEST, clear Buffer, do Profilig
  2000. }
  2001. my $map = ModbusLD_ObjInfo($hash, $objCombi, "map", "defMap");
  2002. my $setmin = ModbusLD_ObjInfo($hash, $objCombi, "min", "", ""); # default to ""
  2003. my $setmax = ModbusLD_ObjInfo($hash, $objCombi, "max", "", ""); # default to ""
  2004. my $setexpr = ModbusLD_ObjInfo($hash, $objCombi, "setexpr");
  2005. my $textArg = ModbusLD_ObjInfo($hash, $objCombi, "textArg");
  2006. my $unpack = ModbusLD_ObjInfo($hash, $objCombi, "unpack", "defUnpack", "n");
  2007. my $revRegs = ModbusLD_ObjInfo($hash, $objCombi, "revRegs", "defRevRegs");
  2008. my $swpRegs = ModbusLD_ObjInfo($hash, $objCombi, "bswapRegs", "defBswapRegs");
  2009. my $len = ModbusLD_ObjInfo($hash, $objCombi, "len", "defLen", 1);
  2010. my $fCode = ModbusLD_DevInfo($hash, $type, "write", $Modbus_defaultFCode{$type}{write});
  2011. if ($map) { # 1. Schritt: Map prüfen
  2012. my $rm = $map;
  2013. $rm =~ s/([^ ,\$]+):([^ ,\$]+),? ?/$2 $1 /g; # reverse map string erzeugen
  2014. my %rmap = split (' ', $rm); # reverse hash aus dem reverse string
  2015. if (defined($rmap{$setVal})) { # reverse map Eintrag für das Reading und den Wert definiert
  2016. $rawVal = $rmap{$setVal};
  2017. Log3 $name, 5, "$name: Set: found $setVal in map and converted to $rawVal";
  2018. } else { # Wert nicht in der Map
  2019. Log3 $name, 3, "$name: Set: Value $setVal did not match defined map";
  2020. return "Set Value $setVal did not match defined map";
  2021. }
  2022. } else {
  2023. $rawVal = $setVal;
  2024. }
  2025. if ($rawVal =~ /^\s*-?\d+\.?\d*\s*$/) { # a number (potentially with blanks)
  2026. $rawVal =~ s/\s+//g if (!$textArg); # remove blanks
  2027. if ($setmin ne "") { # 2. Schritt: falls definiert Min- und Max-Werte prüfen
  2028. Log3 $name, 5, "$name: Set: checking value $rawVal against min $setmin";
  2029. return "value $rawVal is smaller than min ($setmin)" if ($rawVal < $setmin);
  2030. }
  2031. if ($setmax ne "") {
  2032. Log3 $name, 5, "$name: Set: checking value $rawVal against max $setmax";
  2033. return "value $rawVal is bigger than max ($setmax)" if ($rawVal > $setmax);
  2034. }
  2035. } else {
  2036. if (!$textArg) {
  2037. Log3 $name, 3, "$name: Set: Value $rawVal is not numeric and textArg not specified";
  2038. return "Set Value $rawVal is not numeric and textArg not specified";
  2039. }
  2040. }
  2041. # 3. Schritt: Konvertiere mit setexpr falls definiert
  2042. $rawVal = Modbus_CheckEval($hash, $rawVal, $setexpr, "Set", "setexpr for $setName") if ($setexpr);
  2043. my $packedVal = pack ($unpack, $rawVal);
  2044. Log3 $name, 5, "$name: set packed hex " . unpack ('H*', $rawVal) . " with $unpack to hex " . unpack ('H*', $packedVal);
  2045. $packedVal = Modbus_RevRegs($hash, $packedVal, $len) if ($revRegs && $len > 1);
  2046. $packedVal = Modbus_SwpRegs($hash, $packedVal, $len) if ($swpRegs);
  2047. if (AttrVal($name, "nonPrioritizedSet", 0)) {
  2048. ModbusLD_Send($hash, $objCombi, "write", $packedVal, 0); # no force, just queue
  2049. } else {
  2050. ModbusLD_Send($hash, $objCombi, "write", $packedVal, 1); # add at beginning and force send / sleep if necessary
  2051. ($err, $result) = ModbusLD_ReadAnswer($hash, $setName);
  2052. Modbus_EndBUSY ($ioHash); # set BUSY to 0, delete REQUEST, clear Buffer, do Profilig
  2053. return $err if ($err);
  2054. }
  2055. if ($fCode == 15 || $fCode == 16) {
  2056. # read after write
  2057. Log3 $name, 5, "$name: Set: sending read after write";
  2058. if (AttrVal($name, "nonPrioritizedSet", 0)) {
  2059. ModbusLD_Send($hash, $objCombi, "read", 0, 0); # no force, just queue
  2060. } else {
  2061. ModbusLD_Send($hash, $objCombi, "read", 0, 1); # add at beginning and force send / sleep if necessary
  2062. ($err, $result) = ModbusLD_ReadAnswer($hash, $setName);
  2063. Modbus_EndBUSY ($ioHash); # set BUSY to 0, delete REQUEST, clear Buffer, do Profilig
  2064. return "$err (in read after write for FCode 16)" if ($err);
  2065. }
  2066. }
  2067. return; # no return code if no error
  2068. }
  2069. ###############################################
  2070. # Called from get / set to get a direct answer
  2071. # called with logical device hash
  2072. # has to return a value and an error separately
  2073. # so set can ignore the value and only return an error
  2074. # whereas get needs the value or error
  2075. sub ModbusLD_ReadAnswer($;$)
  2076. {
  2077. my ($hash, $reading) = @_;
  2078. my $name = $hash->{NAME};
  2079. my $now = gettimeofday();
  2080. my $ioHash = ModbusLD_GetIOHash($hash);
  2081. my $ioName = $ioHash->{NAME};
  2082. Log3 $name, 3, "$name: _ReadAnswer called but IO Device is disabled" if (IsDisabled ($ioName));
  2083. return ("IO Device is disabled", undef) if (IsDisabled ($ioName));
  2084. return ("No FD", undef) if (!$ioHash);
  2085. return ("No FD", undef) if ($^O !~ /Win/ && !defined($ioHash->{FD}));
  2086. my $buf;
  2087. my $rin = '';
  2088. # get timeout. In case ReadAnswer is called after a delay
  2089. # only wait for remaining time
  2090. my $to = ModbusLD_DevInfo($hash, "timing", "timeout", 2);
  2091. my $rest = ($ioHash->{nextTimeout} ? $ioHash->{nextTimeout} - $now : 0);
  2092. if ($rest <= 0) {
  2093. Log3 $name, 5, "$name: ReadAnswer called but timeout already over" .
  2094. ($reading ? " requested reading was $reading" : "");
  2095. return ("Timeout reading answer", undef);
  2096. }
  2097. if ($rest < $to) {
  2098. Log3 $name, 5, "$name: ReadAnswer called and remaining timeout is $rest" .
  2099. ($reading ? " requested reading is $reading" : "");
  2100. $to = $rest;
  2101. } else {
  2102. Log3 $name, 5, "$name: ReadAnswer called" . ($reading ? " for $reading" : "");
  2103. }
  2104. delete $hash->{gotReadings};
  2105. $reading = "" if (!$reading);
  2106. Modbus_Profiler($ioHash, "Read");
  2107. for(;;) {
  2108. if($^O =~ m/Win/ && $ioHash->{USBDev}) {
  2109. $ioHash->{USBDev}->read_const_time($to*1000); # set timeout (ms)
  2110. $buf = $ioHash->{USBDev}->read(999);
  2111. if(length($buf) == 0) {
  2112. my $logLvl = AttrVal($ioHash->{NAME}, "timeoutLogLevel", 3);
  2113. Log3 $name, $logLvl, "$name: Timeout in ReadAnswer" . ($reading ? " for $reading" : "");
  2114. Modbus_CountTimeouts ($ioHash);
  2115. return ("Timeout reading answer", undef)
  2116. }
  2117. } else {
  2118. if(!$ioHash->{FD}) {
  2119. Log3 $name, 3, "$name: Device lost in ReadAnswer". ($reading ? " for $reading" : "");
  2120. return ("Device lost when reading answer", undef);
  2121. }
  2122. vec($rin, $ioHash->{FD}, 1) = 1; # setze entsprechendes Bit in rin
  2123. my $nfound = select($rin, undef, undef, $to);
  2124. if($nfound < 0) {
  2125. next if ($! == EAGAIN() || $! == EINTR() || $! == 0);
  2126. my $err = $!;
  2127. DevIo_Disconnected($ioHash);
  2128. Log3 $name, 3, "$name: ReadAnswer error: $err";
  2129. return("Modbus_ReadAnswer error: $err", undef);
  2130. }
  2131. if($nfound == 0) {
  2132. my $logLvl = AttrVal($ioHash->{NAME}, "timeoutLogLevel", 3);
  2133. Log3 $name, $logLvl, "$name: Timeout2 in ReadAnswer" . ($reading ? " for $reading" : "");
  2134. Modbus_CountTimeouts ($ioHash);
  2135. return ("Timeout reading answer", undef);
  2136. }
  2137. $buf = DevIo_SimpleRead($ioHash);
  2138. if(!defined($buf)) {
  2139. Log3 $name, 3, "$name: ReadAnswer got no data" . ($reading ? " for $reading" : "");
  2140. return ("No data", undef);
  2141. }
  2142. }
  2143. if($buf) {
  2144. $ioHash->{helper}{buffer} .= $buf;
  2145. $now = gettimeofday();
  2146. $hash->{helper}{lrecv} = $now;
  2147. $ioHash->{helper}{lrecv} = $now;
  2148. Log3 $name, 5, "$name: ReadAnswer got: " . unpack ("H*", $ioHash->{helper}{buffer});
  2149. }
  2150. my $code = Modbus_ParseFrames($ioHash);
  2151. if ($code) {
  2152. if ($code ne "1") {
  2153. Log3 $name, 5, "$name: ReadAnswer: ParseFrames returned error: $code";
  2154. return ($code, undef);
  2155. }
  2156. Log3 $name, 5, "$name: ReadAnswer done" . ($reading ? ", reading is $reading" : "") .
  2157. (defined($hash->{gotReadings}{$reading}) ? ", value: $hash->{gotReadings}{$reading}" : "");
  2158. if ($reading && defined($hash->{gotReadings}{$reading})) {
  2159. return (undef, $hash->{gotReadings}{$reading}); # no error
  2160. }
  2161. return (undef, undef); # no error but also no value
  2162. }
  2163. }
  2164. return ("no Data", undef);
  2165. }
  2166. sub Modbus_compObjKeys ($$) {
  2167. my ($a, $b) = @_;
  2168. my $aType = substr($a, 0, 1);
  2169. my $aStart = substr($a, 1);
  2170. my $bType = substr($b, 0, 1);
  2171. my $bStart = substr($b, 1);
  2172. my $result = ($aType cmp $bType);
  2173. if ($result) {
  2174. return $result;
  2175. }
  2176. $result = $aStart <=> $bStart;
  2177. return $result;
  2178. }
  2179. #####################################
  2180. # called via internal timer from
  2181. # logical device module with
  2182. # update:name - name of logical device
  2183. #
  2184. sub ModbusLD_GetUpdate($) {
  2185. my $param = shift;
  2186. my ($calltype,$name) = split(':',$param);
  2187. my $hash = $defs{$name}; # hash des logischen Devices, da GetUpdate aus dem logischen Modul per Timer gestartet wird
  2188. my $modHash = $modules{$hash->{TYPE}};
  2189. my $parseInfo = $modHash->{parseInfo};
  2190. my $devInfo = $modHash->{deviceInfo};
  2191. my $now = gettimeofday();
  2192. my $ioHash = ModbusLD_GetIOHash($hash);
  2193. Log3 $name, 5, "$name: GetUpdate called";
  2194. if ($calltype eq "update") { ## todo check if interval > min
  2195. ModbusLD_SetTimer($hash);
  2196. }
  2197. if (IsDisabled($name)) {
  2198. Log3 $name, 5, "$name: GetUpdate called but device is disabled";
  2199. return;
  2200. }
  2201. return if (!$ioHash);
  2202. if ($ioHash->{STATE} eq "disconnected") {
  2203. Log3 $name, 5, "$name: GetUpdate called, but device is disconnected";
  2204. return;
  2205. }
  2206. Modbus_Profiler($ioHash, "Fhem");
  2207. my @ObjList;
  2208. my %readList;
  2209. foreach my $at (keys %{$attr{$name}}) {
  2210. if ($at =~ /^obj-(.*)-reading$/) {
  2211. push @ObjList, $1 if (!$parseInfo->{$1});
  2212. }
  2213. };
  2214. Log3 $name, 5, "$name: GetUpdate objects from attributes: " . join (" ", @ObjList);
  2215. push @ObjList, keys (%{$parseInfo});
  2216. Log3 $name, 5, "$name: GetUpdate full object list: " . join (" ", sort @ObjList);
  2217. # create readList by checking delays and poll settings for ObjList
  2218. foreach my $objCombi (sort @ObjList) {
  2219. #my $type = substr($objCombi, 0, 1);
  2220. #my $adr = substr($objCombi, 1);
  2221. my $reading = ModbusLD_ObjInfo($hash, $objCombi, "reading");
  2222. my $objHashRef = $parseInfo->{$objCombi};
  2223. #my $devTypeRef = $devInfo->{$type};
  2224. my $poll = ModbusLD_ObjInfo($hash, $objCombi, "poll", "defPoll", 0);
  2225. my $lastRead = ($hash->{lastRead}{$objCombi} ? $hash->{lastRead}{$objCombi} : 0);
  2226. Log3 $name, 5, "$name: GetUpdate check $objCombi => $reading, poll = $poll, last = $lastRead";
  2227. if (($poll && $poll ne "once") || ($poll eq "once" && !$lastRead)) {
  2228. my $delay = ModbusLD_ObjInfo($hash, $objCombi, "polldelay", "", "0.5");
  2229. if ($delay =~ "^x([0-9]+)") {
  2230. $delay = $1 * $hash->{INTERVAL}; # Delay als Multiplikator des Intervalls falls es mit x beginnt.
  2231. }
  2232. if ($now >= $lastRead + $delay) {
  2233. Log3 $name, 4, "$name: GetUpdate will request $reading";
  2234. $readList{$objCombi} = 1; # include it in the list of items to read
  2235. # lastRead wird bei erfolgreichem Lesen in ParseObj gesetzt.
  2236. } else {
  2237. Log3 $name, 5, "$name: GetUpdate will skip $reading, delay not over";
  2238. }
  2239. }
  2240. }
  2241. Log3 $name, 5, "$name: GetUpdate tries to combine read commands";
  2242. my ($obj, $type, $adr, $reading, $len, $span);
  2243. my ($nextObj, $nextType, $nextAdr, $nextReading, $nextLen, $nextSpan);
  2244. my $maxLen;
  2245. $adr = 0; $type = ""; $span = 0; $nextSpan = 0;
  2246. # combine objects in Readlist by increasing the length of a first object and removing the second
  2247. foreach $nextObj (sort Modbus_compObjKeys keys %readList) {
  2248. $nextType = substr($nextObj, 0, 1);
  2249. $nextAdr = substr($nextObj, 1);
  2250. $nextReading = ModbusLD_ObjInfo($hash, $nextObj, "reading");
  2251. $nextLen = ModbusLD_ObjInfo($hash, $nextObj, "len", "defLen", 1);
  2252. $readList{$nextObj} = $nextLen;
  2253. if ($obj && $maxLen){
  2254. $nextSpan = ($nextAdr + $nextLen) - $adr; # Combined length with next object
  2255. if ($nextType eq $type && $nextSpan <= $maxLen && $nextSpan > $span) {
  2256. Log3 $name, 5, "$name: Combine $reading ($obj) with $nextReading ($nextObj), ".
  2257. "span=$nextSpan, max=$maxLen, drop read for $nextObj";
  2258. delete $readList{$nextObj}; # no individual read for this object, combine with last
  2259. $span = $nextSpan;
  2260. $readList{$obj} = $nextSpan; # increase the length to include following object
  2261. next; # don't change current object variables
  2262. } else {
  2263. Log3 $name, 5, "$name: No Combine $reading / $obj with $nextReading / $nextObj, ".
  2264. "span $nextSpan > max $maxLen";
  2265. $nextSpan = 0;
  2266. }
  2267. }
  2268. ($obj, $type, $adr, $reading, $len, $span) = ($nextObj, $nextType, $nextAdr, $nextReading, $nextLen, $nextSpan);
  2269. $maxLen = ModbusLD_DevInfo($hash, $type, "combine", 1);
  2270. # Log3 $name, 5, "$name: GetUpdate: combine for $type is $maxLen";
  2271. }
  2272. if (AttrVal($name, "sortUpdate", 0)) {
  2273. Log3 $name, 5, "$name: sort objList before sending requests";
  2274. foreach my $objCombi (sort Modbus_compObjKeys keys %readList) {
  2275. my $span = $readList{$objCombi};
  2276. ModbusLD_Send($hash, $objCombi, "read", 0, 0, $span);
  2277. }
  2278. } else {
  2279. Log3 $name, 5, "$name: don't sort objList before sending requests";
  2280. while (my ($objCombi, $span) = each %readList) {
  2281. ModbusLD_Send($hash, $objCombi, "read", 0, 0, $span);
  2282. }
  2283. }
  2284. Modbus_Profiler($ioHash, "Idle");
  2285. return;
  2286. }
  2287. ######################################
  2288. # called from logical device fuctions
  2289. # with log dev hash to get the
  2290. # physical io device hash
  2291. sub ModbusLD_GetIOHash($){
  2292. my $hash = shift;
  2293. my $name = $hash->{NAME}; # name of logical device
  2294. my $ioHash;
  2295. #Log3 $name, 5, "$name: GetIOHash, TYPE = $hash->{TYPE}" . ($hash->{DEST} ? ", DEST = $hash->{DEST}" : "");
  2296. if ($hash->{TYPE} eq "Modbus") {
  2297. # physical Device
  2298. return $hash;
  2299. } else {
  2300. # logical Device
  2301. if ($hash->{DEST}) {
  2302. return $hash; # Modbus TCP/RTU/ASCII über TCP, physical hash = logical hash
  2303. } else {
  2304. return $hash->{IODev} if ($hash->{IODev}); # logical device needs pointer to physical device (IODev)
  2305. if (ModbusLD_SetIODev($hash)) {
  2306. return $hash->{IODev};
  2307. }
  2308. Log3 $name, 3, "$name: no IODev attribute or matching physical Modbus-device found for $hash->{NAME}";
  2309. }
  2310. }
  2311. return;
  2312. }
  2313. #####################################
  2314. # called from send and parse
  2315. # reverse order of word registers
  2316. sub Modbus_RevRegs($$$) {
  2317. my ($hash, $buffer, $len) = @_; # hash only needed for logging
  2318. my $name = $hash->{NAME}; # name of device for logging
  2319. Log3 $name, 5, "$name: RevRegs: reversing order of up to $len registers";
  2320. my $work = substr($buffer, 0, $len * 2); # the first 2*len bytes of buffer
  2321. my $rest = substr($buffer, $len * 2); # everything after len
  2322. my $new = "";
  2323. while ($work) {
  2324. $new = substr($work, 0, 2) . $new; # prepend first two bytes of work to new
  2325. $work = substr($work, 2); # remove first word from work
  2326. }
  2327. Log3 $name, 5, "$name: RevRegs: string before is " . unpack ("H*", $buffer);
  2328. $buffer = $new . $rest;
  2329. Log3 $name, 5, "$name: RevRegs: string after is " . unpack ("H*", $buffer);
  2330. return $buffer;
  2331. }
  2332. #####################################
  2333. # called from send and parse
  2334. # reverse byte order in word registers
  2335. sub Modbus_SwpRegs($$$) {
  2336. my ($hash, $buffer, $len) = @_; # hash only needed for logging
  2337. my $name = $hash->{NAME}; # name of device for logging
  2338. Log3 $name, 5, "$name: SwpRegs: reversing byte order of up to $len registers";
  2339. my $rest = substr($buffer, $len * 2); # everything after len
  2340. my $nval = "";
  2341. for (my $i = 0; $i < $len; $i++) {
  2342. $nval = $nval . substr($buffer,$i*2 + 1,1) . substr($buffer,$i*2,1);
  2343. };
  2344. Log3 $name, 5, "$name: SwpRegs: string before is " . unpack ("H*", $buffer);
  2345. $buffer = $nval . $rest;
  2346. Log3 $name, 5, "$name: SwpRegs: string after is " . unpack ("H*", $buffer);
  2347. return $buffer;
  2348. }
  2349. #####################################
  2350. # called from logical device functions
  2351. # with log dev hash
  2352. sub ModbusLD_Send($$$;$$$){
  2353. my ($hash, $objCombi, $op, $v1, $force, $reqLen) = @_;
  2354. # $hash : the logival Device hash
  2355. # $objCombi : type+adr
  2356. # $op : read, write or scanids/scanobj
  2357. # $v1 : value for writing (already packed)
  2358. # $force : put in front of queue and don't reschedule but wait if necessary
  2359. my $name = $hash->{NAME}; # name of logical device
  2360. my $devId = ($op =~ /^scanid([0-9]+)/ ? $1 : $hash->{MODBUSID});
  2361. my $proto = $hash->{PROTOCOL};
  2362. my $ioHash = ModbusLD_GetIOHash($hash);
  2363. my $type = substr($objCombi, 0, 1);
  2364. my $adr = substr($objCombi, 1);
  2365. my $reading = ModbusLD_ObjInfo($hash, $objCombi, "reading");
  2366. my $objLen = ModbusLD_ObjInfo($hash, $objCombi, "len", "defLen", 1);
  2367. my $fcKey = $op;
  2368. if ($op =~ /^scan/) {
  2369. $objLen = $reqLen; # for scan there is no objLen but reqLen is given - avoid confusing log and set objLen ...
  2370. $fcKey = 'read';
  2371. }
  2372. return if (!$ioHash);
  2373. my $ioName = $ioHash->{NAME};
  2374. my $qlen = ($ioHash->{QUEUE} ? scalar(@{$ioHash->{QUEUE}}) : 0);
  2375. Log3 $name, 3, "$name: _Send called but IO Device is disabled" if (IsDisabled ($ioName));
  2376. Log3 $name, 4, "$name: Send called with $type$adr, objLen $objLen / reqLen " .
  2377. ($reqLen ? $reqLen : "-") . " to id $devId, op $op, qlen $qlen" .
  2378. ((defined($v1) && $op eq 'write') ? ", value hex " . unpack ('H*', $v1) : "");
  2379. $reqLen = $objLen if (!$reqLen); # reqLen given as parameter (only for combined read requests from GetUpdate or scans)
  2380. my $unpack = ModbusLD_ObjInfo($hash, $objCombi, "unpack", "defUnpack", "n");
  2381. if ($objLen < 2 && $unpack =~ /lLIqQfFNVD/) {
  2382. Log3 $name, 3, "$name: _Send with unpack $unpack but len seems too small - please set obj-${objCombi}-Len!";
  2383. }
  2384. if ($qlen && AttrVal($ioName, "dropQueueDoubles", 0)) {
  2385. Log3 $name, 5, "$name: Send is checking if request is already in queue ($qlen requests)";
  2386. foreach my $elem (@{$ioHash->{QUEUE}}) {
  2387. Log3 $name, 5, "$name: is it $elem->{TYPE} $elem->{ADR} reqLen $elem->{LEN} to id $elem->{MODBUSID}?";
  2388. if($elem->{ADR} == $adr && $elem->{TYPE} eq $type
  2389. && $elem->{LEN} == $reqLen && $elem->{MODBUSID} eq $devId) {
  2390. Log3 $name, 4, "$name: request already in queue - dropping";
  2391. return;
  2392. }
  2393. }
  2394. }
  2395. my $tid = int(rand(255));
  2396. my %request;
  2397. $request{DEVHASH} = $hash; # logical device in charge
  2398. $request{TYPE} = $type; # type of object (cdih)
  2399. $request{ADR} = $adr; # address of object
  2400. $request{LEN} = $reqLen; # number of registers / length of object
  2401. $request{READING} = $reading; # reading name of the object
  2402. $request{TID} = $tid; # transaction id for Modbus TCP
  2403. $request{PROTOCOL} = $proto; # RTU / ASCII / ...
  2404. $request{MODBUSID} = $devId; # ModbusId of the addressed device - coming from logical device hash
  2405. $request{VALUE} = $v1; # Value to be written (set)
  2406. $request{OPERATION} = $op; # read / write / scan
  2407. my $fCode = ModbusLD_DevInfo($hash, $type, $fcKey, $Modbus_defaultFCode{$type}{$fcKey});
  2408. if (!$fCode) {
  2409. Log3 $name, 3, "$name: Send did not find fCode for $fcKey type $type";
  2410. return;
  2411. }
  2412. $request{FCODE} = $fCode; # function code
  2413. Log3 $name, 4, "$name: Send" .
  2414. ($force ? " adds " : " queues ") .
  2415. "fc $fCode to $devId" .
  2416. ($proto eq "TCP" ? ", tid $tid" : "") . ", for $type$adr" .
  2417. ($reading ? " ($reading)" : "") . ", reqLen $reqLen" .
  2418. ((defined($v1) && $op eq 'write') ? ", value hex " . unpack ('H*', $v1) : "") .
  2419. ($force ? " at beginning of queue for immediate sending" : "");
  2420. if(!$qlen) {
  2421. #Log3 $name, 5, "$name: Send is creating new queue";
  2422. $ioHash->{QUEUE} = [ \%request ];
  2423. } else {
  2424. #Log3 $name, 5, "$name: Send initial queue length is $qlen";
  2425. if ($qlen > AttrVal($name, "queueMax", 100)) {
  2426. Log3 $name, 3, "$name: Send queue too long ($qlen), dropping new request";
  2427. } else {
  2428. if ($force) {
  2429. unshift (@{$ioHash->{QUEUE}}, \%request); # an den Anfang
  2430. } else {
  2431. push(@{$ioHash->{QUEUE}}, \%request); # ans Ende
  2432. }
  2433. }
  2434. }
  2435. Modbus_HandleSendQueue("direct:".$ioName, $force); # name is physical device
  2436. return;
  2437. }
  2438. 1;
  2439. =pod
  2440. =item device
  2441. =item summary base module for devices with Modbus Interface
  2442. =item summary_DE Basismodul für Geräte mit Modbus-Interface
  2443. =begin html
  2444. <a name="Modbus"></a>
  2445. <h3>Modbus</h3>
  2446. <ul>
  2447. Modbus defines a physical modbus interface and functions to be called from other logical modules / devices.
  2448. This low level module takes care of the communication with modbus devices and provides Get, Set and cyclic polling
  2449. of Readings as well as formatting and input validation functions.
  2450. The logical device modules for individual machines only need to define the supported modbus function codes and objects of the machine with the modbus interface in data structures. These data structures are then used by this low level module to implement Set, Get and automatic updateing of readings in a given interval.
  2451. <br>
  2452. This version of the Modbus module supports Modbus RTU and ASCII over serial / RS485 lines as well as Modbus TCP and Modbus RTU or RTU over TCP.
  2453. It defines read / write functions for Modbus holding registers, input registers, coils and discrete inputs.
  2454. <br><br>
  2455. <b>Prerequisites</b>
  2456. <ul>
  2457. <li>
  2458. This module requires the Device::SerialPort or Win32::SerialPort module.
  2459. </li>
  2460. </ul>
  2461. <br>
  2462. <a name="ModbusDefine"></a>
  2463. <b>Define</b>
  2464. <ul>
  2465. <code>define &lt;name&gt; Modbus &lt;device&gt; </code>
  2466. <br><br>
  2467. A define of a physical device based on this module is only necessary if a shared physical device like a RS485 USB adapter is used. In the case of Modbus TCP this module will be used as a library for other modules that define all the data objects and no define of the base module is needed.
  2468. <br>
  2469. Example:<br>
  2470. <br>
  2471. <ul><code>define ModBusLine Modbus /dev/ttyUSB1@9600</code></ul>
  2472. <br>
  2473. In this example the module opens the given serial interface and other logical modules can access several Modbus devices connected to this bus concurrently.
  2474. If your device needs special communications parameters like even parity you can add the number of data bits, the parity and the number of stopbits separated by commas after the baudrate e.g.:
  2475. <br>
  2476. <ul><code>define ModBusLine Modbus /dev/ttyUSB2@38400,8,E,2</code></ul>
  2477. <br>
  2478. </ul>
  2479. <br>
  2480. <a name="ModbusSet"></a>
  2481. <b>Set-Commands</b><br>
  2482. <ul>
  2483. this low level device module doesn't provide set commands for itself but implements set
  2484. for logical device modules that make use of this module. See ModbusAttr for example.
  2485. </ul>
  2486. <br>
  2487. <a name="ModbusGet"></a>
  2488. <b>Get-Commands</b><br>
  2489. <ul>
  2490. this low level device module doesn't provide get commands for itself but implements get
  2491. for logical device modules that make use of this module.
  2492. </ul>
  2493. <br>
  2494. <a name="ModbusAttr"></a>
  2495. <b>Attributes</b><br><br>
  2496. <ul>
  2497. <li><a href="#do_not_notify">do_not_notify</a></li>
  2498. <li><a href="#readingFnAttributes">readingFnAttributes</a></li>
  2499. <br>
  2500. <li><b>queueDelay</b></li>
  2501. modify the delay used when sending requests to the device from the internal queue, defaults to 1 second <br>
  2502. <li><b>busDelay</b></li>
  2503. defines a delay that is always enforced between the last read from the bus and the next send to the bus for all connected devices<br>
  2504. <li><b>clientSwitchDelay</b></li>
  2505. defines a delay that is always enforced between the last read from the bus and the next send to the bus for all connected devices but only if the next send goes to a different device than the last one<br>
  2506. <li><b>dropQueueDoubles</b></li>
  2507. prevents new request to be queued if the same request is already in the send queue<br>
  2508. <li><b>skipGarbage</b></li>
  2509. if set to 1 this attribute will enhance the way the module treats Modbus response frames (RTU over serial lines) that look as if they have a wrong Modbus id as their first byte. If skipGarbage is set to 1 then the module will skip all bytes until a byte with the expected modbus id is seen. Under normal circumstances this behavior should not do any harm and lead to more robustness. However since it changes the original behavior of this module it has to be turned on explicitely.<br>
  2510. For Modbus ASCII it skips bytes until the expected starting byte ":" is seen.
  2511. <li><b>profileInterval</b></li>
  2512. if set to something non zero it is the time period in seconds for which the module will create bus usage statistics.
  2513. Please note that this number should be at least twice as big as the interval used for requesting values in logical devices that use this physical device<br>
  2514. The bus usage statistics create the following readings:
  2515. <ul>
  2516. <li><b>Profiler_Delay_sum</b></li>
  2517. seconds used as delays to implement the defined sendDelay and commDelay
  2518. <li><b>Profiler_Fhem_sum</b></li>
  2519. seconds spend processing in the module
  2520. <li><b>Profiler_Idle_sum</b></li>
  2521. idle time
  2522. <li><b>Profiler_Read_sum</b></li>
  2523. seconds spent reading and validating the data read
  2524. <li><b>Profiler_Send_sum</b></li>
  2525. seconds spent preparing and sending data
  2526. <li><b>Profiler_Wait_sum</b></li>
  2527. seconds waiting for a response to a request
  2528. <li><b>Statistics_Requests</b></li>
  2529. number of requests sent
  2530. <li><b>Statistics_Timeouts</b></li>
  2531. timeouts encountered
  2532. </ul>
  2533. </ul>
  2534. <br>
  2535. </ul>
  2536. =end html
  2537. =cut