95_Babble.pm 89 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141214221432144214521462147214821492150215121522153215421552156215721582159216021612162216321642165216621672168216921702171217221732174217521762177217821792180218121822183218421852186218721882189219021912192219321942195219621972198219922002201220222032204220522062207220822092210221122122213221422152216221722182219222022212222222322242225222622272228222922302231223222332234223522362237223822392240224122422243224422452246224722482249225022512252225322542255225622572258225922602261226222632264226522662267226822692270227122722273227422752276227722782279228022812282228322842285228622872288228922902291229222932294229522962297229822992300230123022303
  1. ########################################################################################
  2. #
  3. # Babble.pm
  4. #
  5. # FHEM module for speech control of FHEM devices
  6. #
  7. # Prof. Dr. Peter A. Henning
  8. #
  9. # $Id: 95_Babble.pm 16665 2018-04-27 13:28:29Z phenning $
  10. #
  11. ########################################################################################
  12. #
  13. # This programm is free software; you can redistribute it and/or modify
  14. # it under the terms of the GNU General Public License as published by
  15. # the Free Software Foundation; either version 2 of the License, or
  16. # (at your option) any later version.
  17. #
  18. # The GNU General Public License can be found at
  19. # http://www.gnu.org/copyleft/gpl.html.
  20. # A copy is found in the textfile GPL.txt and important notices to the license
  21. # from the author is found in LICENSE.txt distributed with these scripts.
  22. #
  23. # This script is distributed in the hope that it will be useful,
  24. # but WITHOUT ANY WARRANTY; without even the implied warranty of
  25. # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  26. # GNU General Public License for more details.
  27. #
  28. ########################################################################################
  29. package main;
  30. use strict;
  31. use warnings;
  32. use vars qw(%defs); # FHEM device/button definitions
  33. use vars qw(%intAt); # FHEM at definitions
  34. use vars qw($FW_ME);
  35. use JSON; # imports encode_json, decode_json, to_json and from_json.
  36. use Encode;
  37. my $rive = 0;
  38. my $riveinterpreter;
  39. #-- RiveScript missing in System
  40. if (eval {require RiveScript;1;} ne 1) {
  41. Log 1,"[Babble] the RiveScript module is missing from your Perl installation - chatbot functionality not available";
  42. Log 1," check cpan or https://github.com/aichaos/rivescript-perl for download and installation";
  43. } else {
  44. RiveScript->import();
  45. $rive = 1;
  46. Log 1,"[Babble] the RiveScript module has been imported successfully, chatbot functionality available";
  47. }
  48. #########################
  49. # Global variables
  50. my $babblelinkname = "babbles"; # link text
  51. my $babblehiddenroom = "babbleRoom"; # hidden room
  52. my $babblepublicroom = "babble"; # public room
  53. my $babbleversion = "1.35";
  54. my @babblerows;
  55. my %babble_transtable_EN = (
  56. "ok" => "OK",
  57. "notok" => "Not OK",
  58. "start" => "Start",
  59. "end" => "End",
  60. "add" => "Add",
  61. "added" => "added",
  62. "remove" => "Remove",
  63. "removed" => "removed",
  64. "modify" => "Modify",
  65. "modified" => "modified",
  66. "cancel" => "Cancel",
  67. "status" => "Status",
  68. "notstarted" => "Not started",
  69. "next" => "Next",
  70. "babbledev" => "Babble Devices",
  71. "babbleplaces" => "Babble Places",
  72. "babbleverbs" => "Babble Verbs",
  73. "babblename" => "Babble Name",
  74. "babbletest" => "Babble Test",
  75. "fhemname" => "FHEM Name",
  76. "device" => "Device",
  77. "place" => "Place",
  78. "places" => "Places",
  79. "rooms" => "Rooms",
  80. "verb" => "Verb",
  81. "target" => "Target",
  82. "result" => "Result",
  83. "unknown" => "unknown",
  84. "infinitive" => "Infinitive",
  85. "conjugations" => "Conjugations and Variations",
  86. "helptext" => "Help Text",
  87. "confirm" => "Confirmation",
  88. "speak" => "Please speak",
  89. "followedby" => "followed by",
  90. "placespec" => "a place specification",
  91. "dnu" => "Sorry, I did not understand this",
  92. "input" => "Input",
  93. "test" => "Test",
  94. "exec" => "Execute",
  95. "value" => "Value",
  96. "save" => "Save",
  97. "action" => "Action",
  98. "time" => "Time",
  99. "description" => "Description",
  100. "settings" => "Settings",
  101. "babbles" => "Babble System",
  102. "setparms" => "Set Parameters",
  103. #--
  104. "hallo" => "Hallo",
  105. "state" => "Security",
  106. "unlocked" => "Unlocked",
  107. "locked" => "Locked"
  108. );
  109. my %babble_transtable_DE = (
  110. "ok" => "OK",
  111. "notok" => "Nicht OK",
  112. "start" => "Start",
  113. "end" => "Ende",
  114. "add" => "Hinzufügen",
  115. "added" => "hinzugefügt",
  116. "remove" => "Entfernen",
  117. "removed" => "entfernt",
  118. "modify" => "Ändern",
  119. "modified" => "geändert",
  120. "cancel" => "Abbruch",
  121. "status" => "Status",
  122. "notstarted" => "Nicht gestartet",
  123. "next" => "Nächste",
  124. "babbledev" => "Babble Devices",
  125. "babbleplaces" => "Babble Orte",
  126. "babbleverbs" => "Babble Verben",
  127. "babblename" => "Babble Name",
  128. "babbletest" => "Babble Test",
  129. "fhemname" => "FHEM Name",
  130. "device" => "Gerät",
  131. "place" => "Ort",
  132. "places" => "Orte",
  133. "rooms" => "Räume",
  134. "verb" => "Verb",
  135. "target" => "Ziel",
  136. "result" => "Ergebnis",
  137. "unknown" => "unbekannt",
  138. "infinitive" => "Infinitiv",
  139. "conjugations" => "Konjugationen und Variationen",
  140. "helptext" => "Hilfetext",
  141. "confirm" => "Bestätigung",
  142. "speak" => "Bitte sprich",
  143. "followedby" => "gefolgt von",
  144. "placespec" => "einer Ortsangabe",
  145. "dnu" => "Es tut mir leid, das habe ich nicht verstanden",
  146. "input" => "Input",
  147. "test" => "Test",
  148. "exec" => "Ausführung",
  149. "value " => "Wert",
  150. "save" => "Sichern",
  151. "action" => "Aktion",
  152. "time" => "Zeit",
  153. "description" => "Beschreibung",
  154. "settings" => "Einstellungen",
  155. "babbles" => "Babble",
  156. "setparms" => "Parameter setzen",
  157. #--
  158. "hallo" => "Hallo",
  159. "state" => "Sicherheit",
  160. "unlocked" => "Unverschlossen",
  161. "locked" => "Verschlossen"
  162. );
  163. my $babble_tt;
  164. #########################################################################################
  165. #
  166. # Babble_Initialize
  167. #
  168. # Parameter hash = hash of device addressed
  169. #
  170. #########################################################################################
  171. sub Babble_Initialize ($) {
  172. my ($hash) = @_;
  173. $hash->{DefFn} = "Babble_Define";
  174. $hash->{SetFn} = "Babble_Set";
  175. $hash->{GetFn} = "Babble_Get";
  176. $hash->{UndefFn} = "Babble_Undef";
  177. #$hash->{AttrFn} = "Babble_Attr";
  178. my $attst = "lockstate:locked,unlocked helpFunc confirmFunc noChatBot:0,1 dnuFile testParm0 testParm1 testParm2 testParm3 ".
  179. "remoteFHEM0 remoteFHEM1 remoteFHEM2 remoteFHEM3 remoteFunc0 remoteFunc1 remoteFunc2 remoteFunc3 remoteToken0 remoteToken1 remoteToken2 remoteToken3 ".
  180. "babbleIds babblePreSubs babbleDevices babblePlaces babbleNotPlaces babbleVerbs babbleVerbParts babblePrepos babbleQuests babbleArticles babbleStatus babbleWrites babbleTimes";
  181. $hash->{AttrList} = $attst;
  182. if( !defined($babble_tt) ){
  183. #-- in any attribute redefinition readjust language
  184. my $lang = AttrVal("global","language","EN");
  185. if( $lang eq "DE"){
  186. $babble_tt = \%babble_transtable_DE;
  187. }else{
  188. $babble_tt = \%babble_transtable_EN;
  189. }
  190. }
  191. $babblelinkname = $babble_tt->{"babbles"};
  192. $data{FWEXT}{babblex}{LINK} = "?room=".$babblehiddenroom;
  193. $data{FWEXT}{babblex}{NAME} = $babblelinkname;
  194. #-- Create a new RiveScript interpreter
  195. Babble_createRive($hash)
  196. if( $rive==1 && !defined($hash->{Rive})) ;
  197. return undef;
  198. }
  199. #########################################################################################
  200. #
  201. # Babble_Define - Implements DefFn function
  202. #
  203. # Parameter hash = hash of device addressed, def = definition string
  204. #
  205. #########################################################################################
  206. sub Babble_Define ($$) {
  207. my ($hash, $def) = @_;
  208. my $now = time();
  209. my $name = $hash->{NAME};
  210. $hash->{VERSION} = $babbleversion;
  211. #-- readjust language
  212. my $lang = AttrVal("global","language","EN");
  213. if( $lang eq "DE"){
  214. $babble_tt = \%babble_transtable_DE;
  215. }else{
  216. $babble_tt = \%babble_transtable_EN;
  217. }
  218. readingsSingleUpdate( $hash, "state", "Initialized", 1 );
  219. $babblehiddenroom = defined($attr{$name}{"hiddenroom"}) ? $attr{$name}{"hiddenroom"} : $babblehiddenroom;
  220. $babblepublicroom = defined($attr{$name}{"publicroom"}) ? $attr{$name}{"publicroom"} : $babblepublicroom;
  221. $data{FWEXT}{babblex}{LINK} = "?room=".$babblehiddenroom;
  222. $data{FWEXT}{babblex}{NAME} = $babblelinkname;
  223. $attr{$name}{"room"} = $babblehiddenroom;;
  224. my $date = Babble_restore($hash,0);
  225. #-- data seems to be ok, restore
  226. if( defined($date) ){
  227. Babble_restore($hash,1);
  228. Log3 $name,1,"[Babble_Define] data hash restored from save file with date $date";
  229. #-- intialization
  230. }else{
  231. $hash->{DATA}{"devs"}=();
  232. $hash->{DATA}{"devcontacts"}=();
  233. $hash->{DATA}{"rooms"}=();
  234. $hash->{DATA}{"splaces"}=();
  235. $hash->{DATA}{"places"}=();
  236. $hash->{DATA}{"commands"}=();
  237. $hash->{DATA}{"help"}=();
  238. $hash->{DATA}{"status"}=();
  239. $hash->{DATA}{"writes"}=();
  240. $hash->{DATA}{"times"}=();
  241. Babble_checkattrs($hash);
  242. Log3 $name,1,"[Babble_Define] data hash is initialized";
  243. }
  244. #-- Create a new RiveScript interpreter
  245. Babble_createRive($hash)
  246. if( $rive==1 && !defined($hash->{Rive})) ;
  247. $modules{babble}{defptr}{$name} = $hash;
  248. RemoveInternalTimer($hash);
  249. InternalTimer ($now + 5, 'Babble_CreateEntry', $hash, 0);
  250. return;
  251. }
  252. #########################################################################################
  253. #
  254. # Babble_Undef - Implements Undef function
  255. #
  256. # Parameter hash = hash of device addressed, def = definition string
  257. #
  258. #########################################################################################
  259. sub Babble_Undef ($$) {
  260. my ($hash,$arg) = @_;
  261. my $name = $hash->{NAME};
  262. RemoveInternalTimer($hash);
  263. delete $data{FWEXT}{babblex};
  264. if (defined $defs{$name."_weblink"}) {
  265. FW_fC("delete ".$name."_weblink");
  266. Log3 $hash, 3, "[".$name. " V".$babbleversion."]"." Weblink ".$name."_weblink deleted";
  267. }
  268. return undef;
  269. }
  270. #########################################################################################
  271. #
  272. # Babble_Attr - Implements Attr function
  273. #
  274. # Parameter hash = hash of device addressed, ???
  275. #
  276. #########################################################################################
  277. sub Babble_Attr($$$) {
  278. my ($cmd, $name, $attrName, $attrVal) = @_;
  279. my $hash = $defs{"$name"};
  280. #-- in any attribute redefinition readjust language
  281. my $lang = AttrVal("global","language","EN");
  282. if( $lang eq "DE"){
  283. $babble_tt = \%babble_transtable_DE;
  284. }else{
  285. $babble_tt = \%babble_transtable_EN;
  286. }
  287. return;
  288. }
  289. #########################################################################################
  290. #
  291. # Babble_CreateEntry - Puts the babble entry into the FHEM menu
  292. #
  293. # Parameter hash = hash of device addressed
  294. #
  295. #########################################################################################
  296. sub Babble_CreateEntry($) {
  297. my ($hash) = @_;
  298. my $name = $hash->{NAME};
  299. if (!defined $defs{$name."_weblink"}) {
  300. FW_fC("define ".$name."_weblink weblink htmlCode {Babble_Html(\"".$name."\")}");
  301. Log3 $hash, 3, "[".$name. " V".$babbleversion."]"." Weblink ".$name."_weblink created";
  302. }
  303. FW_fC("attr ".$name."_weblink room ".$babblehiddenroom);
  304. foreach my $dn (sort keys %defs) {
  305. if ($defs{$dn}{TYPE} eq "FHEMWEB" && $defs{$dn}{NAME} !~ /FHEMWEB:/) {
  306. my $hr = AttrVal($defs{$dn}{NAME}, "hiddenroom", "");
  307. if (index($hr,$babblehiddenroom) == -1){
  308. if ($hr eq "") {
  309. FW_fC("attr ".$defs{$dn}{NAME}." hiddenroom ".$babblehiddenroom);
  310. }else {
  311. FW_fC("attr ".$defs{$dn}{NAME}." hiddenroom ".$hr.",".$babblehiddenroom);
  312. }
  313. Log3 $hash, 3, "[".$name. " V".$babbleversion."]"." Added hidden room '".$babblehiddenroom."' to ".$defs{$dn}{NAME};
  314. }
  315. }
  316. }
  317. #-- recover state from stored readings
  318. readingsBeginUpdate($hash);
  319. #readingsBulkUpdate( $hash, "state", $mga);
  320. readingsEndUpdate( $hash,1 );
  321. }
  322. #########################################################################################
  323. #
  324. # Babble_Set - Implements the Set function
  325. #
  326. # Parameter hash = hash of device addressed
  327. #
  328. #########################################################################################
  329. sub Babble_Set($@) {
  330. my ( $hash, $name, $cmd, @args ) = @_;
  331. if ( $cmd =~ /^lock(ed)?$/ ) {
  332. readingsSingleUpdate( $hash, "lockstate", "locked", 0 );
  333. return;
  334. #-----------------------------------------------------------
  335. } elsif ( $cmd =~ /^unlock(ed)?$/ ) {
  336. readingsSingleUpdate( $hash, "lockstate", "unlocked", 0 );
  337. return;
  338. #-----------------------------------------------------------
  339. } elsif ( $cmd =~ /^rivereload/ ) {
  340. delete $hash->{Rive};
  341. return Babble_createRive($hash);
  342. #-----------------------------------------------------------
  343. } elsif ( $cmd =~ /^test/ ) {
  344. return Babble_Test($hash);
  345. #-----------------------------------------------------------
  346. } elsif ( $cmd =~ /^save/ ) {
  347. return Babble_save($hash);
  348. #-----------------------------------------------------------
  349. } elsif ( $cmd =~ /^restore/ ) {
  350. return Babble_restore($hash,1);
  351. } else {
  352. my $str = "[babble] Unknown argument " . $cmd . ", choose one of locked:noArg unlocked:noArg save:noArg restore:noArg test:noArg ";
  353. $str .= "rivereload:noArg"
  354. if($rive == 1 && AttrVal($name,"noChatBot",0) != 1);
  355. return $str;
  356. }
  357. }
  358. #########################################################################################
  359. #
  360. # Babble_Get - Implements the Get function
  361. #
  362. # Parameter hash = hash of device addressed
  363. #
  364. #########################################################################################
  365. sub Babble_Get($@) {
  366. my ($hash, @a) = @_;
  367. my $res = "";
  368. my $ip;
  369. my $name = $hash->{NAME};
  370. my $arg = (defined($a[1]) ? $a[1] : "");
  371. if ($arg eq "version") {
  372. return "babble.version => $babbleversion";
  373. }elsif ($arg eq "tokens") {
  374. for( my $i=0;$i<=3;$i++ ){
  375. $ip = AttrVal($name,"remoteFHEM$i",undef);
  376. if( $ip ){
  377. Babble_getcsrf($name,$ip,$i);
  378. }
  379. }
  380. } else {
  381. return "Unknown argument $arg choose one of version:noArg tokens:noArg";
  382. }
  383. }
  384. #########################################################################################
  385. #
  386. # Babble_save
  387. #
  388. # Parameter hash = hash of the babble device
  389. #
  390. #########################################################################################
  391. sub Babble_save($) {
  392. my ($hash) = @_;
  393. my $date = TimeNow();
  394. my $name = $hash->{NAME};
  395. $hash->{DATA}{"savedate"} = $date;
  396. readingsSingleUpdate( $hash, "savedate", $date, 1 );
  397. my $jhash0 = toJSON($hash->{DATA});
  398. #$jhash0 = decode_utf8( $jhash0 );
  399. if( ReadingsVal($name,"lockstate","locked") ne "locked" ){
  400. my $error = FileWrite("babbleFILE",$jhash0);
  401. Log3 $name,1,"[Babble_save]";
  402. }else{
  403. Log3 $name, 1, "[Babble] attempt to save data failed due to lockstate";
  404. Log3 $name, 5, " ".Dumper($jhash0);
  405. }
  406. return;
  407. }
  408. sub Babble_savename($){
  409. my ($name) = @_;
  410. my $hash = $defs{$name};
  411. Babble_save($hash);
  412. }
  413. #########################################################################################
  414. #
  415. # Babble_restore
  416. #
  417. # Parameter hash = hash of the babble device
  418. #
  419. #########################################################################################
  420. sub Babble_restore($$) {
  421. my ($hash,$doit) = @_;
  422. my $name = $hash->{NAME};
  423. my ($error,@lines) = FileRead("babbleFILE");
  424. if( defined($error) && $error ne "" ){
  425. Log3 $name,1,"[Babble_restore] read error=$error";
  426. return undef;
  427. }
  428. my $json = JSON->new->utf8;
  429. my $jhash0 = join('',@lines);
  430. $jhash0 = encode_utf8( $jhash0 );
  431. my $jhash1 = eval{ $json->decode( $jhash0 ) };
  432. my $date = $jhash1->{"savedate"};
  433. #-- just for the first time, reading an old savefile
  434. $date = localtime(time)
  435. if( !defined($date));
  436. readingsSingleUpdate( $hash, "savedate", $date, 0 );
  437. if( $doit==1 ){
  438. $hash->{DATA} = {%{$jhash1}};
  439. Log3 $name,1,"[Babble_restore] Data hash restored from save file with date ".$date;
  440. return 1;
  441. }else{
  442. return $date;
  443. }
  444. }
  445. #########################################################################################
  446. #
  447. # Babble_Test - Implements a variety of tests
  448. #
  449. # Parameter hash = hash of device addressed
  450. #
  451. #########################################################################################
  452. sub Babble_Test($) {
  453. my ($hash) = @_;
  454. my $name = $hash->{NAME};
  455. my $str = "";
  456. $str .= "\nA.1:".Babble_DoIt($name,"guten morgen","testit",0);
  457. $str .= "\nA.2:".Babble_DoIt($name,"gute nacht","testit",0);
  458. $str .= "\nA.3:".Babble_DoIt($name,"guten morgen jeannie","testit",0);
  459. $str .= "\nA.4:".Babble_DoIt($name,"gute nacht jeannie","testit",0);
  460. $str .= "\n";
  461. $str .= "\nB.1:".Babble_DoIt($name,"schalte das gerät an","testit",0);
  462. $str .= "\nB.2:".Babble_DoIt($name,"schalte gerät an","testit",0);
  463. $str .= "\nB.3:".Babble_DoIt($name,"mach das gerät an","testit",0);
  464. $str .= "\nB.4:".Babble_DoIt($name,"das gerät ausschalten","testit",0);
  465. $str .= "\nB.5:".Babble_DoIt($name,"gerät ausschalten","testit",0);
  466. $str .= "\nB.6:".Babble_DoIt($name,"das gerät ausmachen","testit",0);
  467. $str .= "\nB.7:".Babble_DoIt($name,"gerät anmachen","testit",0);
  468. $str .= "\nB.8:".Babble_DoIt($name,"schalte beleuchtung an","testit",0);
  469. $str .= "\nB.9:".Babble_DoIt($name,"licht anschalten","testit",0);
  470. $str .= "\n";
  471. $str .= "\nC.1:".Babble_DoIt($name,"wie ist der wert von gerät","testit",0);
  472. $str .= "\nC.2:".Babble_DoIt($name,"wie ist wert von gerät","testit",0);
  473. $str .= "\nC.3:".Babble_DoIt($name,"wie ist der wert gerät","testit",0);
  474. $str .= "\nC.4:".Babble_DoIt($name,"wie ist wert gerät","testit",0);
  475. $str .= "\nC.4:".Babble_DoIt($name,"sage den status von gerät","testit",0);
  476. $str .= "\nC.5:".Babble_DoIt($name,"sage status von gerät","testit",0);
  477. $str .= "\nC.6:".Babble_DoIt($name,"sage status gerät","testit",0);
  478. $str .= "\n";
  479. $str .= "\nD.1:".Babble_DoIt($name,"wie ist das wetter von morgen","testit",0);
  480. $str .= "\nD.2:".Babble_DoIt($name,"wie ist wetter von morgen","testit",0);
  481. $str .= "\nD.3:".Babble_DoIt($name,"wie ist das wetter morgen","testit",0);
  482. $str .= "\nD.4:".Babble_DoIt($name,"wie ist wetter morgen","testit",0);
  483. $str .= "\nD.5:".Babble_DoIt($name,"wie ist morgen das wetter","testit",0);
  484. $str .= "\nD.6:".Babble_DoIt($name,"wie ist morgen wetter","testit",0);
  485. $str .= "\nD.7:".Babble_DoIt($name,"wetter von morgen","testit",0);
  486. $str .= "\nD.8:".Babble_DoIt($name,"wetter morgen","testit",0);
  487. $str .= "\n";
  488. $str .= "\nF.1:".Babble_DoIt($name,"schalte den wecker aus","testit",0);
  489. $str .= "\nF.2:".Babble_DoIt($name,"schalte wecker aus","testit",0);
  490. $str .= "\nF.3:".Babble_DoIt($name,"den wecker ausschalten","testit",0);
  491. $str .= "\nF.4:".Babble_DoIt($name,"wecker ausschalten","testit",0);
  492. $str .= "\nF.5:".Babble_DoIt($name,"wie ist die weckzeit","testit",0);
  493. $str .= "\nF.6:".Babble_DoIt($name,"wie ist der status des weckers","testit",0);
  494. $str .= "\nF.7:".Babble_DoIt($name,"weckzeit ansagen","testit",0);
  495. $str .= "\nF.8:".Babble_DoIt($name,"weckzeit","testit",0);
  496. $str .= "\nF.9:".Babble_DoIt($name,"wecken um 4 uhr 3","testit",0);
  497. $str .= "\nF.10:".Babble_DoIt($name,"stelle den wecker auf 17:00","testit",0);
  498. $str .= "\nF.11:".Babble_DoIt($name,"wecken um 13:12 Uhr","testit",0);
  499. $str .= "\n";
  500. $str .= "\nG.1:".Babble_DoIt($name,"das haus ansagen","testit",0);
  501. $str .= "\nG.2:".Babble_DoIt($name,"haus ansagen","testit",0);
  502. $str .= "\nG.3:".Babble_DoIt($name,"haus status","testit",0);
  503. $str .= "\nG.4:".Babble_DoIt($name,"wie ist der status des hauses","testit",0);
  504. $str .= "\nG.5:".Babble_DoIt($name,"wie ist der status vom haus","testit",0);
  505. $str .= "\nG.6:".Babble_DoIt($name,"das haus sichern","testit",0);
  506. $str .= "\nG.7:".Babble_DoIt($name,"sichere das haus","testit",0);
  507. $str .= "\nG.8:".Babble_DoIt($name,"haus sichern","testit",0);
  508. $str .= "\nG.9:".Babble_DoIt($name,"das haus entsichern","testit",0);
  509. $str .= "\nG.10:".Babble_DoIt($name,"haus entsichern","testit",0);
  510. $str .= "\nG.11:".Babble_DoIt($name,"haustür öffnen","testit",0);
  511. $str .= "\nG.12:".Babble_DoIt($name,"die haustür öffnen","testit",0);
  512. $str .= "\nG.13:".Babble_DoIt($name,"öffne die haustür","testit",0);
  513. $str .= "\nG.14:".Babble_DoIt($name,"schließe die haustür zu","testit",0);
  514. $str .= "\nG.15:".Babble_DoIt($name,"schließe die haustür auf","testit",0);
  515. $str .= "\n";
  516. $str .= "\nH.1:".Babble_DoIt($name,"alarmanlage einschalten","testit",0);
  517. $str .= "\nH.1:".Babble_DoIt($name,"alarmanlage ein schalten","testit",0);
  518. $str .= "\nH.1:".Babble_DoIt($name,"die alarmanlage scharfschalten","testit",0);
  519. $str .= "\nH.2:".Babble_DoIt($name,"alarmanlage unscharf schalten","testit",0);
  520. $str .= "\nH.2:".Babble_DoIt($name,"die alarmanlage ausschalten","testit",0);
  521. $str .= "\nH.3:".Babble_DoIt($name,"schalte die alarmanlage scharf","testit",0);
  522. $str .= "\nH.4:".Babble_DoIt($name,"schalte den alarm an","testit",0);
  523. $str .= "\nH.5:".Babble_DoIt($name,"alarm wider rufen","testit",0);
  524. $str .= "\nH.6:".Babble_DoIt($name,"alarm widerrufen","testit",0);
  525. $str .= "\n";
  526. $str .= "\nI.1:".Babble_DoIt($name,"schalte beleuchtung in sitzgruppe an","testit",0);
  527. $str .= "\nI.2:".Babble_DoIt($name,"schalte beleuchtung in der sitzgruppe an","testit",0);
  528. $str .= "\nI.3:".Babble_DoIt($name,"mach die beleuchtung auf terrasse an","testit",0);
  529. $str .= "\nI.4:".Babble_DoIt($name,"mache außen die beleuchtung aus","testit",0);
  530. $str .= "\nI.5:".Babble_DoIt($name,"wie ist die temperatur im badezimmer","testit",0);
  531. $str .= "\nI.6:".Babble_DoIt($name,"wie ist die feuchte in dominics zimmer","testit",0);
  532. $str .= "\nI.7:".Babble_DoIt($name,"wie ist die feuchte in dem schlafzimmer","testit",0);
  533. $str .= "\nI.8:".Babble_DoIt($name,"wie ist der status der tür im schlafzimmer","testit",0);
  534. $str .= "\nI.9:".Babble_DoIt($name,"status tür schlafzimmer","testit",0);
  535. $str .= "\nI.10:".Babble_DoIt($name,"status der tür schlafzimmer","testit",0);
  536. $str .= "\nI.11:".Babble_DoIt($name,"status tür im schlafzimmer","testit",0);
  537. $str .= "\nI.12:".Babble_DoIt($name,"status der tür im schlafzimmer","testit",0);
  538. $str .= "\n";
  539. $str .= "\nJ.1:".Babble_DoIt($name,"stelle bei gerät den wert auf 8","testit",0);
  540. $str .= "\nJ.2:".Babble_DoIt($name,"stelle am gerät wert auf 9","testit",0);
  541. $str .= "\nJ.3:".Babble_DoIt($name,"stelle bei harmony den kanal auf 10","testit",0);
  542. $str .= "\nJ.4:".Babble_DoIt($name,"stelle am fernseher die lautstärke auf 11","testit",0);
  543. $str .= "\n";
  544. $str .= "\nK.1:".Babble_DoIt($name,"zur einkaufsliste hinzufügen bratheringe","testit",0);
  545. $str .= "\nK.2:".Babble_DoIt($name,"zu peters liste hinzufügen ticket münchen besorgen","testit",0);
  546. $str .= "\nK.3:".Babble_DoIt($name,"von dominics liste entfernen schmieröl","testit",0);
  547. $str .= "\nK.4:".Babble_DoIt($name,"baumarktliste löschen","testit",0);
  548. $str .= "\nK.5:".Babble_DoIt($name,"einkaufsliste senden","testit",0);
  549. return $str;
  550. }
  551. ##############################################################################
  552. #
  553. # Babble_Normalize
  554. #
  555. # Parameter hash = hash of the babble device
  556. #
  557. ##############################################################################
  558. sub Babble_Normalize($$){
  559. my ($name,$sentence) = @_;
  560. my $hash = $defs{$name};
  561. $sentence = lc $sentence;
  562. $sentence =~ s/[,.]//g;
  563. my $cat = 0;
  564. my $subcat = 0;
  565. my $subsubcat = 0;
  566. my ($device,$verb,$reading,$value,$article,$reserve,$place,$state,$prepo)=("","","","","","","","","","");
  567. #-- normalize special phrases
  568. my $sentmod = $sentence;
  569. my $pairs = AttrVal($name,"babblePreSubs",undef);
  570. if( $pairs ){
  571. my @subs=split(' ',$pairs);
  572. for( my $i=0; $i<int(@subs); $i++ ){
  573. my ($t,$r) = split( ':',$subs[$i],2 );
  574. $t =~ s/\\s/ /g;
  575. $r =~ s/\\s/ /g;
  576. $sentmod =~ s/$t/$r/;
  577. }
  578. }
  579. my @word = split(' ',$sentmod,15);
  580. my $len = int(@word);
  581. ############################# POS tagging ###################
  582. #-- isolate place - take out (prepo) [arti] PLACE
  583. # (verb) (prepo) [arti] PLACE [arti] (device)
  584. # (verb) [arti] (device) (prepo) [arti] PLACE
  585. # wie ist [arti] (device) (prepo) [arti] PLACE
  586. # wie ist (prepo) [arti] PLACE [arti] (device)
  587. $place = "none";
  588. for( my $i=0;$i<$len;$i++){
  589. if( $word[$i] =~ /^$hash->{DATA}{"re_places"}/ ){
  590. $place = $word[$i];
  591. my $to = 1;
  592. $to++
  593. if( ($i-1)>=0 && $word[$i-1] =~ /^$hash->{DATA}{"re_articles"}/ );
  594. $to++
  595. if( ($i-$to)>=0 && $word[$i-$to] =~ /^$hash->{DATA}{"re_prepos"}/ );
  596. for( my $j=$i+1-$to;$j<$len;$j++){
  597. $word[$j]=($word[$j+$to])?$word[$j+$to]:"";
  598. }
  599. last;
  600. }
  601. }
  602. #-- backup without place for reserve
  603. my @xord = @word;
  604. #-- leer
  605. if( int(@word) == 0){
  606. return ("","","","","","","");
  607. #-- Kategorie 1: Verb zuerst ----------------------------------------------------------
  608. # schalte das gerät an
  609. # schalte gerät an
  610. # sage den status von gerät
  611. # sage status von gerät
  612. # sage status gerät
  613. # schalte den wecker aus ;
  614. # schalte wecker aus
  615. }elsif( ($word[0] =~ /^$hash->{DATA}{"re_verbsc"}/) && ($word[1])){
  616. $cat = 1;
  617. #-- get infinitive
  618. $verb = $hash->{DATA}{"verbs"}{$word[0]};
  619. if( $word[1] =~ /^$hash->{DATA}{"re_articles"}/){
  620. $subcat = 1;
  621. $article = $word[1];
  622. $device = $word[2];
  623. $reading = $word[3];
  624. $reserve = $word[4];
  625. }elsif( $word[1] =~ /^$hash->{DATA}{"re_prepos"}/){
  626. $subcat = 2;
  627. $article = $word[1];
  628. $device = $word[2];
  629. }else{
  630. $subcat = 3;
  631. $device = $word[1];
  632. $reading = $word[2];
  633. $reserve = $word[3];
  634. }
  635. #-- device=state => verb="sage" => reading
  636. if( $hash->{DATA}{"re_status"} && $device =~ /^$hash->{DATA}{"re_status"}/ ){
  637. if( $reading =~ /^$hash->{DATA}{"re_prepos"}/ ){
  638. $subsubcat = 1;
  639. $reading = $device;
  640. $device = $reserve;
  641. }else{
  642. $subsubcat = 2;
  643. $reserve = $reading;
  644. $reading = $device;
  645. $device = $reserve;
  646. }
  647. #-- reading of device => target
  648. }elsif( $subcat==2 ){
  649. if( $word[3] =~ /^$hash->{DATA}{"re_articles"}/ ){
  650. $subsubcat = 3;
  651. $reading = $word[4];
  652. $reserve = $word[5];
  653. }else{
  654. $subsubcat = 4;
  655. $reading = $word[3];
  656. $reserve = $word[4];
  657. }
  658. }
  659. #-- Kategorie 2 ----------------------------------------------------------
  660. # wie ist der wert von gerät
  661. # wie ist wert von gerät
  662. # wie ist der wert gerät
  663. # wie ist wert gerät
  664. # wie ist das wetter morgen
  665. # wie ist wetter morgen
  666. # wie ist morgen das wetter
  667. # wie ist morgen wetter
  668. # wie ist die weckzeit
  669. # wie ist der status des weckers
  670. # (quest) ist (time) [arti1] (reading) [prepo] [arti2] ($device)
  671. }elsif( $word[0] =~ /^$hash->{DATA}{"re_quests"}/){
  672. $cat = 2;
  673. $verb = "sagen";
  674. my $inext;
  675. #-- check time
  676. if( $word[2] =~ /^$hash->{DATA}{"re_times"}/){
  677. $value = $word[2];
  678. $inext = 3;
  679. }else{
  680. $inext = 2;
  681. }
  682. #-- take out article
  683. if( $word[$inext] =~ /^$hash->{DATA}{"re_articles"}/){
  684. $subcat=1;
  685. $article = $word[$inext];
  686. $reading = $word[$inext+1];
  687. #-- check time => device is reading
  688. if( $word[$inext+2] =~ /^$hash->{DATA}{"re_times"}/){
  689. $subsubcat = 1;
  690. $value = $word[$inext+2];
  691. $device = $reading;
  692. #-- check time => device is reading
  693. }elsif( $word[$inext+2] =~ /^$hash->{DATA}{"re_prepos"}/ && $word[$inext+3] =~ /^$hash->{DATA}{"re_times"}/){
  694. $subsubcat = 2;
  695. $value = $word[$inext+3];
  696. $device = $reading;
  697. #--take out preposition
  698. }elsif( $word[$inext+2] =~ /^$hash->{DATA}{"re_prepos"}/ ){
  699. if( $word[$inext+3] =~ /^$hash->{DATA}{"re_articles"}/){
  700. $subsubcat = 3;
  701. $article = $word[$inext+3];
  702. $device = $word[$inext+4];
  703. }else{
  704. $subsubcat = 4;
  705. $device = $word[$inext+3];
  706. }
  707. #-- no preposition
  708. }else{
  709. if( $word[$inext+2] =~ /^$hash->{DATA}{"re_articles"}/){
  710. $subsubcat = 5;
  711. $article = $word[$inext+2];
  712. $device = $word[$inext+3];
  713. }else{
  714. $subsubcat = 6;
  715. $device = $word[$inext+2];
  716. }
  717. }
  718. #-- no article
  719. }else{
  720. $subcat=2;
  721. $reading = $word[$inext];
  722. #-- check time => device is reading
  723. if( $word[$inext+1] =~ /^$hash->{DATA}{"re_times"}/){
  724. $subsubcat = 1;
  725. $value = $word[$inext+1];
  726. $device = $reading;
  727. #-- check time => device is reading
  728. }elsif( $word[$inext+1] =~ /^$hash->{DATA}{"re_prepos"}/ && $word[$inext+2] =~ /^$hash->{DATA}{"re_times"}/){
  729. $subsubcat = 2;
  730. $value = $word[$inext+2];
  731. $device = $reading;
  732. #--take out preposition
  733. }elsif( $word[$inext+1] =~ /^$hash->{DATA}{"re_prepos"}/ ){
  734. if( $word[$inext+2] =~ /^$hash->{DATA}{"re_articles"}/){
  735. $subsubcat = 3;
  736. $article = $word[$inext+2];
  737. $device = $word[$inext+3];
  738. }else{
  739. $subsubcat = 4;
  740. $device = $word[$inext+2];
  741. }
  742. #-- no preposition
  743. }else{
  744. if( $word[$inext+1] =~ /^$hash->{DATA}{"re_articles"}/){
  745. $subsubcat = 5;
  746. $article = $word[$inext+1];
  747. $device = $word[$inext+2];
  748. }else{
  749. $subsubcat = 6;
  750. $device = $word[$inext+1];
  751. }
  752. }
  753. }
  754. if( $device eq ""){
  755. $subsubcat = 7;
  756. $device = $reading;
  757. $reading = "status";
  758. }
  759. #-- Kategorie 3 ----------------------------------------------------------
  760. # das gerät anschalten
  761. # gerät anschalten
  762. # das wetter von morgen
  763. # wetter von morgen
  764. # das wetter morgen
  765. # wetter morgen
  766. # guten morgen
  767. # gute nacht
  768. # den wecker ausschalten
  769. # wecker ausschalten
  770. # wecker
  771. # status
  772. }else{
  773. $cat = 3;
  774. my $rex = $hash->{DATA}{"re_verbparts"}." ?".$hash->{DATA}{"re_verbsi"};
  775. #-- guten morgen / gute nacht
  776. if( $word[0] =~ /^gut.*/){
  777. $subcat = 1;
  778. $device="zeit";
  779. $reading="status";
  780. $value=$word[1];
  781. $reserve=$word[2]
  782. if( $word[2] );
  783. $verb="schalten";
  784. #-- (arti) (device) something
  785. }elsif( $word[0] =~ /^$hash->{DATA}{"re_articles"}/){
  786. $subcat = 2;
  787. $article = $word[0];
  788. $device = $word[1];
  789. shift(@xord);
  790. shift(@xord);
  791. #--take out preposition
  792. if( $word[2] =~ /^$hash->{DATA}{"re_prepos"}/ ){
  793. $subsubcat = 1;
  794. shift(@xord);
  795. $reserve = join(" ",@xord);
  796. }else{
  797. $subsubcat = 2;
  798. $reserve = join(" ",@xord);
  799. }
  800. #-- (arti) (device) [prepo] (time)
  801. if( $reserve =~ /^$hash->{DATA}{"re_times"}/ ){
  802. $subsubcat = 3;
  803. #$reading = $reserve;
  804. $value = $reserve;
  805. $verb = "sagen";
  806. #-- (arti) (device) [prepo] verb
  807. }elsif( $reserve =~ s/^$hash->{DATA}{"re_verbsi"}\s?// ){
  808. $subsubcat = 4;
  809. $verb = $1;
  810. $reading = $reserve;
  811. #-- (arti) (device) [prepo] (reading) (verb) (value)
  812. }else{
  813. $subsubcat = 5;
  814. $reserve =~ /^$rex/;
  815. #-- named group
  816. $verb = $+{verbsi};
  817. $reading = $1;
  818. }
  819. #-- status [prepo] (device)
  820. }elsif( $word[0] =~ /^status/){
  821. $subcat = 3;
  822. #--take out preposition
  823. if( $word[1] =~ /^$hash->{DATA}{"re_prepos"}/ ){
  824. $subsubcat = 1;
  825. $device = $word[2];
  826. }else{
  827. $subsubcat = 2;
  828. $device = $word[1];
  829. }
  830. $verb = "sagen";
  831. $reading = "status";
  832. #-- (device) something
  833. }elsif($word[1] ne ""){
  834. $subcat = 4;
  835. $device = $word[0];
  836. shift(@xord);
  837. #--take out preposition
  838. if( $word[1] =~ /^$hash->{DATA}{"re_prepos"}/ ){
  839. $subsubcat = 1;
  840. shift(@xord);
  841. $reserve = join(" ",@xord);
  842. }else{
  843. $subsubcat = 2;
  844. $reserve = join(" ",@xord);
  845. }
  846. #-- (device) [prepo] (time)
  847. if( $reserve =~ /^$hash->{DATA}{"re_times"}/ ){
  848. $subsubcat = 3;
  849. $reading = "status";
  850. $value = $reserve;
  851. $verb = "sagen";
  852. #-- (device) [prepo] status
  853. }elsif( $reserve =~ /^status/ ){
  854. $subsubcat = 4;
  855. $reading = "status";
  856. $verb = "sagen";
  857. #-- (device) (write)
  858. }elsif( $word[1] =~ /^$hash->{DATA}{"re_writes"}/ ){
  859. $subsubcat = 5;
  860. $verb = $word[1];
  861. shift(@xord);
  862. $reading = join(" ",@xord);
  863. #-- (arti) (device) [prepo] verb
  864. }elsif( $reserve =~ s/^$hash->{DATA}{"re_verbsi"}\s?// ){
  865. $subsubcat = 6;
  866. $verb = $1;
  867. $reading = $reserve;
  868. #-- (device) [prepo] (reading) (verb) (value)
  869. }else{
  870. $subsubcat = 7;
  871. $reserve =~ /^$rex/;
  872. #-- named group
  873. $verb = $+{verbsi};
  874. $reading = $1;
  875. }
  876. #-- (device)
  877. }else{
  878. $subcat = 5;
  879. $device = $word[0];
  880. $reading = "status";
  881. $verb = "sagen";
  882. }
  883. }
  884. #-- normalize devices
  885. $device = "haus"
  886. if( $device =~/hauses/);
  887. $device = "wecker"
  888. if( $device =~/we((ck)|g).*/);
  889. $place = "wohnzimmer"
  890. if( ($device eq "licht") && ($place eq ""));
  891. if( $device eq "außenlicht" ){
  892. $place="aussen"
  893. if( $place eq "" );
  894. $device="licht";
  895. }
  896. #-- machen
  897. $verb = "schalten"
  898. if( $verb && $verb eq "machen");
  899. #-- sichern
  900. $reading = "zu"
  901. if(( $verb && $verb eq "sichern") && ($reading eq ""));
  902. #-- an
  903. $reading = "status"
  904. if( (( $verb && $verb eq "sagen") || ( $verb && $verb eq "zeigen")) && ($reading eq "an"));
  905. $reading = "an"
  906. if( $reading && $reading eq "ein");
  907. #-- value
  908. $value=substr($sentmod,index($sentmod,"auf")+4)
  909. if( ($reading && $reading eq "auf") || ($reserve && $reserve eq "auf") );
  910. $value=substr($sentmod,index($sentmod,"hinzufügen")+11)
  911. if( $reserve && $reserve =~ /hinzufügen (.*)/ );
  912. if( $verb && $verb eq "entfernen" ){
  913. $value = $reading;
  914. $reading = "ent";
  915. }
  916. if( $value =~ /.*uhr.*/ ){
  917. $value = Babble_timecorrector($value);
  918. }
  919. return ($device,$verb,$reading,$value,$article,$reserve,$place,"$cat.$subcat.$subsubcat");
  920. }
  921. #########################################################################################
  922. #
  923. # Babble_timecorrector - to correct for weird answers from Google
  924. #
  925. #########################################################################################
  926. sub Babble_timecorrector($){
  927. my ($value) = @_;
  928. my ($h,$m1,$m2);
  929. #-- xx:yy uhr und zz uhr
  930. if( $value =~/(\d?\d):(\d\d) uhr und (\d\d)( uhr)?/ ){
  931. $h = $1*1;
  932. $m1 = $2*1;
  933. $m2 = $3*1;
  934. return(sprintf("%2d\:%02d uhr",$h,$m1+$m2));
  935. #-- xx uhr zz uhr
  936. }elsif( $value =~/(\d?\d) uhr (\d\d)( uhr)?/ ){
  937. $h = $1*1;
  938. $m1 = $2*1;
  939. return(sprintf("%2d\:%02d uhr",$h,$m1));
  940. #-- xx:yy - no correction
  941. }elsif( $value =~/(\d?\d)(:(\d\d))?( uhr)?$/ ){
  942. $h = $1*1;
  943. $m1 = $3*1;
  944. if( $m1 eq "" ){
  945. $m1 = 0;
  946. }
  947. return(sprintf("%2d\:%02d uhr",$h,$m1));
  948. }else{
  949. return "xx";
  950. }
  951. }
  952. #########################################################################################
  953. #
  954. # Babble_createRive
  955. #
  956. #########################################################################################
  957. sub Babble_createRive($){
  958. my ($hash) = @_;
  959. my $name = $hash->{NAME};
  960. my $rs = $hash->{Rive};
  961. if( !defined($rs) ){
  962. $rs = new RiveScript(utf8=>1);
  963. $hash->{Rive} = $rs;
  964. Log3 $name, 1, "[Babble] new RiveScript interpreter generated";
  965. }
  966. #--load a directory of replies
  967. eval{$rs->loadDirectory ("./rivescript")};
  968. #-- sort all the loaded replies
  969. $rs->sortReplies;
  970. }
  971. #########################################################################################
  972. #
  973. # Babble_getcsrf
  974. #
  975. # Parameter ip = ip address of remote FHEM
  976. #
  977. #########################################################################################
  978. sub Babble_getcsrf($$$){
  979. my ($name,$ip,$i) = @_;
  980. my $url = "http://".$ip."/fhem";
  981. HttpUtils_NonblockingGet({
  982. url => $url,
  983. callback => sub($$$){
  984. my ($rhash,$err,$data) = @_;
  985. my $res = $rhash->{httpheader};
  986. $res =~ /X-FHEM-csrfToken\:\s(csrf_\d+).*/;
  987. CommandAttr(undef,$name." remoteToken$i ".$1);
  988. }
  989. });
  990. }
  991. ########################################################################################
  992. #
  993. # Babble_DoIt
  994. #
  995. # Parameter name = name of the babble definition
  996. #
  997. #########################################################################################
  998. sub Babble_DoIt{
  999. my ($name,$sentence,@parms) = @_;
  1000. my $hash = $defs{$name};
  1001. chomp ($sentence);
  1002. my $testit = 0;
  1003. my $exflag = 0;
  1004. my $confirm= 0;
  1005. my $res = "";
  1006. my $str = "";
  1007. my $star = "";
  1008. my $reply = "";
  1009. #-- semantic analysis
  1010. my ($device,$verb,$reading,$value,$article,$reserve,$place,$cat) = Babble_Normalize($name,$sentence);
  1011. $verb = "none"
  1012. if( !$verb );
  1013. $reading = "none"
  1014. if( !$reading );
  1015. if( @parms && $parms[0] eq "testit"){
  1016. $testit = 1;
  1017. shift @parms;
  1018. $exflag = $parms[0];
  1019. shift @parms;
  1020. for( my $i=0;$i<4;$i++){
  1021. $parms[$i] = AttrVal($name,"testParm".$i,undef)
  1022. if( !defined($parms[$i]) && AttrVal($name,"testParm".$i,undef));
  1023. }
  1024. $str="[Babble_Normalize] ".$babble_tt->{"input"}.": $sentence\n".
  1025. " ".$babble_tt->{"result"}.": Category=$cat: ".
  1026. $babble_tt->{"device"}."=$device ".$babble_tt->{"place"}."=$place ".
  1027. $babble_tt->{"verb"}."=$verb ".$babble_tt->{"target"}."=$reading / $value";
  1028. }
  1029. #-- find command directly
  1030. my $cmd = $hash->{DATA}{"command"}{$device}{$place}{$verb}{$reading};
  1031. #-- not directly - but maybe we have an alias device ?
  1032. if( !defined($cmd) || $cmd eq "" ){
  1033. my $alidev = $device;
  1034. $alidev =~s/_\d+$//g;
  1035. my $numalias = (defined($hash->{DATA}{"devsalias"}{$alidev})) ? int(@{$hash->{DATA}{"devsalias"}{$alidev}}) : 0;
  1036. for (my $i=0;$i<$numalias ;$i++){
  1037. my $ig = $hash->{DATA}{"devsalias"}{$alidev}[$i];
  1038. my $bdev = $hash->{DATA}{"devs"}[$ig];
  1039. my $lbdev = lc($bdev);
  1040. next
  1041. if( $lbdev eq $device );
  1042. $cmd = $hash->{DATA}{"command"}{$lbdev}{$place}{$verb}{$reading};
  1043. if( defined($cmd) && $cmd ne "" ){
  1044. $device = $lbdev;
  1045. last;
  1046. }
  1047. }
  1048. }
  1049. #-- not directly - but maybe we have a device which is an extension of an alias device
  1050. if( (!defined($cmd) || $cmd eq "") && defined($device) ){
  1051. my $realdev = $device;
  1052. foreach my $stardev (keys %{$hash->{DATA}{"devsalias"}}){
  1053. if(index($stardev,'*')!=-1){
  1054. my $starrexp = $stardev;
  1055. $starrexp =~ s/\*/\(\.\*\)/;
  1056. if( $realdev =~ m/$starrexp/ ){
  1057. $star = $1;
  1058. $cmd = $hash->{DATA}{"command"}{$stardev}{$place}{$verb}{$reading};
  1059. $cmd =~ s/\$STAR/$star/g;
  1060. if( defined($cmd) && $cmd ne "" ){
  1061. $device = $stardev;
  1062. last;
  1063. }
  1064. }
  1065. }
  1066. }
  1067. }
  1068. #-- command found after all
  1069. if( defined($cmd) && $cmd ne "" ){
  1070. #-- confirmation ?
  1071. if( index($cmd,"\$CONFIRM") != -1 ){
  1072. $confirm=1;
  1073. $cmd =~ s/;;\$CONFIRM$//;
  1074. }
  1075. #-- substitution
  1076. $cmd =~ s/\$DEV/$device/g;
  1077. $cmd =~ s/\$VALUE/$value/g;
  1078. for(my $i=0;$i<int(@parms);$i++){
  1079. $cmd =~ s/\$PARM$i/$parms[$i]/g;
  1080. }
  1081. if( $testit==0 || ($testit==1 && $exflag==1 )){
  1082. Log3 $name,1,"[Babble_DoIt] Executing from hash: $device.$place.$verb.$reading/$value ";
  1083. my $contact = $hash->{DATA}{"devcontacts"}{$device}[2];
  1084. my $fhemdev = $hash->{DATA}{"devcontacts"}{$device}[1];
  1085. if( $contact == 0 ){
  1086. $res = fhem($cmd);
  1087. }else{
  1088. my $ip = AttrVal($name,"remoteFHEM".$contact,undef);
  1089. my $token = AttrVal($name,"remoteToken".$contact,undef);
  1090. my $func = AttrVal($name,"remoteFunc".$contact,undef);
  1091. if( $func && $func ne "" ){
  1092. $res = eval($func."(\"".$cmd."\")")
  1093. }else{
  1094. $cmd =~ s/\s/\%20/g;
  1095. my $url = "http://".$ip."/fhem?XHR=1&amp;fwcsrf=".$token."&amp;cmd.$fhemdev=$cmd";
  1096. HttpUtils_NonblockingGet({
  1097. url => $url,
  1098. callback => sub($$$){}
  1099. });
  1100. }
  1101. }
  1102. #-- confirm execution
  1103. my $func = AttrVal($name,"confirmFunc",undef);
  1104. if( $confirm ){
  1105. if ($func && $func ne "" ){
  1106. #-- substitution
  1107. $func =~ s/\$DEV/$device/g;
  1108. $func =~ s/\$VALUE/$value/g;
  1109. for(my $i=0;$i<int(@parms);$i++){
  1110. $func =~ s/\$PARM$i/$parms[$i]/g;
  1111. }
  1112. $res = fhem($func);
  1113. }else{
  1114. Log3 $name,1,"[Babble_DoIt] Warning: requesting confirmation, but no attribute confirmFunc defined";
  1115. }
  1116. }
  1117. }
  1118. #-- what to do in conclusion
  1119. if( $testit==0 ){
  1120. return undef;
  1121. }else{
  1122. $str .= "==> $cmd";
  1123. return $str;
  1124. }
  1125. #-- no command found, acquire alternate text
  1126. }else{
  1127. #-- ChatBot available
  1128. if( $rive==1 && AttrVal($name,"noChatBot",0) != 1){
  1129. #-- Create a new RiveScript interpreter
  1130. Babble_createRive($hash)
  1131. if( !defined($hash->{Rive}) );
  1132. my $rs = $hash->{Rive};
  1133. $reply = $rs->reply ('localuser',$sentence);
  1134. if ($reply eq "ERR: No Reply Matched"){
  1135. $reply = $babble_tt->{dnu};
  1136. my $dnufile = AttrVal($name,"dnuFile",undef);
  1137. if( $dnufile ){
  1138. open(my $fh, '>>', $dnufile);
  1139. print $fh $sentence." => Category=$cat: ".
  1140. $babble_tt->{"device"}."=$device ".$babble_tt->{"place"}."=$place ".
  1141. $babble_tt->{"verb"}."=$verb ".$babble_tt->{"target"}."=$reading / $value\n";
  1142. close $fh;
  1143. }
  1144. }
  1145. #-- no chatbot, use help text directly
  1146. }else{
  1147. $reply = defined($hash->{DATA}{"help"}{$device}) ? $hash->{DATA}{"help"}{$device} : "";
  1148. }
  1149. #-- get help function
  1150. my $func = AttrVal($name,"helpFunc",undef);
  1151. if( $func && $func ne "" ){
  1152. #-- substitution
  1153. $func =~ s/\$HELP/$reply/g;
  1154. $func =~ s/\$DEV/$device/g;
  1155. $func =~ s/\$VALUE/$value/g;
  1156. for(my $i=0;$i<int(@parms);$i++){
  1157. $func =~ s/\$PARM$i/$parms[$i]/g;
  1158. }
  1159. if( $testit==0 ){
  1160. $res = eval($func);
  1161. return "";
  1162. }elsif($testit==1 && $exflag==1 ){
  1163. $res = eval($func);
  1164. return $str." ".$reply;
  1165. }else{
  1166. return $str." ".$func;
  1167. }
  1168. #-- no command, testing, no execution
  1169. }elsif( $testit==1 ){
  1170. Log 1,"[Babble_DoIt] Command $device.$place.$verb.$reading/$value undefined, reply = $reply";
  1171. $str = $reply;
  1172. }else{
  1173. $str = "";
  1174. }
  1175. return $str;
  1176. }
  1177. }
  1178. ########################################################################################
  1179. #
  1180. # Babble_checkattrs
  1181. #
  1182. # Parameter name = name of the babble definition
  1183. #
  1184. ########################################################################################
  1185. sub Babble_checkattrs($){
  1186. my ($hash) = @_;
  1187. my $name = $hash->{NAME};
  1188. CommandAttr (undef,$name." babbleVerbs schalt,schalte:schalten")
  1189. if( AttrVal($name,"babbleVerbs","") eq "" );
  1190. CommandAttr (undef,$name." babbleVerbParts zu auf ent wider ein an aus ab um")
  1191. if( AttrVal($name,"babbleVerbParts","") eq "" );
  1192. CommandAttr (undef,$name." babblePrepos von vom des der in im auf bei am")
  1193. if( AttrVal($name,"babblePrepos","") eq "" );
  1194. CommandAttr (undef,$name." babbleQuests wie wo wann")
  1195. if( AttrVal($name,"babbleQuests","") eq "" );
  1196. CommandAttr (undef,$name." babbleArticles der die das den des dem zur")
  1197. if( AttrVal($name,"babbleArticles","") eq "" );
  1198. CommandAttr (undef,$name." babbleStatus Status Wert Wetter Zeit")
  1199. if( AttrVal($name,"babbleStatus","") eq "" );
  1200. CommandAttr (undef,$name." babbleWrites setzen ändern löschen")
  1201. if( AttrVal($name,"babbleWrites","") eq "" );
  1202. CommandAttr (undef,$name." babbleTimes heute morgen übermorgen nacht")
  1203. if( AttrVal($name,"babbleTimes","") eq "" );
  1204. #}else{
  1205. # $hash->{DATA}{"verbsi"}[0]="switching";
  1206. # $hash->{DATA}{"verbsicc"}[0][0]="switch";
  1207. # CommandAttr (undef,$name." babbleVerbParts re un");
  1208. # CommandAttr (undef,$name." babbleQuests by of in on at");
  1209. # CommandAttr (undef,$name." babbleAdverb how where when");
  1210. # CommandAttr (undef,$name." babbleArticles the to");
  1211. # CommandAttr (undef,$name." babbleStatus status value weather time");
  1212. #}
  1213. }
  1214. #########################################################################################
  1215. #
  1216. # Babble_ModPlace
  1217. #
  1218. # Parameter name = name of the babble definition
  1219. #
  1220. #########################################################################################
  1221. sub Babble_ModPlace($$$){
  1222. my ($name,$place,$cmd) = @_;
  1223. my $hash = $defs{$name};
  1224. #-- remove a place (parameter is just a number)
  1225. if( $cmd == 0){
  1226. splice(@{$hash->{DATA}{"splaces"}},$place,1);
  1227. #-- add a place
  1228. }else{
  1229. push(@{$hash->{DATA}{"splaces"}},$place);
  1230. }
  1231. CommandAttr (undef,$name." babblePlaces ".join(" ",@{$hash->{DATA}{"splaces"}}));
  1232. Babble_getplaces($hash,"new",undef);
  1233. Babble_save($hash);
  1234. }
  1235. #########################################################################################
  1236. #
  1237. # Babble_ModVerb
  1238. #
  1239. # Parameter name = name of the babble definition
  1240. #
  1241. #########################################################################################
  1242. sub Babble_ModVerb($$$$){
  1243. my ($name,$verbi,$verbc,$cmd) = @_;
  1244. my $hash = $defs{$name};
  1245. my $verbi2 = $verbi;
  1246. my $verbc2 = $verbc;
  1247. # %{$hash->{DATA}{"verbs"}} = hash of all verb => infinitive_verb pairs
  1248. # @{$hash->{DATA}{"verbsi"}} = array of all infinite verbs
  1249. # @{$hash->{DATA}{"verbsicc"}} = array of all arrays of conjugated verbs
  1250. #-- remove a verb - verbi is only a number,verbc is empty
  1251. if( $cmd == 0){
  1252. $verbi2 = $hash->{DATA}{"verbsi"}[$verbi];
  1253. $verbc2 = join(',',$hash->{DATA}{"verbsicc"}[$verbi]);
  1254. splice(@{ $hash->{DATA}{"verbsi"}},$verbi,1);
  1255. splice(@{ $hash->{DATA}{"verbsicc"}},$verbi,1);
  1256. #-- add a verb
  1257. }elsif( $cmd==1) {
  1258. push(@{$hash->{DATA}{"verbsi"}},$verbi);
  1259. my @cc=split(',',$verbc);
  1260. push(@{$hash->{DATA}{"verbsicc"}},\@cc);
  1261. #-- modify a verb - verbi is only a number,verbc is a list of conjugations
  1262. }else{
  1263. $verbi2 = $hash->{DATA}{"verbsi"}[$verbi];
  1264. my @cc=split(',',$verbc);
  1265. $hash->{DATA}{"verbsicc"}[$verbi]=\@cc;
  1266. }
  1267. #-- recreate attribute
  1268. my $att = "";
  1269. for(my $i=0;$i<int(@{ $hash->{DATA}{"verbsi"}});$i++){
  1270. $att .= join(',',@{ $hash->{DATA}{"verbsicc"}[$i]}).":".$hash->{DATA}{"verbsi"}[$i]." ";
  1271. }
  1272. CommandAttr (undef,$name." babbleVerbs ".$att);
  1273. Babble_getverbs($hash,"new",undef);
  1274. Babble_save($hash);
  1275. }
  1276. ########################################################################################
  1277. #
  1278. # Babble_ModHlp
  1279. #
  1280. # Parameter name = name of the babble definition
  1281. #
  1282. #########################################################################################
  1283. sub Babble_ModHlp($$$){
  1284. my ($name,$bdev,$txt) = @_;
  1285. my $hash = $defs{$name};
  1286. #-- lower case characters
  1287. $bdev = lc($bdev);
  1288. $hash->{DATA}{"help"}{$bdev}=$txt;
  1289. }
  1290. ########################################################################################
  1291. #
  1292. # Babble_ModCmd
  1293. #
  1294. # Parameter name = name of the babble definition
  1295. #
  1296. #########################################################################################
  1297. sub Babble_ModCmd($$$$$$){
  1298. my ($name,$bdev,$place,$verb,$target,$cmd) = @_;
  1299. my $hash = $defs{$name};
  1300. #-- lower case characters
  1301. $bdev = lc($bdev);
  1302. if( defined($target) && $target ne "" ){
  1303. $target = lc($target);
  1304. delete($hash->{DATA}{"command"}{$bdev}{"none"}{"none"}{"none"})
  1305. }else{
  1306. $target="none"
  1307. };
  1308. if( defined($verb) && $verb ne "" ){
  1309. $verb = lc($verb);
  1310. delete($hash->{DATA}{"command"}{$bdev}{"none"}{"none"})
  1311. }else{
  1312. $verb="none"
  1313. };
  1314. if( defined($place) && $place ne "" ){
  1315. $place = lc($place);
  1316. delete($hash->{DATA}{"command"}{$bdev}{"none"})
  1317. }else{
  1318. $place="none"
  1319. };
  1320. #Log 1,"[Babble_ModCmd] Setting in hash: $bdev.$place.$verb.$target";
  1321. $hash->{DATA}{"command"}{$bdev}{$place}{$verb}{$target}=$cmd;
  1322. }
  1323. ########################################################################################
  1324. #
  1325. # Babble_RemCmd
  1326. #
  1327. # Parameter name = name of the babble definition
  1328. #
  1329. #########################################################################################
  1330. sub Babble_RemCmd($$$$$$){
  1331. my ($name,$bdev,$place,$verb,$target,$fallback) = @_;
  1332. my $hash = $defs{$name};
  1333. #-- lower case characters
  1334. $bdev = lc($bdev);
  1335. $place = lc($place);
  1336. $verb = lc($verb);
  1337. $target = lc($target);
  1338. $place="none"
  1339. if( $place eq "");
  1340. $verb="none"
  1341. if( $verb eq "");
  1342. $target="none"
  1343. if( $target eq "");
  1344. #-- trying to delete from data obtained via web
  1345. if( defined($hash->{DATA}{"command"}{$bdev}{$place}{$verb}{$target}) ){
  1346. Log3 $name, 1,"[Babble_RemCmd] Deleting from hash: $bdev.$place.$verb.$target => ".$hash->{DATA}{"command"}{$bdev}{$place}{$verb}{$target};
  1347. delete($hash->{DATA}{"command"}{$bdev}{$place}{$verb}{$target});
  1348. return
  1349. #-- try to figure out data from index (fallback strategy)
  1350. }else{
  1351. my $cmdstr = $babblerows[$fallback-1];
  1352. ($bdev,$place,$verb,$target)=split('\+\|\+',$cmdstr);
  1353. Log3 $name, 1,"[Babble_RemCmd] Deleting in fallback strategy from hash: $bdev.$place.$verb.$target => ".$hash->{DATA}{"command"}{$bdev}{$place}{$verb}{$target};
  1354. delete($hash->{DATA}{"command"}{$bdev}{$place}{$verb}{$target});
  1355. return
  1356. }
  1357. }
  1358. #########################################################################################
  1359. #
  1360. # Babble_getids - Helper function to assemble id list
  1361. #
  1362. # Parameter hash = hash of device addressed
  1363. #
  1364. #########################################################################################
  1365. sub Babble_getids($$) {
  1366. my ($hash,$type) = @_;
  1367. my $name = $hash->{NAME};
  1368. my $res = "";
  1369. # @{$hash->{DATA}{"ids"}} = array of all ids
  1370. my @ids;
  1371. #--generate a new list
  1372. if( $type eq "new" ){
  1373. push(@ids,$babble_tt->{"hallo"});
  1374. #-- get ids from attribute
  1375. push(@ids,split(' ',AttrVal($name, "babbleIds", "")));
  1376. $hash->{DATA}{"re_ids"} = lc("((".join(")|(",@ids)."))");
  1377. return;
  1378. #-- just do something with the current list
  1379. }else{
  1380. return undef;
  1381. }
  1382. }
  1383. #########################################################################################
  1384. #
  1385. # Babble_getdevs - Helper function to assemble devices list
  1386. #
  1387. # Parameter hash = hash of device addressed
  1388. #
  1389. #########################################################################################
  1390. sub Babble_getdevs($$) {
  1391. my ($hash,$type) = @_;
  1392. my $name = $hash->{NAME};
  1393. # @{$hash->{DATA}{"devs"}} = array of all Babble devices
  1394. # %{$hash->{DATA}{"devcontacts"}} = hash of all arrays of contact data (Babble Device, FHEM Device, remote type)
  1395. my @remotes = (); # intermediate array of all remote groups of Babble device/FHEM device/contact data
  1396. my @devs = (); # intermediate array of all Babble devices with _number appendix
  1397. my %devshash = (); # intermediate hash of all Babble devices with _number appendix (for checking existence of name)
  1398. my %devsalias= (); # hash of arrays of all Babble device aliases without _number appendix
  1399. my @devcs = (); # intermediate array of all contact data for a certain device
  1400. my ($bdev,$lbdev,$sbdev,$fhemdev,$contact);
  1401. #--generate a new list
  1402. if( $type eq "new" ){
  1403. my $ig = 0;
  1404. $hash->{DATA}{"devs"}=();
  1405. $hash->{DATA}{"devcontacts"}=();
  1406. #-- local Babble devices raw data
  1407. foreach my $fhemdev (sort keys %defs ) {
  1408. $bdev = AttrVal($fhemdev, "babbleDevice",undef);
  1409. if( defined($bdev) ) {
  1410. Log3 $name,5,"[Babble_getdevs] finds local FHEM device $fhemdev with babbleDevice=$bdev";
  1411. $lbdev = lc($bdev);
  1412. $sbdev = $lbdev;
  1413. if(exists($devshash{$lbdev})) {
  1414. Log3 $name,1,"[Babble_getdevs] Warning: local FHEM device $fhemdev has duplicate babbleDevice=$bdev, is ignored. You need to specifiy ".$bdev."_<number> instead.";
  1415. }else{
  1416. Log3 $name,5,"[Babble_getdevs] local FHEM device $fhemdev with babbleDevice=$bdev entered into hashes with ig=$ig";
  1417. $devs[$ig] = $bdev;
  1418. #-- take away trailing _<num>
  1419. $sbdev =~ s/_\d+$//;
  1420. #-- put into hash
  1421. $hash->{DATA}{"devs"}[$ig] = $bdev;
  1422. $hash->{DATA}{"devcontacts"}{$lbdev}[0] = $bdev;
  1423. $hash->{DATA}{"devcontacts"}{$lbdev}[1] = $fhemdev;
  1424. $hash->{DATA}{"devcontacts"}{$lbdev}[2] = 0;
  1425. $devshash{$lbdev} = 1;
  1426. if( !defined($devsalias{$sbdev}) ){
  1427. $devsalias{$sbdev}[0]=$ig;
  1428. }else{
  1429. push(@{$devsalias{$sbdev}},$ig);
  1430. }
  1431. $ig++;
  1432. #-- safeguard against empty device
  1433. if( !defined($hash->{DATA}{"command"}{$lbdev})){
  1434. Log3 $name,1,"[Babble_getdevs] No entry in command table under $lbdev for local FHEM device $fhemdev with attribute babbleDevice=$bdev";
  1435. Babble_ModCmd($name,$sbdev,undef,undef,undef,undef)
  1436. }
  1437. }
  1438. }
  1439. }
  1440. #-- get devices from attribute
  1441. push(@remotes,split(' ',AttrVal($name, "babbleDevices", "")));
  1442. for (my $i=0;$i<int(@remotes);$i++){
  1443. ($bdev,$fhemdev,$contact) =split(':',$remotes[$i]);
  1444. $lbdev = lc($bdev);
  1445. $sbdev = $lbdev;
  1446. #-- take away trailing _<num>
  1447. $sbdev =~ s/_\d+$//;
  1448. if(exists($devshash{$lbdev})) {
  1449. Log3 $name,1,"[Babble_getdevs] Warning: remote FHEM device $fhemdev has duplicate babbleDevice=$bdev, is ignored. You need to specifiy ".$bdev."_<unique number> instead.";
  1450. }else{
  1451. Log3 $name,5,"[Babble_getdevs] remote FHEM device $fhemdev with babbleDevice=$bdev entered into hashes with ig=$ig";
  1452. $hash->{DATA}{"devs"}[$ig] = $bdev;
  1453. $hash->{DATA}{"devcontacts"}{$lbdev}[0] = $bdev;
  1454. $hash->{DATA}{"devcontacts"}{$lbdev}[1] = $fhemdev;
  1455. $hash->{DATA}{"devcontacts"}{$lbdev}[2] = $contact;
  1456. $devshash{$lbdev} = 1;
  1457. if( !defined($devsalias{$sbdev}) ){
  1458. $devsalias{$sbdev}[0]=$ig;
  1459. }else{
  1460. push(@{$devsalias{$sbdev}},$ig);
  1461. }
  1462. $ig++;
  1463. #-- safeguard against empty device
  1464. if( !defined($hash->{DATA}{"command"}{$lbdev})){
  1465. Log 1,"[Babble_getdevs] No entry in command table under $lbdev for remote FHEM device $fhemdev (remote $contact) with attribute babbleDevice=$bdev";
  1466. Babble_ModCmd($name,$sbdev,undef,undef,undef,undef)
  1467. }
  1468. }
  1469. }
  1470. #-- hash of devices without _<num>
  1471. %{$hash->{DATA}{"devsalias"}} = %devsalias;
  1472. #-- regex list for devices to check for validity
  1473. $hash->{DATA}{"re_devs"} = lc("((".join(")|(",@{$hash->{DATA}{"devs"}})."))")
  1474. if( defined($hash->{DATA}{"devs"}) );
  1475. #-- cleanup commands list for obsolete devices
  1476. if( defined( $hash->{DATA}{"command"} )){
  1477. foreach my $device (keys %{$hash->{DATA}{"command"}}){
  1478. if( !defined($hash->{DATA}{"devcontacts"}{$device}) ){
  1479. delete($hash->{DATA}{"command"}{$device});
  1480. }
  1481. }
  1482. }
  1483. }
  1484. }
  1485. #########################################################################################
  1486. #
  1487. # Babble_antistupidity - check for stupid naming of devices or rooms
  1488. # Parameter hash = hash of device addressed
  1489. #
  1490. #########################################################################################
  1491. sub Babble_antistupidity($) {
  1492. my ($hash) = @_;
  1493. my $name = $hash->{NAME};
  1494. my $regexp = $hash->{DATA}{"re_places"};
  1495. my $devs = $hash->{DATA}{"devs"};
  1496. return
  1497. if( !defined($regexp) || !defined($devs) );
  1498. my $imax = int(@{$hash->{DATA}{"devs"}});
  1499. for( my $i=0; $i<$imax; $i++){
  1500. my $dev = lc($hash->{DATA}{"devs"}[$i]);
  1501. Log 1,"[Babble] Baaaaah ! It is not a good idea to name a device $dev similar to a place in Babble"
  1502. if( $dev =~ /$regexp/ );
  1503. }
  1504. return undef;
  1505. }
  1506. #########################################################################################
  1507. #
  1508. # Babble_gethelp - Helper function
  1509. # Parameter hash = hash of device addressed
  1510. #
  1511. #########################################################################################
  1512. sub Babble_gethelp($$) {
  1513. my ($hash,$bdev) = @_;
  1514. my $name = $hash->{NAME};
  1515. my $lbdev = lc($bdev);
  1516. }
  1517. #########################################################################################
  1518. #
  1519. # Babble_getplaces - Helper function to assemble places list
  1520. #
  1521. # Parameter hash = hash of device addressed
  1522. #
  1523. #########################################################################################
  1524. sub Babble_getplaces($$$) {
  1525. my ($hash,$type,$sel) = @_;
  1526. my $name = $hash->{NAME};
  1527. # @{$hash->{DATA}{"rooms"}} = array of all rooms that are not hidden
  1528. # @{$hash->{DATA}{"splaces"}} = array of all special places for Babble
  1529. # @{$hash->{DATA}{"places"}} = array of all places for Babble = rooms + special
  1530. my %rooms; # intermediate hash of all rooms
  1531. my @special; # intermediate array of all special places for Babble
  1532. my @places; # intermediate array of rooms/all babble places
  1533. my $nop = AttrVal($name,"babbleNotPlaces","");
  1534. #--generate a new list
  1535. if( $type eq "new" ){
  1536. #-- code lifted from FHEMWEB
  1537. %rooms = (); # Make a room hash
  1538. my $hre = AttrVal($FW_wname, "hiddenroomRegexp", "");
  1539. foreach my $d (keys %defs ) {
  1540. #next if(IsIgnored($d));
  1541. foreach my $r (split(",", AttrVal($d, "room", "Unsorted"))) {
  1542. next if($hre && $r =~ m/$hre/);
  1543. next if($r eq "Unsorted" || $r eq "hidden" || $r eq $babblehiddenroom || $r eq $babblepublicroom );
  1544. next if (index($nop, $r) != -1);
  1545. $rooms{$r}{$d} = 1;
  1546. }
  1547. }
  1548. if(AttrVal($FW_wname, "sortRooms", "")) { # Slow!
  1549. my @sortBy = split( " ", AttrVal( $FW_wname, "sortRooms", "" ) );
  1550. my %sHash;
  1551. map { $sHash{$_} = FW_roomIdx(\@sortBy,$_) } keys %rooms;
  1552. @places = sort { $sHash{$a} cmp $sHash{$b} } keys %rooms;
  1553. } else {
  1554. @places = sort keys %rooms;
  1555. }
  1556. @{$hash->{DATA}{"rooms"}}=@places;
  1557. #-- append special places from attribute
  1558. @special = split(' ',AttrVal($name, "babblePlaces", ""));
  1559. @{$hash->{DATA}{"splaces"}} = @special;
  1560. push(@places, @special);
  1561. @{$hash->{DATA}{"places"}} = @places;
  1562. $hash->{DATA}{"re_places"} = lc("((".join(")|(",@places)."))");
  1563. #Babble_save($hash);
  1564. return;
  1565. #-- just do something with the current list
  1566. }elsif( $type eq "html" ){
  1567. @places=@{$hash->{DATA}{"places"}};
  1568. #-- output
  1569. if( !defined($sel) ){
  1570. return "<option></option><option>".join("</option><option>",@places)."</option>";
  1571. }else{
  1572. $sel = lc($sel);
  1573. #-- todo: geht das einfacher ?
  1574. $sel =~ s/\xe3\xbc/ü/g;
  1575. $sel =~ s/\xe3\xb6/ö/g;
  1576. $sel =~ s/\xe3\xa4/ä/g;
  1577. $sel =~ s/\xe3\x9f/ß/g;
  1578. my $ret = ($sel eq "none") ? '<option selected="selected">' : '<option>';
  1579. $ret .= '</option>';
  1580. for( my $i=0;$i<int(@places);$i++){
  1581. $ret .= ( $sel eq lc($places[$i]) ) ? '<option selected="selected">' : '<option>';
  1582. $ret .= $places[$i].'</option>';
  1583. }
  1584. return $ret;
  1585. }
  1586. }else{
  1587. return undef;
  1588. }
  1589. }
  1590. #########################################################################################
  1591. #
  1592. # Babble_getverbs - Helper function to assemble verbs list
  1593. #
  1594. # Parameter hash = hash of device addressed
  1595. #
  1596. #########################################################################################
  1597. sub Babble_getverbs($$$) {
  1598. my ($hash,$type,$sel) = @_;
  1599. my $name = $hash->{NAME};
  1600. my $res = "";
  1601. # %{$hash->{DATA}{"verbs"}} = hash of all verb => infinitive_verb pairs
  1602. # @{$hash->{DATA}{"verbsi"}} = array of all infinite verbs
  1603. # @{$hash->{DATA}{"verbsicc"}} = array of all arrays of conjugated verbs
  1604. my @groups; # intermediate array of all conjugated_verb/infinitive_verb groups
  1605. my @verbsic; # intermediate array of all conjugations for a certain verb
  1606. #--generate a new list
  1607. if( $type eq "new" ){
  1608. #-- get verbs from attribute
  1609. push(@groups,split(' ',AttrVal($name, "babbleVerbs", "")));
  1610. for (my $i=0;$i<int(@groups);$i++){
  1611. my ($vc,$vi) =split(':',$groups[$i]);
  1612. $hash->{DATA}{"verbs"}{$vi} = $vi;
  1613. $hash->{DATA}{"verbsi"}[$i] = $vi;
  1614. @verbsic=split(',',$vc);
  1615. for (my $j=0;$j< int(@verbsic);$j++){
  1616. my $vcc = $verbsic[$j];
  1617. $hash->{DATA}{"verbs"}{$vcc} = $vi;
  1618. $hash->{DATA}{"verbsicc"}[$i][$j] = $vcc
  1619. }
  1620. }
  1621. $hash->{DATA}{"re_verbsi"} = "(?P<verbsi>(".lc( join(")|(",@{$hash->{DATA}{"verbsi"}}))."))";
  1622. #$hash->{DATA}{"re_verbsc"} = lc("((".join(")|(",(keys %{$hash->{DATA}{"verbs"}}))."))");
  1623. my $verbsc="((";
  1624. while (my ($key, $value) = each %{$hash->{DATA}{"verbs"}}){
  1625. $verbsc.=lc($key).")|(";
  1626. }
  1627. $verbsc =~ s/\)\|\($/))/;
  1628. $hash->{DATA}{"re_verbsc"}=$verbsc;
  1629. return;
  1630. #-- just do something with the current list
  1631. }elsif( $type eq "html" ){
  1632. my @verbsi=@{$hash->{DATA}{"verbsi"}};
  1633. my $fnd = 0;
  1634. #-- output
  1635. if( !defined($sel) ){
  1636. return "<option></option><option>".join("</option><option>",@verbsi)."</option>";
  1637. }else{
  1638. $sel = lc($sel);
  1639. #-- todo: geht das einfacher ?
  1640. $sel =~ s/\xe3\xbc/ü/g;
  1641. $sel =~ s/\xe3\xb6/ö/g;
  1642. $sel =~ s/\xe3\xa4/ä/g;
  1643. $sel =~ s/\xe3\x9f/ß/g;
  1644. #my $sel1 = encode_utf8($sel);
  1645. #my $sel2 = decode_utf8($sel);
  1646. my $ret = ($sel eq "none") ? '<option selected="selected">' : '<option>';
  1647. $ret .= '</option>';
  1648. for( my $i=0;$i<int(@verbsi);$i++){
  1649. if( $sel eq lc($verbsi[$i]) ) {
  1650. $ret .= '<option selected="selected">';
  1651. $fnd = 1;
  1652. }else{
  1653. $ret .= '<option>';
  1654. }
  1655. $ret .= $verbsi[$i].'</option>';
  1656. }
  1657. #if( $fnd==0 ){
  1658. # $ret .= '<option selected="selected" value="unknown">'.$babble_tt->{"unknown"}.'</option>';
  1659. #}
  1660. return $ret;
  1661. }
  1662. }else{
  1663. return undef;
  1664. }
  1665. }
  1666. #########################################################################################
  1667. #
  1668. # Babble_getwords - Helper function to assemble list of other word classes
  1669. #
  1670. # Parameter hash = hash of device addressed
  1671. #
  1672. #########################################################################################
  1673. sub Babble_getwords($$$$) {
  1674. my ($hash,$class,$type,$sel) = @_;
  1675. my $name = $hash->{NAME};
  1676. my $res = "";
  1677. my @words;
  1678. if( $type eq "new" ){
  1679. if( $class eq "verbparts" || $class eq "all" ) {
  1680. @words=split(' ',AttrVal($name, "babbleVerbParts", ""));
  1681. @{$hash->{DATA}{"verbparts"}} = @words;
  1682. $hash->{DATA}{"re_verbparts"} = lc("((".join(")|(",@words)."))");
  1683. }
  1684. if( $class eq "prepos" || $class eq "all" ) {
  1685. @words=split(' ',AttrVal($name, "babblePrepos", ""));
  1686. @{$hash->{DATA}{"prepos"}} = @words;
  1687. $hash->{DATA}{"re_prepos"} = lc("((".join(")|(",@words)."))");
  1688. }
  1689. if( $class eq "articles" || $class eq "all" ) {
  1690. @words=split(' ',AttrVal($name, "babbleArticles", ""));
  1691. @{$hash->{DATA}{"articles"}} = @words;
  1692. $hash->{DATA}{"re_articles"} = lc("((".join(")|(",@words)."))");
  1693. }
  1694. if( $class eq "status" || $class eq "all" ) {
  1695. @words=split(' ',AttrVal($name, "babbleStatus", ""));
  1696. @{$hash->{DATA}{"status"}} = @words;
  1697. $hash->{DATA}{"re_status"} = lc("((".join(")|(",@words)."))");
  1698. }
  1699. if( $class eq "times" || $class eq "all" ) {
  1700. @words=split(' ',AttrVal($name, "babbleTimes", ""));
  1701. @{$hash->{DATA}{"times"}} = @words;
  1702. $hash->{DATA}{"re_times"} = lc("((".join(")|(",@words)."))");
  1703. }
  1704. if( $class eq "quests" || $class eq "all" ) {
  1705. @words=split(' ',AttrVal($name, "babbleQuests", ""));
  1706. @{$hash->{DATA}{"quests"}} = @words;
  1707. $hash->{DATA}{"re_quests"} = lc("((".join(")|(",@words)."))");
  1708. }
  1709. if( $class eq "writes" || $class eq "all" ) {
  1710. @words=split(' ',AttrVal($name, "babbleStatus", ""));
  1711. @{$hash->{DATA}{"writes"}} = @words;
  1712. $hash->{DATA}{"re_writes"} = lc("((".join(")|(",@words)."))");
  1713. }
  1714. delete($hash->{DATA}{"pronouns"});
  1715. #Babble_save($hash);
  1716. return;
  1717. #-- just do something with the current list
  1718. }elsif( $class eq "targets" && $type eq "html" ){
  1719. my @targets=@{$hash->{DATA}{"status"}};
  1720. push(@targets,"----");
  1721. push(@targets,@{$hash->{DATA}{"verbparts"}});
  1722. #-- output
  1723. if( !defined($sel) ){
  1724. return "<option></option><option>".join("</option><option>",@targets)."</option>";
  1725. }else{
  1726. $sel = lc($sel);
  1727. #-- todo: geht das einfacher ?
  1728. $sel =~ s/\xe3\xbc/ü/g;
  1729. $sel =~ s/\xe3\xb6/ö/g;
  1730. $sel =~ s/\xe3\xa4/ä/g;
  1731. $sel =~ s/\xe3\x9f/ß/g;
  1732. my $ret = ($sel eq "none") ? '<option selected="selected">' : '<option>';
  1733. $ret .= '</option>';
  1734. for( my $i=0;$i<int(@targets);$i++){
  1735. $ret .= (lc($sel) eq lc($targets[$i]) ) ? '<option selected="selected">' : '<option>';
  1736. $ret .= $targets[$i].'</option>';
  1737. }
  1738. return $ret;
  1739. }
  1740. }else{
  1741. return undef;
  1742. }
  1743. }
  1744. #########################################################################################
  1745. #
  1746. # Babble_Html - returns HTML code for the babble page
  1747. #
  1748. # Parameter name = name of the babble definition
  1749. #
  1750. #########################################################################################
  1751. sub Babble_Html($)
  1752. {
  1753. my ($name) = @_;
  1754. my $ret = "";
  1755. my $rot = "";
  1756. my $hash = $defs{$name};
  1757. my $id = $defs{$name}{NR};
  1758. if( !defined($babble_tt) ){
  1759. #-- readjust language
  1760. my $lang = AttrVal("global","language","EN");
  1761. if( $lang eq "DE"){
  1762. $babble_tt = \%babble_transtable_DE;
  1763. }else{
  1764. $babble_tt = \%babble_transtable_EN;
  1765. }
  1766. }
  1767. Babble_checkattrs($hash);
  1768. Babble_getids($hash,"new");
  1769. Babble_getdevs($hash,"new");
  1770. my $pllist = Babble_getplaces($hash,"new",undef);
  1771. Babble_antistupidity($hash);
  1772. my $pmlist="";
  1773. for(my $i=0;$i<int(@{$hash->{DATA}{"splaces"}});$i++){
  1774. $pmlist .= "<a onclick=\"babble_modplace('$name','".$hash->{DATA}{"splaces"}[$i]."',$i)\">".$hash->{DATA}{"splaces"}[$i]."</a> ";
  1775. }
  1776. my $vblist = Babble_getverbs($hash,"new",undef);
  1777. my $vmlist="";
  1778. for(my $i=0;$i<int(@{$hash->{DATA}{"verbsi"}});$i++){
  1779. my $vi = $hash->{DATA}{"verbsi"}[$i];
  1780. my $vmilist = join(',',@{$hash->{DATA}{"verbsicc"}[$i]});
  1781. $vmlist .= "<a onclick=\"babble_modverb('$name','".$vi."','".$vmilist."',$i)\">".$vi."</a> ";
  1782. }
  1783. my $vpmlist = Babble_getwords($hash,"all","new",undef);
  1784. #-- update state display
  1785. #readingsSingleUpdate( $hash, "state", Babble_getstate($hash)." ".$hash->{READINGS}{"short"}{VAL}, 1 );
  1786. #--
  1787. my $lockstate = ($hash->{READINGS}{lockstate}{VAL}) ? $hash->{READINGS}{lockstate}{VAL} : "unlocked";
  1788. my $showhelper = ($lockstate eq "unlocked") ? 1 : 0;
  1789. #--
  1790. $ret .= "<script type=\"text/javascript\" src=\"$FW_ME/pgm2/babble.js\"></script><script type=\"text/javascript\">\n";
  1791. $ret .= "var tt_add='".$babble_tt->{"add"}."';\n";
  1792. $ret .= "var tt_added='".$babble_tt->{"added"}."';\n";
  1793. $ret .= "var tt_remove='".$babble_tt->{"remove"}."';\n";
  1794. $ret .= "var tt_removed='".$babble_tt->{"removed"}."';\n";
  1795. $ret .= "var tt_modify='".$babble_tt->{"modify"}."';\n";
  1796. $ret .= "var tt_modified='".$babble_tt->{"modified"}."';\n";
  1797. $ret .= "var tt_cancel='".$babble_tt->{"cancel"}."';\n";
  1798. $ret .= "var tt_place='".$babble_tt->{"place"}."';\n";
  1799. $ret .= "var tt_verb='".$babble_tt->{"verb"}."';\n";
  1800. $ret .= "var newplace = '<select name=\"d_place\">".Babble_getplaces($hash,"html","none")."</select>';\n";
  1801. $ret .= "var newverbs = '<select name=\"d_verb\">".Babble_getverbs($hash, "html","none")."</select>';\n";
  1802. $ret .= "var newtargs = '<select name=\"d_verbpart\">".Babble_getwords($hash,"targets","html","none")."</select>';\n";
  1803. $ret .= "var newfield = '<input type=\"text\" name=\"d_command\" size=\"30\" maxlength=\"512\" value=\"FHEM command\">';\n";
  1804. $ret .= "var newcheck = '<input type=\"checkbox\" name=\"d_confirm\">';\n";
  1805. $rot .= "</script>\n";
  1806. $rot .= "<table class=\"roomoverview\">\n";
  1807. #-- test table
  1808. $rot .= "<tr><td colspan=\"3\"><div class=\"devType\">".$babble_tt->{"babbletest"}."</div></td></tr>";
  1809. $rot .= "<tr><td colspan=\"3\"><table class=\"block wide\" id=\"testtable\">\n";
  1810. $rot .= "<tr class=\"odd\" ><td class=\"col1\">".$babble_tt->{"input"}.": <input type=\"text\" id=\"d_testcommand\" size=\"60\" maxlength=\"512\"/></td>\n".
  1811. "<td class=\"col1\" style=\"text-align:left\"><input type=\"button\" id=\"b_testit\" onclick=\"babble_testit('".$name."')\" value=\"".$babble_tt->{"test"}."\" style=\"width:100px;\"/</td></tr>\n".
  1812. "<tr class=\"even\"><td class=\"col1\">".$babble_tt->{"result"}.": <div id=\"d_testresult\"></div></td>\n".
  1813. "<td class=\"col1\" style=\"text-align:left\"><input type=\"checkbox\" id=\"b_execit\">".$babble_tt->{"exec"}."</td></tr>\n";
  1814. $rot .= "</table></td></tr>";
  1815. #-- places table
  1816. my $tblrow=1;
  1817. $rot .= "<tr><td colspan=\"3\"><div class=\"devType\">".$babble_tt->{"babbleplaces"}."</div></td></tr>";
  1818. $rot .= "<tr><td colspan=\"3\"><table class=\"block wide\" id=\"placestable\">\n";
  1819. $rot .= "<tr class=\"odd\"><td class=\"col1\">".$babble_tt->{"rooms"}."</td><td class=\"col1\" colspan=\"2\" style=\"horizontal-align:left\">".join(" ",@{$hash->{DATA}{"rooms"}})."</td></tr>\n".
  1820. "<tr class=\"even\"><td class=\"col1\">".$babble_tt->{"places"}."</td><td class=\"col1\" colspan=\"2\" style=\"align:left\">".$pmlist."</td></tr>\n".
  1821. "<tr class=\"odd\"><td class=\"col1\"><input type=\"button\" id=\"b_addplace\" onclick=\"babble_addplace('".$name."')\" value=\"".$babble_tt->{"add"}."\" style=\"width:100px;\"/>".
  1822. "<div id=\"b_chgplacediv\" style=\"width:100px\"></div></td>".
  1823. "<td class=\"col3\" colspan=\"2\"><input type=\"text\" id=\"b_newplace\" size=\"40\" maxlength=\"120\" ></td></tr>\n";
  1824. $rot .= "</table></td></tr>";
  1825. #-- verbs table
  1826. $tblrow=1;
  1827. $rot .= "<tr><td colspan=\"3\"><div class=\"devType\">".$babble_tt->{"babbleverbs"}."</div></td></tr>";
  1828. $rot .= "<tr><td colspan=\"3\"><table class=\"block wide\" id=\"verbstable\">\n";
  1829. $rot .= "<tr class=\"odd\"><td class=\"col1\">".$babble_tt->{"verbs"}."</td><td class=\"col1\" colspan=\"2\" style=\"align:left\">".$vmlist."</td></tr>\n".
  1830. "<tr class=\"even\"><td class=\"col1\"></td>".
  1831. "<td class=\"col3\">".$babble_tt->{"conjugations"}."</td><td class=\"col3\">".$babble_tt->{"infinitive"}."</td></tr>\n".
  1832. "<tr class=\"odd\"><td class=\"col1\"><input type=\"button\" id=\"b_addverb\" onclick=\"babble_addverb('".$name."')\" value=\"".$babble_tt->{"add"}.
  1833. "\" style=\"width:100px;\"/><div id=\"b_chgverbdiv\" style=\"width:100px\"></div></td>".
  1834. "<td class=\"col3\"><input type=\"text\" id=\"b_newverbc\" size=\"20\" maxlength=\"120\" ></td><td class=\"col3\"><input type=\"text\" id=\"b_newverbi\" size=\"20\" maxlength=\"120\" ></td></tr>\n";
  1835. $rot .= "</table></td></tr>";
  1836. #-- devices table
  1837. $tblrow = 0;
  1838. my $ig = 0;
  1839. my $devcount = 0;
  1840. my @devrows = ();
  1841. my $indrow = 0;
  1842. @babblerows = ();
  1843. my($devrow,$ip,$ipp);
  1844. $rot .= "<tr><td colspan=\"3\"><div class=\"devType\">".$babble_tt->{"babbledev"}."</div></td></tr>";
  1845. $rot .= "<tr><td colspan=\"3\"><table class=\"block wide\" id=\"devstable\">\n";
  1846. $rot .= "<tr class=\"odd\"><td class=\"col1\" style=\"text-align:left;padding-right:10px;\">".$babble_tt->{"fhemname"}."</td><td class=\"col2\" style=\"text-align:left\">".$babble_tt->{"device"}."</td>\n".
  1847. "<td class=\"col3\">".$babble_tt->{"place"}."</td><td class=\"col3\">".$babble_tt->{"verb"}."</td><td class=\"col3\">".$babble_tt->{"target"}."</td>\n".
  1848. "<td class=\"col3\">".$babble_tt->{"action"}."</td><td class=\"col3\">".$babble_tt->{"confirm"}."</td><td class=\"col3\"><input type=\"button\" id=\"d_save\" onclick=\"babble_savedevs('".$name."')\" value=\"".$babble_tt->{"save"}.
  1849. "\" style=\"width:100px;\"/></td></tr>\n";
  1850. #-- loop over all unique devices to get some sorting
  1851. if( defined($hash->{DATA}{"devsalias"}) ){
  1852. for my $alidev (sort keys %{$hash->{DATA}{"devsalias"}}) {
  1853. #-- number of devices with this unique
  1854. my $numalias = int(@{$hash->{DATA}{"devsalias"}{$alidev}});
  1855. for (my $i=0;$i<$numalias ;$i++){
  1856. $ig = $hash->{DATA}{"devsalias"}{$alidev}[$i];
  1857. my $bdev = $hash->{DATA}{"devs"}[$ig];
  1858. my $lbdev = lc($bdev);
  1859. my $sbdev = $bdev;
  1860. $sbdev =~s/_\d+$//g;
  1861. my $lsbdev = $lbdev;
  1862. $lsbdev =~s/_\d+$//g;
  1863. my $hlp = $hash->{DATA}{"help"}{$lbdev};
  1864. if( !defined($hlp) ){
  1865. $hlp = $babble_tt->{"speak"}.": ".$sbdev.", ".$babble_tt->{"followedby"}." ";
  1866. #-- places ?
  1867. if( join('_',(keys %{$hash->{DATA}{"command"}{$lbdev}})) ne "none"){;
  1868. $hlp .= $babble_tt->{"placespec"}.", ".$babble_tt->{"followedby"}." ";
  1869. }
  1870. }
  1871. my $checked;
  1872. my $fhemdev = $hash->{DATA}{"devcontacts"}{$lbdev}[1];
  1873. my $contact = $hash->{DATA}{"devcontacts"}{$lbdev}[2];
  1874. $devcount++;
  1875. $tblrow++;
  1876. $ig++;
  1877. $devrow=1;
  1878. #-- headline for device
  1879. $rot .= sprintf("<tr class=\"%s\" style=\"padding-right:25px;\">", ($tblrow&1)?"odd":"even");
  1880. $rot .= "<td width=\"240\" class=\"col1\" style=\"text-align:left;padding-right:10px; border-top:1px solid gray\">";
  1881. #-- local link to device
  1882. if( $contact == 0 ){
  1883. $rot .= "<a href=\"$FW_ME?detail=$fhemdev\">$fhemdev</a>";
  1884. #-- remote link to device
  1885. }else{
  1886. $ip = AttrVal($name,"remoteFHEM".$contact,undef);
  1887. $ipp = $ip =~ s/:.*//sr;
  1888. if( $ip ){
  1889. $rot .= "<a href=\"http://".$ip."/fhem?detail=$fhemdev\">$fhemdev</a> ($ipp)";
  1890. }else{
  1891. $rot .= $fhemdev." (R$contact)";
  1892. }
  1893. }
  1894. $rot .= "</td>\n<td class=\"col2\" style=\"text-align:left; border-top:1px solid gray;padding:2px\">$bdev</td>\n";
  1895. $rot .= "</td>\n<td class=\"col2\" style=\"text-align:right; border-left:1px dotted gray; border-bottom: 1px dotted gray;border-top:1px solid gray;border-bottom-left-radius:10px; padding:2px\">".$babble_tt->{"helptext"}."&rarr;</td>";
  1896. #-- helptext
  1897. $rot .= "<td class=\"col3\" colspan=\"4\" style=\"text-align:left;border-right:1px dotted gray;border-bottom: 1px dotted gray;border-top:1px solid gray;border-bottom-right-radius:10px; padding:2px;\">";
  1898. $rot .= "<input type=\"text\" name=\"d_help\" size=\"51\" maxlength=\"1024\" value=\"".$hlp."\"/></td>";
  1899. $rot .= "<td style=\"text-align:left;padding-right:10px; border-top:1px solid gray\">".
  1900. "<input type=\"button\" id=\"d_addrow\" onclick=\"babble_addrow('".$name."',$devcount,$tblrow)\" value=\"".$babble_tt->{"add"}."\" style=\"width:100px;\"/></td></tr>\n";#$tblrow-$devcount.$devrow
  1901. foreach my $place (keys %{$hash->{DATA}{"command"}{$lbdev}}){
  1902. foreach my $verb (keys %{$hash->{DATA}{"command"}{$lbdev}{$place}}){
  1903. foreach my $target (keys %{$hash->{DATA}{"command"}{$lbdev}{$place}{$verb}}){
  1904. my $cmd = $hash->{DATA}{"command"}{$lbdev}{$place}{$verb}{$target};
  1905. if( !defined($cmd) ){
  1906. Log3 $name,1,"[Babble] Warning: Entry \$hash->{DATA}{\"command\"}{\"".$lbdev."\"}{\"".$place."\"}{\"".$verb."\"}{\"".$target."\"} is undefined";
  1907. $cmd = "undefined"
  1908. }
  1909. if( index($cmd,"\$CONFIRM") != -1 ){
  1910. $checked = "checked=\"checked\" ";
  1911. $cmd =~ s/;;\$CONFIRM$//;
  1912. }else{
  1913. $checked="";
  1914. }
  1915. push(@babblerows,$lbdev."+|+".$place."+|+".$verb."+|+".$target);
  1916. $indrow++;
  1917. $tblrow++;
  1918. $devrow++;
  1919. $rot .= sprintf("<tr class=\"%s\" style=\"padding-right:25px;\"><td></td><td></td>\n", ($tblrow&1)?"odd":"even");
  1920. $pllist = Babble_getplaces($hash,"html",$place);
  1921. $vblist = Babble_getverbs($hash, "html",$verb);
  1922. $vpmlist = Babble_getwords($hash,"targets","html",$target);
  1923. $rot .= "<td class=\"col3\"><select name=\"d_place\">".$pllist."</select></td>".
  1924. "<td class=\"col3\"><select name=\"d_verb\">".$vblist."</select></td>".
  1925. "<td class=\"col3\"><select name=\"d_verbpart\">".$vpmlist."</select></td>\n";
  1926. $rot .= "<td class=\"col3\" style=\"text-align:left;padding:2px\"><input type=\"text\" name=\"d_command\" size=\"30\" maxlength=\"512\" value=\"".$cmd."\"/></td>";
  1927. $rot .= "<td class=\"col3\"><input type=\"checkbox\" name=\"d_confirm\"$checked</td>";
  1928. $rot .= "<td><input type=\"button\" id=\"d_remrow\" onclick=\"babble_remrow('".$name."',$devcount,$tblrow,$indrow)\" value=\"".$babble_tt->{"remove"}."\" style=\"width:100px;\"/></td></tr>\n";#$tblrow-$devcount.$devrow
  1929. }
  1930. }
  1931. }
  1932. push(@devrows,$devrow)
  1933. }
  1934. }
  1935. $rot .= "</table></td></tr>";
  1936. }
  1937. $rot .= "</table>";
  1938. $ret .= "var devrows=[".( (@devrows) ? join(",",@devrows) : "")."];\n";
  1939. $ret .= "var devrowstart=devrows;\n";
  1940. return $ret.$rot;
  1941. }
  1942. 1;
  1943. =pod
  1944. =item helper
  1945. =item summary for speech control of FHEM devices
  1946. =begin html
  1947. <a name="Babble"></a>
  1948. <h3>Babble</h3>
  1949. <ul>
  1950. <p> FHEM module for speech control of FHEM devices</p>
  1951. <a name="babbleusage"></a>
  1952. <h4>Usage</h4>
  1953. See <a href="http://www.fhemwiki.de/wiki/Modul_babble">German Wiki page</a>
  1954. <a name="babbledefine"></a>
  1955. <br/>
  1956. <h4>Define</h4>
  1957. <p>
  1958. <code>define &lt;name&gt; babble</code>
  1959. <br />Defines the Babble device. </p>
  1960. <a name="babbleset"></a>
  1961. Notes: <ul>
  1962. <li>This module uses the global attribute <code>language</code> to determine its output data<br/>
  1963. (default: EN=english). For German output set <code>attr global language DE</code>.</li>
  1964. <li>This module needs the JSON package.</li>
  1965. <li>Only when the chatbot functionality of RiveScript is required, the RiveScript module must be installed as well, see https://github.com/aichaos/rivescript-perl</li>
  1966. </ul>
  1967. <h4>Usage</h4>
  1968. To use this module, call the Perl function <code>Babble_DoIt("&lt;name&gt;","&lt;sentence&gt;"[,&lt;parm0&gt;,&lt;parm1&gt;,...])</code>.
  1969. &lt;name&gt; is the name of the Babble device, &lt;parm0&gt; &lt;parm1&gt; are arbitrary parameters.
  1970. The module will analyze the sentence passed an isolate a device to be addressed, a place identifier,
  1971. a verb, a target and its value from the sentence passed.
  1972. If a proper command has been stored with device, place, verb and target, it will be subject to substitutions and then will be executed.
  1973. In these substitutions, a string $VALUE will be replaced by the value for the target reading, a string $DEV will be replaced by the device name identified by Babble,
  1974. and strings $PARM[0|1|2...] will be replaced by the
  1975. corresponding parameters passed to the function <code>Babble_DoIt</code>
  1976. <ul>
  1977. <li>If no stored command ist found, the sentence is passed to the local RiveScript interpreter if present</li>
  1978. <li>To have a FHEM register itself as a Babble Device, it must get an attribute value <code>babbleDevice=&lt;name&gt;</code>. The <i>name</i> parameter must either be
  1979. unique to the Babble system, or it muts be of the form <code>&lt;name&gt;_&lt;digits&gt;</code></li>
  1980. <li>Devices on remote FHEM installations are defined in the <code>babbleDevices</code> attribute, see below</li>
  1981. </ul>
  1982. <h4>Set</h4>
  1983. <ul>
  1984. <li><a name="babble_lock">
  1985. <code>set &lt;name&gt; locked</code><br />
  1986. <code>set &lt;name&gt; unlocked</code>
  1987. </a>
  1988. <br />sets the lockstate of the babble module to <i>locked</i> (i.e., babble setups
  1989. may not be changed) resp. <i>unlocked</i> (i.e., babble setups may be changed>)</li>
  1990. <li><a name="babble_save">
  1991. <code>set &lt;name&gt; save|restore</code>
  1992. </a>
  1993. <br />Manually save/restore the babble to/from the external file babbleFILE (save done automatically at each state modification, restore at FHEM start)</li>
  1994. <li><a name="babble_rivereload">
  1995. <code>set &lt;name&gt; rivereload</code>
  1996. </a>
  1997. <br />Reload data for RiveScript Interpreter</li>
  1998. <li><a name="babble_test">
  1999. <code>set &lt;name&gt; test</code>
  2000. </a>
  2001. <br />Run a few test cases for normalization</li>
  2002. </ul>
  2003. </ul>
  2004. <a name="babbleget"></a>
  2005. <h4>Get</h4>
  2006. <ul>
  2007. <li><a name="babble_version"></a>
  2008. <code>get &lt;name&gt; version</code>
  2009. <br />Display the version of the module</li>
  2010. <li><a name="babble_tokens"></a>
  2011. <code>get &lt;name&gt; tokens</code>
  2012. <br />Obtain fresh csrfToken from remote FHEM installations (needed after restart of remote FHEM)</li>
  2013. </ul>
  2014. <a name="babbleattr"></a>
  2015. <h4>Attributes</h4>
  2016. <ul>
  2017. <li><a name="babbleDevices"><code>attr &lt;name&gt; babbleDevices [&lt;babble devname&gt;:&lt;FHEM devname&gt;:1|2|3]* </code></a>
  2018. <br />space separated list of <i>remote</i> FHEM devices, each as a group separated by ':' consisting of
  2019. <ul><li>a Babble device name</li>
  2020. <li>a FHEM Device name</li>
  2021. <li>an integer 1..3, indication which of the <i>remoteFHEM</i> functions to be called</li>
  2022. </ul>
  2023. The Babble device name may contain a <b>*</b>-character. If this is the case, it will be considered a regular expression, with the star replaced by <b>(.*)</b>.
  2024. When using Babble with a natural language sentence whose device part matches this regular expression, the character group addressed by the star sequence is placed in the variable
  2025. <code>$STAR</code>, and used to replace this value in the command sequence.
  2026. </li>
  2027. <li><a name="helpFunc"><code>attr &lt;name&gt; helpFunc &lt;function name&rt;</code></a>
  2028. <br/>name of a help function which is used in case no command is found for a certain device. When this function is called, the strings $DEV, $HELP, $PARM[0|1|2...]
  2029. will be replaced by the devicename identified by Babble, the help text for this device and parameters passed to the Babble_DoIt function</li>
  2030. <li><a name="testParm"><code>attr &lt;name&gt; testParm(0|1|2|3) &lt;string&rt;</code></a>
  2031. <br/>if a command is not really excuted, but only tested, the values of these attributes will be used to substitute the strings $PARM[0|1|2...]
  2032. in the tested command</li>
  2033. <li><a name="dnuFile"><code>attr &lt;name&gt; dnuFile &lt;filename&rt;</code></a>
  2034. <br/>if this filename is given, every sentence that could not be analyzed is stored in this file</li>
  2035. <li><a name="confirmFunc"><code>attr &lt;name&gt; confirmFunc &lt;function name&rt;</code></a>
  2036. <br/>name of a confirmation function which is used in case a command is exceuted. When this function is called, the strings $DEV, $HELP, $PARM[0|1|2...]
  2037. will be replaced by the devicename identified by Babble, the help text for this device and parameters passed to the Babble_DoIt function</li>
  2038. <li><a name="noChatBot"><code>attr &lt;name&gt; noChatBot 0|1</code></a>
  2039. <br/>if this attribute is set to 1, a local RiveScript interpreter will be ignored even though it is present in the system</li>
  2040. <li><a name="remoteFHEM"><code>attr &lt;name&gt; remoteFHEM(0|1|2|3) [&lt;user&gt;:&lt;password&gt;@]&lt;IP address:port&rt;</code></a>
  2041. <br/>IP address and port for a remote FHEM installation</li>
  2042. <li><a name="remoteFunc"><code>attr &lt;name&gt; remoteFunc(0|1|2|3) &lt;function name&rt;</code></a>
  2043. <br/>name of a Perl function that is called for addressing a certain remote FHEM device</li>
  2044. <li><a name="remoteToken"><code>attr &lt;name&gt; remoteToken(0|1|2|3) &lt;csrfToken&rt;</code></a>
  2045. <br/>csrfToken for addressing a certain remote FHEM device</li>
  2046. <li><a name="babbleIds"><code>attr &lt;name&gt; babbleIds <id_1> <id_2> ...</code></a>
  2047. <br />space separated list of identities by which babble may be addressed</li>
  2048. <li><a name="babblePreSubs"><code>attr &lt;name&gt; babbleSubs <regexp1>:<replacement1>,<regexp2>:<replacement2>, ...</code></a>
  2049. <br/>space separated list of regular expressions and their replacements - this will be used on the initial sentence submitted to Babble
  2050. (Note: a space in the regexp must be replaced by \s). </li>
  2051. <li><a name="babblePlaces"><code>attr &lt;name&gt; babblePlaces <place_1> <place_2> ...</code></a>
  2052. <br />space separated list of special places to be identified in speech</li>
  2053. <li><a name="babbleNotPlaces"><code>attr &lt;name&gt; babbleNoPlaces <place_1> <place_2> ...</code></a>
  2054. <br />space separated list of rooms (in the local FHEM device) that should <i>not</i> appear in the list of place</li>
  2055. <li><a name="babbleStatus"><code>attr &lt;name&gt; babbleStatus <status_1> <status_2> ...</code></a>
  2056. <br />space separated list of status identifiers to be identified in speech. Example: <code>Status Value Weather Time</code></li>
  2057. <li><a name="babblePrepos"><code>attr &lt;name&gt; babblePrepos <prepo_1> <prepo_2> ...</code></a>
  2058. <br />space separated list of prepositions to be identified in speech. Example: <code>by in at on</code></li>
  2059. <li><a name="babbleTimes"><code>attr &lt;name&gt; babbleTimes <time_1> <time_2> ...</code></a>
  2060. <br />space separated list of temporal adverbs. Example: <code>today tomorrow</code></li>
  2061. <li><a name="babbleQuests"><code>attr &lt;name&gt; babbleQuests <pron_1> <pron_2> ...</code></a>
  2062. <br />space separated list of questioning adverbs. Example: <code>how when where</code></li>
  2063. <li><a name="babbleArticles"><code>attr &lt;name&gt; babbleArticles <art_1> <art_2> ...</code></a>
  2064. <br />space separated list of articles to be identified in speech. Example: <code>the</code></li>
  2065. <li><a name="babbleVerbs"><code>attr &lt;name&gt; babbleVerbs <form1a>,<form1b>...:<infinitive1> <form2a>,<form2b>...:<infinitive2></code></a>
  2066. <br />space separated list of verb groups to be identified in speech. Each group consists of comma separated verb forms (conjugations as well as variations),
  2067. followed by a ':' and then the infinitive form of the verb. Example: <code>speak,speaks,say,says:speaking</code></li>
  2068. <li><a name="babbleWrites"><code>attr &lt;name&gt; babbleWrites <write_1> <write_2> ...</code></a>
  2069. <br />space separated list of write verbs to be identified in speech. Example: <code>send add remove</code></li>
  2070. <li><a name="babbleVerbParts"><code>attr &lt;name&gt; babbleVerbParts <vp_1> <vp_2> ...</code></a>
  2071. <br />space separated list of verb parts to be identified in speech. Example: <code>un re</code></li>
  2072. <li><a name="babble_linkname"><code>attr &lt;name&gt; linkname
  2073. &lt;string&gt;</code></a>
  2074. <br />Name for babble web link, default:
  2075. babbles</li>
  2076. <li><a name="babble_hiddenroom"><code>attr &lt;name&gt; hiddenroom
  2077. &lt;string&gt;</code></a>
  2078. <br />Room name for hidden babble room (containing only the Babble device), default:
  2079. babbleRoom</li>
  2080. <li><a name="babble_publicroom"><code>attr &lt;name&gt; publicroom
  2081. &lt;string&gt;</code></a>
  2082. <br />Room name for public babble room (containing sensor/actor devices), default:
  2083. babble</li>
  2084. <li><a name="babble_lockstate"><code>attr &lt;name&gt; lockstate
  2085. locked|unlocked</code></a>
  2086. <br /><i>locked</i> means that babble setups may not be changed, <i>unlocked</i>
  2087. means that babble setups may be changed></li>
  2088. </ul>
  2089. =end html
  2090. =begin html_DE
  2091. <a name="Babble"></a>
  2092. <h3>Babble</h3>
  2093. <ul>
  2094. <a href="https://wiki.fhem.de/wiki/Modul_Babble">Deutsche Dokumentation im Wiki</a> vorhanden, die englische Version gibt es hier: <a href="/fhem/docs/commandref.html#babble">babble</a>
  2095. </ul>
  2096. =end html_DE
  2097. =cut