######################################################################################## # # Babble.pm # # FHEM module for speech control of FHEM devices # # Prof. Dr. Peter A. Henning # # $Id$ # ######################################################################################## # # This programm is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # (at your option) any later version. # # The GNU General Public License can be found at # http://www.gnu.org/copyleft/gpl.html. # A copy is found in the textfile GPL.txt and important notices to the license # from the author is found in LICENSE.txt distributed with these scripts. # # This script is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # ######################################################################################## package main; use strict; use warnings; use vars qw(%defs); # FHEM device/button definitions use vars qw(%intAt); # FHEM at definitions use vars qw($FW_ME); use JSON; # imports encode_json, decode_json, to_json and from_json. use Encode; my $rive = 0; my $riveinterpreter; #-- RiveScript missing in System if (eval {require RiveScript;1;} ne 1) { Log 1,"[Babble] the RiveScript module is missing from your Perl installation - chatbot functionality not available"; Log 1," check cpan or https://github.com/aichaos/rivescript-perl for download and installation"; } else { RiveScript->import(); $rive = 1; Log 1,"[Babble] the RiveScript module has been imported successfully, chatbot functionality available"; } ######################### # Global variables my $babblelinkname = "babbles"; # link text my $babblehiddenroom = "babbleRoom"; # hidden room my $babblepublicroom = "babble"; # public room my $babbleversion = "1.35"; my @babblerows; my %babble_transtable_EN = ( "ok" => "OK", "notok" => "Not OK", "start" => "Start", "end" => "End", "add" => "Add", "added" => "added", "remove" => "Remove", "removed" => "removed", "modify" => "Modify", "modified" => "modified", "cancel" => "Cancel", "status" => "Status", "notstarted" => "Not started", "next" => "Next", "babbledev" => "Babble Devices", "babbleplaces" => "Babble Places", "babbleverbs" => "Babble Verbs", "babblename" => "Babble Name", "babbletest" => "Babble Test", "fhemname" => "FHEM Name", "device" => "Device", "place" => "Place", "places" => "Places", "rooms" => "Rooms", "verb" => "Verb", "target" => "Target", "result" => "Result", "unknown" => "unknown", "infinitive" => "Infinitive", "conjugations" => "Conjugations and Variations", "helptext" => "Help Text", "confirm" => "Confirmation", "speak" => "Please speak", "followedby" => "followed by", "placespec" => "a place specification", "dnu" => "Sorry, I did not understand this", "input" => "Input", "test" => "Test", "exec" => "Execute", "value" => "Value", "save" => "Save", "action" => "Action", "time" => "Time", "description" => "Description", "settings" => "Settings", "babbles" => "Babble System", "setparms" => "Set Parameters", #-- "hallo" => "Hallo", "state" => "Security", "unlocked" => "Unlocked", "locked" => "Locked" ); my %babble_transtable_DE = ( "ok" => "OK", "notok" => "Nicht OK", "start" => "Start", "end" => "Ende", "add" => "Hinzufügen", "added" => "hinzugefügt", "remove" => "Entfernen", "removed" => "entfernt", "modify" => "Ändern", "modified" => "geändert", "cancel" => "Abbruch", "status" => "Status", "notstarted" => "Nicht gestartet", "next" => "Nächste", "babbledev" => "Babble Devices", "babbleplaces" => "Babble Orte", "babbleverbs" => "Babble Verben", "babblename" => "Babble Name", "babbletest" => "Babble Test", "fhemname" => "FHEM Name", "device" => "Gerät", "place" => "Ort", "places" => "Orte", "rooms" => "Räume", "verb" => "Verb", "target" => "Ziel", "result" => "Ergebnis", "unknown" => "unbekannt", "infinitive" => "Infinitiv", "conjugations" => "Konjugationen und Variationen", "helptext" => "Hilfetext", "confirm" => "Bestätigung", "speak" => "Bitte sprich", "followedby" => "gefolgt von", "placespec" => "einer Ortsangabe", "dnu" => "Es tut mir leid, das habe ich nicht verstanden", "input" => "Input", "test" => "Test", "exec" => "Ausführung", "value " => "Wert", "save" => "Sichern", "action" => "Aktion", "time" => "Zeit", "description" => "Beschreibung", "settings" => "Einstellungen", "babbles" => "Babble", "setparms" => "Parameter setzen", #-- "hallo" => "Hallo", "state" => "Sicherheit", "unlocked" => "Unverschlossen", "locked" => "Verschlossen" ); my $babble_tt; ######################################################################################### # # Babble_Initialize # # Parameter hash = hash of device addressed # ######################################################################################### sub Babble_Initialize ($) { my ($hash) = @_; $hash->{DefFn} = "Babble_Define"; $hash->{SetFn} = "Babble_Set"; $hash->{GetFn} = "Babble_Get"; $hash->{UndefFn} = "Babble_Undef"; #$hash->{AttrFn} = "Babble_Attr"; my $attst = "lockstate:locked,unlocked helpFunc confirmFunc noChatBot:0,1 dnuFile testParm0 testParm1 testParm2 testParm3 ". "remoteFHEM0 remoteFHEM1 remoteFHEM2 remoteFHEM3 remoteFunc0 remoteFunc1 remoteFunc2 remoteFunc3 remoteToken0 remoteToken1 remoteToken2 remoteToken3 ". "babbleIds babblePreSubs babbleDevices babblePlaces babbleNotPlaces babbleVerbs babbleVerbParts babblePrepos babbleQuests babbleArticles babbleStatus babbleWrites babbleTimes"; $hash->{AttrList} = $attst; if( !defined($babble_tt) ){ #-- in any attribute redefinition readjust language my $lang = AttrVal("global","language","EN"); if( $lang eq "DE"){ $babble_tt = \%babble_transtable_DE; }else{ $babble_tt = \%babble_transtable_EN; } } $babblelinkname = $babble_tt->{"babbles"}; $data{FWEXT}{babblex}{LINK} = "?room=".$babblehiddenroom; $data{FWEXT}{babblex}{NAME} = $babblelinkname; #-- Create a new RiveScript interpreter Babble_createRive($hash) if( $rive==1 && !defined($hash->{Rive})) ; return undef; } ######################################################################################### # # Babble_Define - Implements DefFn function # # Parameter hash = hash of device addressed, def = definition string # ######################################################################################### sub Babble_Define ($$) { my ($hash, $def) = @_; my $now = time(); my $name = $hash->{NAME}; $hash->{VERSION} = $babbleversion; #-- readjust language my $lang = AttrVal("global","language","EN"); if( $lang eq "DE"){ $babble_tt = \%babble_transtable_DE; }else{ $babble_tt = \%babble_transtable_EN; } readingsSingleUpdate( $hash, "state", "Initialized", 1 ); $babblehiddenroom = defined($attr{$name}{"hiddenroom"}) ? $attr{$name}{"hiddenroom"} : $babblehiddenroom; $babblepublicroom = defined($attr{$name}{"publicroom"}) ? $attr{$name}{"publicroom"} : $babblepublicroom; $data{FWEXT}{babblex}{LINK} = "?room=".$babblehiddenroom; $data{FWEXT}{babblex}{NAME} = $babblelinkname; $attr{$name}{"room"} = $babblehiddenroom;; my $date = Babble_restore($hash,0); #-- data seems to be ok, restore if( defined($date) ){ Babble_restore($hash,1); Log3 $name,1,"[Babble_Define] data hash restored from save file with date $date"; #-- intialization }else{ $hash->{DATA}{"devs"}=(); $hash->{DATA}{"devcontacts"}=(); $hash->{DATA}{"rooms"}=(); $hash->{DATA}{"splaces"}=(); $hash->{DATA}{"places"}=(); $hash->{DATA}{"commands"}=(); $hash->{DATA}{"help"}=(); $hash->{DATA}{"status"}=(); $hash->{DATA}{"writes"}=(); $hash->{DATA}{"times"}=(); Babble_checkattrs($hash); Log3 $name,1,"[Babble_Define] data hash is initialized"; } #-- Create a new RiveScript interpreter Babble_createRive($hash) if( $rive==1 && !defined($hash->{Rive})) ; $modules{babble}{defptr}{$name} = $hash; RemoveInternalTimer($hash); InternalTimer ($now + 5, 'Babble_CreateEntry', $hash, 0); return; } ######################################################################################### # # Babble_Undef - Implements Undef function # # Parameter hash = hash of device addressed, def = definition string # ######################################################################################### sub Babble_Undef ($$) { my ($hash,$arg) = @_; my $name = $hash->{NAME}; RemoveInternalTimer($hash); delete $data{FWEXT}{babblex}; if (defined $defs{$name."_weblink"}) { FW_fC("delete ".$name."_weblink"); Log3 $hash, 3, "[".$name. " V".$babbleversion."]"." Weblink ".$name."_weblink deleted"; } return undef; } ######################################################################################### # # Babble_Attr - Implements Attr function # # Parameter hash = hash of device addressed, ??? # ######################################################################################### sub Babble_Attr($$$) { my ($cmd, $name, $attrName, $attrVal) = @_; my $hash = $defs{"$name"}; #-- in any attribute redefinition readjust language my $lang = AttrVal("global","language","EN"); if( $lang eq "DE"){ $babble_tt = \%babble_transtable_DE; }else{ $babble_tt = \%babble_transtable_EN; } return; } ######################################################################################### # # Babble_CreateEntry - Puts the babble entry into the FHEM menu # # Parameter hash = hash of device addressed # ######################################################################################### sub Babble_CreateEntry($) { my ($hash) = @_; my $name = $hash->{NAME}; if (!defined $defs{$name."_weblink"}) { FW_fC("define ".$name."_weblink weblink htmlCode {Babble_Html(\"".$name."\")}"); Log3 $hash, 3, "[".$name. " V".$babbleversion."]"." Weblink ".$name."_weblink created"; } FW_fC("attr ".$name."_weblink room ".$babblehiddenroom); foreach my $dn (sort keys %defs) { if ($defs{$dn}{TYPE} eq "FHEMWEB" && $defs{$dn}{NAME} !~ /FHEMWEB:/) { my $hr = AttrVal($defs{$dn}{NAME}, "hiddenroom", ""); if (index($hr,$babblehiddenroom) == -1){ if ($hr eq "") { FW_fC("attr ".$defs{$dn}{NAME}." hiddenroom ".$babblehiddenroom); }else { FW_fC("attr ".$defs{$dn}{NAME}." hiddenroom ".$hr.",".$babblehiddenroom); } Log3 $hash, 3, "[".$name. " V".$babbleversion."]"." Added hidden room '".$babblehiddenroom."' to ".$defs{$dn}{NAME}; } } } #-- recover state from stored readings readingsBeginUpdate($hash); #readingsBulkUpdate( $hash, "state", $mga); readingsEndUpdate( $hash,1 ); } ######################################################################################### # # Babble_Set - Implements the Set function # # Parameter hash = hash of device addressed # ######################################################################################### sub Babble_Set($@) { my ( $hash, $name, $cmd, @args ) = @_; if ( $cmd =~ /^lock(ed)?$/ ) { readingsSingleUpdate( $hash, "lockstate", "locked", 0 ); return; #----------------------------------------------------------- } elsif ( $cmd =~ /^unlock(ed)?$/ ) { readingsSingleUpdate( $hash, "lockstate", "unlocked", 0 ); return; #----------------------------------------------------------- } elsif ( $cmd =~ /^rivereload/ ) { delete $hash->{Rive}; return Babble_createRive($hash); #----------------------------------------------------------- } elsif ( $cmd =~ /^test/ ) { return Babble_Test($hash); #----------------------------------------------------------- } elsif ( $cmd =~ /^save/ ) { return Babble_save($hash); #----------------------------------------------------------- } elsif ( $cmd =~ /^restore/ ) { return Babble_restore($hash,1); } else { my $str = "[babble] Unknown argument " . $cmd . ", choose one of locked:noArg unlocked:noArg save:noArg restore:noArg test:noArg "; $str .= "rivereload:noArg" if($rive == 1 && AttrVal($name,"noChatBot",0) != 1); return $str; } } ######################################################################################### # # Babble_Get - Implements the Get function # # Parameter hash = hash of device addressed # ######################################################################################### sub Babble_Get($@) { my ($hash, @a) = @_; my $res = ""; my $ip; my $name = $hash->{NAME}; my $arg = (defined($a[1]) ? $a[1] : ""); if ($arg eq "version") { return "babble.version => $babbleversion"; }elsif ($arg eq "tokens") { for( my $i=0;$i<=3;$i++ ){ $ip = AttrVal($name,"remoteFHEM$i",undef); if( $ip ){ Babble_getcsrf($name,$ip,$i); } } } else { return "Unknown argument $arg choose one of version:noArg tokens:noArg"; } } ######################################################################################### # # Babble_save # # Parameter hash = hash of the babble device # ######################################################################################### sub Babble_save($) { my ($hash) = @_; my $date = TimeNow(); my $name = $hash->{NAME}; $hash->{DATA}{"savedate"} = $date; readingsSingleUpdate( $hash, "savedate", $date, 1 ); my $jhash0 = toJSON($hash->{DATA}); #$jhash0 = decode_utf8( $jhash0 ); if( ReadingsVal($name,"lockstate","locked") ne "locked" ){ my $error = FileWrite("babbleFILE",$jhash0); Log3 $name,1,"[Babble_save]"; }else{ Log3 $name, 1, "[Babble] attempt to save data failed due to lockstate"; Log3 $name, 5, " ".Dumper($jhash0); } return; } sub Babble_savename($){ my ($name) = @_; my $hash = $defs{$name}; Babble_save($hash); } ######################################################################################### # # Babble_restore # # Parameter hash = hash of the babble device # ######################################################################################### sub Babble_restore($$) { my ($hash,$doit) = @_; my $name = $hash->{NAME}; my ($error,@lines) = FileRead("babbleFILE"); if( defined($error) && $error ne "" ){ Log3 $name,1,"[Babble_restore] read error=$error"; return undef; } my $json = JSON->new->utf8; my $jhash0 = join('',@lines); $jhash0 = encode_utf8( $jhash0 ); my $jhash1 = eval{ $json->decode( $jhash0 ) }; my $date = $jhash1->{"savedate"}; #-- just for the first time, reading an old savefile $date = localtime(time) if( !defined($date)); readingsSingleUpdate( $hash, "savedate", $date, 0 ); if( $doit==1 ){ $hash->{DATA} = {%{$jhash1}}; Log3 $name,1,"[Babble_restore] Data hash restored from save file with date ".$date; return 1; }else{ return $date; } } ######################################################################################### # # Babble_Test - Implements a variety of tests # # Parameter hash = hash of device addressed # ######################################################################################### sub Babble_Test($) { my ($hash) = @_; my $name = $hash->{NAME}; my $str = ""; $str .= "\nA.1:".Babble_DoIt($name,"guten morgen","testit",0); $str .= "\nA.2:".Babble_DoIt($name,"gute nacht","testit",0); $str .= "\nA.3:".Babble_DoIt($name,"guten morgen jeannie","testit",0); $str .= "\nA.4:".Babble_DoIt($name,"gute nacht jeannie","testit",0); $str .= "\n"; $str .= "\nB.1:".Babble_DoIt($name,"schalte das gerät an","testit",0); $str .= "\nB.2:".Babble_DoIt($name,"schalte gerät an","testit",0); $str .= "\nB.3:".Babble_DoIt($name,"mach das gerät an","testit",0); $str .= "\nB.4:".Babble_DoIt($name,"das gerät ausschalten","testit",0); $str .= "\nB.5:".Babble_DoIt($name,"gerät ausschalten","testit",0); $str .= "\nB.6:".Babble_DoIt($name,"das gerät ausmachen","testit",0); $str .= "\nB.7:".Babble_DoIt($name,"gerät anmachen","testit",0); $str .= "\nB.8:".Babble_DoIt($name,"schalte beleuchtung an","testit",0); $str .= "\nB.9:".Babble_DoIt($name,"licht anschalten","testit",0); $str .= "\n"; $str .= "\nC.1:".Babble_DoIt($name,"wie ist der wert von gerät","testit",0); $str .= "\nC.2:".Babble_DoIt($name,"wie ist wert von gerät","testit",0); $str .= "\nC.3:".Babble_DoIt($name,"wie ist der wert gerät","testit",0); $str .= "\nC.4:".Babble_DoIt($name,"wie ist wert gerät","testit",0); $str .= "\nC.4:".Babble_DoIt($name,"sage den status von gerät","testit",0); $str .= "\nC.5:".Babble_DoIt($name,"sage status von gerät","testit",0); $str .= "\nC.6:".Babble_DoIt($name,"sage status gerät","testit",0); $str .= "\n"; $str .= "\nD.1:".Babble_DoIt($name,"wie ist das wetter von morgen","testit",0); $str .= "\nD.2:".Babble_DoIt($name,"wie ist wetter von morgen","testit",0); $str .= "\nD.3:".Babble_DoIt($name,"wie ist das wetter morgen","testit",0); $str .= "\nD.4:".Babble_DoIt($name,"wie ist wetter morgen","testit",0); $str .= "\nD.5:".Babble_DoIt($name,"wie ist morgen das wetter","testit",0); $str .= "\nD.6:".Babble_DoIt($name,"wie ist morgen wetter","testit",0); $str .= "\nD.7:".Babble_DoIt($name,"wetter von morgen","testit",0); $str .= "\nD.8:".Babble_DoIt($name,"wetter morgen","testit",0); $str .= "\n"; $str .= "\nF.1:".Babble_DoIt($name,"schalte den wecker aus","testit",0); $str .= "\nF.2:".Babble_DoIt($name,"schalte wecker aus","testit",0); $str .= "\nF.3:".Babble_DoIt($name,"den wecker ausschalten","testit",0); $str .= "\nF.4:".Babble_DoIt($name,"wecker ausschalten","testit",0); $str .= "\nF.5:".Babble_DoIt($name,"wie ist die weckzeit","testit",0); $str .= "\nF.6:".Babble_DoIt($name,"wie ist der status des weckers","testit",0); $str .= "\nF.7:".Babble_DoIt($name,"weckzeit ansagen","testit",0); $str .= "\nF.8:".Babble_DoIt($name,"weckzeit","testit",0); $str .= "\nF.9:".Babble_DoIt($name,"wecken um 4 uhr 3","testit",0); $str .= "\nF.10:".Babble_DoIt($name,"stelle den wecker auf 17:00","testit",0); $str .= "\nF.11:".Babble_DoIt($name,"wecken um 13:12 Uhr","testit",0); $str .= "\n"; $str .= "\nG.1:".Babble_DoIt($name,"das haus ansagen","testit",0); $str .= "\nG.2:".Babble_DoIt($name,"haus ansagen","testit",0); $str .= "\nG.3:".Babble_DoIt($name,"haus status","testit",0); $str .= "\nG.4:".Babble_DoIt($name,"wie ist der status des hauses","testit",0); $str .= "\nG.5:".Babble_DoIt($name,"wie ist der status vom haus","testit",0); $str .= "\nG.6:".Babble_DoIt($name,"das haus sichern","testit",0); $str .= "\nG.7:".Babble_DoIt($name,"sichere das haus","testit",0); $str .= "\nG.8:".Babble_DoIt($name,"haus sichern","testit",0); $str .= "\nG.9:".Babble_DoIt($name,"das haus entsichern","testit",0); $str .= "\nG.10:".Babble_DoIt($name,"haus entsichern","testit",0); $str .= "\nG.11:".Babble_DoIt($name,"haustür öffnen","testit",0); $str .= "\nG.12:".Babble_DoIt($name,"die haustür öffnen","testit",0); $str .= "\nG.13:".Babble_DoIt($name,"öffne die haustür","testit",0); $str .= "\nG.14:".Babble_DoIt($name,"schließe die haustür zu","testit",0); $str .= "\nG.15:".Babble_DoIt($name,"schließe die haustür auf","testit",0); $str .= "\n"; $str .= "\nH.1:".Babble_DoIt($name,"alarmanlage einschalten","testit",0); $str .= "\nH.1:".Babble_DoIt($name,"alarmanlage ein schalten","testit",0); $str .= "\nH.1:".Babble_DoIt($name,"die alarmanlage scharfschalten","testit",0); $str .= "\nH.2:".Babble_DoIt($name,"alarmanlage unscharf schalten","testit",0); $str .= "\nH.2:".Babble_DoIt($name,"die alarmanlage ausschalten","testit",0); $str .= "\nH.3:".Babble_DoIt($name,"schalte die alarmanlage scharf","testit",0); $str .= "\nH.4:".Babble_DoIt($name,"schalte den alarm an","testit",0); $str .= "\nH.5:".Babble_DoIt($name,"alarm wider rufen","testit",0); $str .= "\nH.6:".Babble_DoIt($name,"alarm widerrufen","testit",0); $str .= "\n"; $str .= "\nI.1:".Babble_DoIt($name,"schalte beleuchtung in sitzgruppe an","testit",0); $str .= "\nI.2:".Babble_DoIt($name,"schalte beleuchtung in der sitzgruppe an","testit",0); $str .= "\nI.3:".Babble_DoIt($name,"mach die beleuchtung auf terrasse an","testit",0); $str .= "\nI.4:".Babble_DoIt($name,"mache außen die beleuchtung aus","testit",0); $str .= "\nI.5:".Babble_DoIt($name,"wie ist die temperatur im badezimmer","testit",0); $str .= "\nI.6:".Babble_DoIt($name,"wie ist die feuchte in dominics zimmer","testit",0); $str .= "\nI.7:".Babble_DoIt($name,"wie ist die feuchte in dem schlafzimmer","testit",0); $str .= "\nI.8:".Babble_DoIt($name,"wie ist der status der tür im schlafzimmer","testit",0); $str .= "\nI.9:".Babble_DoIt($name,"status tür schlafzimmer","testit",0); $str .= "\nI.10:".Babble_DoIt($name,"status der tür schlafzimmer","testit",0); $str .= "\nI.11:".Babble_DoIt($name,"status tür im schlafzimmer","testit",0); $str .= "\nI.12:".Babble_DoIt($name,"status der tür im schlafzimmer","testit",0); $str .= "\n"; $str .= "\nJ.1:".Babble_DoIt($name,"stelle bei gerät den wert auf 8","testit",0); $str .= "\nJ.2:".Babble_DoIt($name,"stelle am gerät wert auf 9","testit",0); $str .= "\nJ.3:".Babble_DoIt($name,"stelle bei harmony den kanal auf 10","testit",0); $str .= "\nJ.4:".Babble_DoIt($name,"stelle am fernseher die lautstärke auf 11","testit",0); $str .= "\n"; $str .= "\nK.1:".Babble_DoIt($name,"zur einkaufsliste hinzufügen bratheringe","testit",0); $str .= "\nK.2:".Babble_DoIt($name,"zu peters liste hinzufügen ticket münchen besorgen","testit",0); $str .= "\nK.3:".Babble_DoIt($name,"von dominics liste entfernen schmieröl","testit",0); $str .= "\nK.4:".Babble_DoIt($name,"baumarktliste löschen","testit",0); $str .= "\nK.5:".Babble_DoIt($name,"einkaufsliste senden","testit",0); return $str; } ############################################################################## # # Babble_Normalize # # Parameter hash = hash of the babble device # ############################################################################## sub Babble_Normalize($$){ my ($name,$sentence) = @_; my $hash = $defs{$name}; $sentence = lc $sentence; $sentence =~ s/[,.]//g; my $cat = 0; my $subcat = 0; my $subsubcat = 0; my ($device,$verb,$reading,$value,$article,$reserve,$place,$state,$prepo)=("","","","","","","","","",""); #-- normalize special phrases my $sentmod = $sentence; my $pairs = AttrVal($name,"babblePreSubs",undef); if( $pairs ){ my @subs=split(' ',$pairs); for( my $i=0; $i{DATA}{"re_places"}/ ){ $place = $word[$i]; my $to = 1; $to++ if( ($i-1)>=0 && $word[$i-1] =~ /^$hash->{DATA}{"re_articles"}/ ); $to++ if( ($i-$to)>=0 && $word[$i-$to] =~ /^$hash->{DATA}{"re_prepos"}/ ); for( my $j=$i+1-$to;$j<$len;$j++){ $word[$j]=($word[$j+$to])?$word[$j+$to]:""; } last; } } #-- backup without place for reserve my @xord = @word; #-- leer if( int(@word) == 0){ return ("","","","","","",""); #-- Kategorie 1: Verb zuerst ---------------------------------------------------------- # schalte das gerät an # schalte gerät an # sage den status von gerät # sage status von gerät # sage status gerät # schalte den wecker aus ; # schalte wecker aus }elsif( ($word[0] =~ /^$hash->{DATA}{"re_verbsc"}/) && ($word[1])){ $cat = 1; #-- get infinitive $verb = $hash->{DATA}{"verbs"}{$word[0]}; if( $word[1] =~ /^$hash->{DATA}{"re_articles"}/){ $subcat = 1; $article = $word[1]; $device = $word[2]; $reading = $word[3]; $reserve = $word[4]; }elsif( $word[1] =~ /^$hash->{DATA}{"re_prepos"}/){ $subcat = 2; $article = $word[1]; $device = $word[2]; }else{ $subcat = 3; $device = $word[1]; $reading = $word[2]; $reserve = $word[3]; } #-- device=state => verb="sage" => reading if( $hash->{DATA}{"re_status"} && $device =~ /^$hash->{DATA}{"re_status"}/ ){ if( $reading =~ /^$hash->{DATA}{"re_prepos"}/ ){ $subsubcat = 1; $reading = $device; $device = $reserve; }else{ $subsubcat = 2; $reserve = $reading; $reading = $device; $device = $reserve; } #-- reading of device => target }elsif( $subcat==2 ){ if( $word[3] =~ /^$hash->{DATA}{"re_articles"}/ ){ $subsubcat = 3; $reading = $word[4]; $reserve = $word[5]; }else{ $subsubcat = 4; $reading = $word[3]; $reserve = $word[4]; } } #-- Kategorie 2 ---------------------------------------------------------- # wie ist der wert von gerät # wie ist wert von gerät # wie ist der wert gerät # wie ist wert gerät # wie ist das wetter morgen # wie ist wetter morgen # wie ist morgen das wetter # wie ist morgen wetter # wie ist die weckzeit # wie ist der status des weckers # (quest) ist (time) [arti1] (reading) [prepo] [arti2] ($device) }elsif( $word[0] =~ /^$hash->{DATA}{"re_quests"}/){ $cat = 2; $verb = "sagen"; my $inext; #-- check time if( $word[2] =~ /^$hash->{DATA}{"re_times"}/){ $value = $word[2]; $inext = 3; }else{ $inext = 2; } #-- take out article if( $word[$inext] =~ /^$hash->{DATA}{"re_articles"}/){ $subcat=1; $article = $word[$inext]; $reading = $word[$inext+1]; #-- check time => device is reading if( $word[$inext+2] =~ /^$hash->{DATA}{"re_times"}/){ $subsubcat = 1; $value = $word[$inext+2]; $device = $reading; #-- check time => device is reading }elsif( $word[$inext+2] =~ /^$hash->{DATA}{"re_prepos"}/ && $word[$inext+3] =~ /^$hash->{DATA}{"re_times"}/){ $subsubcat = 2; $value = $word[$inext+3]; $device = $reading; #--take out preposition }elsif( $word[$inext+2] =~ /^$hash->{DATA}{"re_prepos"}/ ){ if( $word[$inext+3] =~ /^$hash->{DATA}{"re_articles"}/){ $subsubcat = 3; $article = $word[$inext+3]; $device = $word[$inext+4]; }else{ $subsubcat = 4; $device = $word[$inext+3]; } #-- no preposition }else{ if( $word[$inext+2] =~ /^$hash->{DATA}{"re_articles"}/){ $subsubcat = 5; $article = $word[$inext+2]; $device = $word[$inext+3]; }else{ $subsubcat = 6; $device = $word[$inext+2]; } } #-- no article }else{ $subcat=2; $reading = $word[$inext]; #-- check time => device is reading if( $word[$inext+1] =~ /^$hash->{DATA}{"re_times"}/){ $subsubcat = 1; $value = $word[$inext+1]; $device = $reading; #-- check time => device is reading }elsif( $word[$inext+1] =~ /^$hash->{DATA}{"re_prepos"}/ && $word[$inext+2] =~ /^$hash->{DATA}{"re_times"}/){ $subsubcat = 2; $value = $word[$inext+2]; $device = $reading; #--take out preposition }elsif( $word[$inext+1] =~ /^$hash->{DATA}{"re_prepos"}/ ){ if( $word[$inext+2] =~ /^$hash->{DATA}{"re_articles"}/){ $subsubcat = 3; $article = $word[$inext+2]; $device = $word[$inext+3]; }else{ $subsubcat = 4; $device = $word[$inext+2]; } #-- no preposition }else{ if( $word[$inext+1] =~ /^$hash->{DATA}{"re_articles"}/){ $subsubcat = 5; $article = $word[$inext+1]; $device = $word[$inext+2]; }else{ $subsubcat = 6; $device = $word[$inext+1]; } } } if( $device eq ""){ $subsubcat = 7; $device = $reading; $reading = "status"; } #-- Kategorie 3 ---------------------------------------------------------- # das gerät anschalten # gerät anschalten # das wetter von morgen # wetter von morgen # das wetter morgen # wetter morgen # guten morgen # gute nacht # den wecker ausschalten # wecker ausschalten # wecker # status }else{ $cat = 3; my $rex = $hash->{DATA}{"re_verbparts"}." ?".$hash->{DATA}{"re_verbsi"}; #-- guten morgen / gute nacht if( $word[0] =~ /^gut.*/){ $subcat = 1; $device="zeit"; $reading="status"; $value=$word[1]; $reserve=$word[2] if( $word[2] ); $verb="schalten"; #-- (arti) (device) something }elsif( $word[0] =~ /^$hash->{DATA}{"re_articles"}/){ $subcat = 2; $article = $word[0]; $device = $word[1]; shift(@xord); shift(@xord); #--take out preposition if( $word[2] =~ /^$hash->{DATA}{"re_prepos"}/ ){ $subsubcat = 1; shift(@xord); $reserve = join(" ",@xord); }else{ $subsubcat = 2; $reserve = join(" ",@xord); } #-- (arti) (device) [prepo] (time) if( $reserve =~ /^$hash->{DATA}{"re_times"}/ ){ $subsubcat = 3; #$reading = $reserve; $value = $reserve; $verb = "sagen"; #-- (arti) (device) [prepo] verb }elsif( $reserve =~ s/^$hash->{DATA}{"re_verbsi"}\s?// ){ $subsubcat = 4; $verb = $1; $reading = $reserve; #-- (arti) (device) [prepo] (reading) (verb) (value) }else{ $subsubcat = 5; $reserve =~ /^$rex/; #-- named group $verb = $+{verbsi}; $reading = $1; } #-- status [prepo] (device) }elsif( $word[0] =~ /^status/){ $subcat = 3; #--take out preposition if( $word[1] =~ /^$hash->{DATA}{"re_prepos"}/ ){ $subsubcat = 1; $device = $word[2]; }else{ $subsubcat = 2; $device = $word[1]; } $verb = "sagen"; $reading = "status"; #-- (device) something }elsif($word[1] ne ""){ $subcat = 4; $device = $word[0]; shift(@xord); #--take out preposition if( $word[1] =~ /^$hash->{DATA}{"re_prepos"}/ ){ $subsubcat = 1; shift(@xord); $reserve = join(" ",@xord); }else{ $subsubcat = 2; $reserve = join(" ",@xord); } #-- (device) [prepo] (time) if( $reserve =~ /^$hash->{DATA}{"re_times"}/ ){ $subsubcat = 3; $reading = "status"; $value = $reserve; $verb = "sagen"; #-- (device) [prepo] status }elsif( $reserve =~ /^status/ ){ $subsubcat = 4; $reading = "status"; $verb = "sagen"; #-- (device) (write) }elsif( $word[1] =~ /^$hash->{DATA}{"re_writes"}/ ){ $subsubcat = 5; $verb = $word[1]; shift(@xord); $reading = join(" ",@xord); #-- (arti) (device) [prepo] verb }elsif( $reserve =~ s/^$hash->{DATA}{"re_verbsi"}\s?// ){ $subsubcat = 6; $verb = $1; $reading = $reserve; #-- (device) [prepo] (reading) (verb) (value) }else{ $subsubcat = 7; $reserve =~ /^$rex/; #-- named group $verb = $+{verbsi}; $reading = $1; } #-- (device) }else{ $subcat = 5; $device = $word[0]; $reading = "status"; $verb = "sagen"; } } #-- normalize devices $device = "haus" if( $device =~/hauses/); $device = "wecker" if( $device =~/we((ck)|g).*/); $place = "wohnzimmer" if( ($device eq "licht") && ($place eq "")); if( $device eq "außenlicht" ){ $place="aussen" if( $place eq "" ); $device="licht"; } #-- machen $verb = "schalten" if( $verb && $verb eq "machen"); #-- sichern $reading = "zu" if(( $verb && $verb eq "sichern") && ($reading eq "")); #-- an $reading = "status" if( (( $verb && $verb eq "sagen") || ( $verb && $verb eq "zeigen")) && ($reading eq "an")); $reading = "an" if( $reading && $reading eq "ein"); #-- value $value=substr($sentmod,index($sentmod,"auf")+4) if( ($reading && $reading eq "auf") || ($reserve && $reserve eq "auf") ); $value=substr($sentmod,index($sentmod,"hinzufügen")+11) if( $reserve && $reserve =~ /hinzufügen (.*)/ ); if( $verb && $verb eq "entfernen" ){ $value = $reading; $reading = "ent"; } if( $value =~ /.*uhr.*/ ){ $value = Babble_timecorrector($value); } return ($device,$verb,$reading,$value,$article,$reserve,$place,"$cat.$subcat.$subsubcat"); } ######################################################################################### # # Babble_timecorrector - to correct for weird answers from Google # ######################################################################################### sub Babble_timecorrector($){ my ($value) = @_; my ($h,$m1,$m2); #-- xx:yy uhr und zz uhr if( $value =~/(\d?\d):(\d\d) uhr und (\d\d)( uhr)?/ ){ $h = $1*1; $m1 = $2*1; $m2 = $3*1; return(sprintf("%2d\:%02d uhr",$h,$m1+$m2)); #-- xx uhr zz uhr }elsif( $value =~/(\d?\d) uhr (\d\d)( uhr)?/ ){ $h = $1*1; $m1 = $2*1; return(sprintf("%2d\:%02d uhr",$h,$m1)); #-- xx:yy - no correction }elsif( $value =~/(\d?\d)(:(\d\d))?( uhr)?$/ ){ $h = $1*1; $m1 = $3*1; if( $m1 eq "" ){ $m1 = 0; } return(sprintf("%2d\:%02d uhr",$h,$m1)); }else{ return "xx"; } } ######################################################################################### # # Babble_createRive # ######################################################################################### sub Babble_createRive($){ my ($hash) = @_; my $name = $hash->{NAME}; my $rs = $hash->{Rive}; if( !defined($rs) ){ $rs = new RiveScript(utf8=>1); $hash->{Rive} = $rs; Log3 $name, 1, "[Babble] new RiveScript interpreter generated"; } #--load a directory of replies eval{$rs->loadDirectory ("./rivescript")}; #-- sort all the loaded replies $rs->sortReplies; } ######################################################################################### # # Babble_getcsrf # # Parameter ip = ip address of remote FHEM # ######################################################################################### sub Babble_getcsrf($$$){ my ($name,$ip,$i) = @_; my $url = "http://".$ip."/fhem"; HttpUtils_NonblockingGet({ url => $url, callback => sub($$$){ my ($rhash,$err,$data) = @_; my $res = $rhash->{httpheader}; $res =~ /X-FHEM-csrfToken\:\s(csrf_\d+).*/; CommandAttr(undef,$name." remoteToken$i ".$1); } }); } ######################################################################################## # # Babble_DoIt # # Parameter name = name of the babble definition # ######################################################################################### sub Babble_DoIt{ my ($name,$sentence,@parms) = @_; my $hash = $defs{$name}; chomp ($sentence); my $testit = 0; my $exflag = 0; my $confirm= 0; my $res = ""; my $str = ""; my $star = ""; my $reply = ""; #-- semantic analysis my ($device,$verb,$reading,$value,$article,$reserve,$place,$cat) = Babble_Normalize($name,$sentence); $verb = "none" if( !$verb ); $reading = "none" if( !$reading ); if( @parms && $parms[0] eq "testit"){ $testit = 1; shift @parms; $exflag = $parms[0]; shift @parms; for( my $i=0;$i<4;$i++){ $parms[$i] = AttrVal($name,"testParm".$i,undef) if( !defined($parms[$i]) && AttrVal($name,"testParm".$i,undef)); } $str="[Babble_Normalize] ".$babble_tt->{"input"}.": $sentence\n". " ".$babble_tt->{"result"}.": Category=$cat: ". $babble_tt->{"device"}."=$device ".$babble_tt->{"place"}."=$place ". $babble_tt->{"verb"}."=$verb ".$babble_tt->{"target"}."=$reading / $value"; } #-- find command directly my $cmd = $hash->{DATA}{"command"}{$device}{$place}{$verb}{$reading}; #-- not directly - but maybe we have an alias device ? if( !defined($cmd) || $cmd eq "" ){ my $alidev = $device; $alidev =~s/_\d+$//g; my $numalias = (defined($hash->{DATA}{"devsalias"}{$alidev})) ? int(@{$hash->{DATA}{"devsalias"}{$alidev}}) : 0; for (my $i=0;$i<$numalias ;$i++){ my $ig = $hash->{DATA}{"devsalias"}{$alidev}[$i]; my $bdev = $hash->{DATA}{"devs"}[$ig]; my $lbdev = lc($bdev); next if( $lbdev eq $device ); $cmd = $hash->{DATA}{"command"}{$lbdev}{$place}{$verb}{$reading}; if( defined($cmd) && $cmd ne "" ){ $device = $lbdev; last; } } } #-- not directly - but maybe we have a device which is an extension of an alias device if( (!defined($cmd) || $cmd eq "") && defined($device) ){ my $realdev = $device; foreach my $stardev (keys %{$hash->{DATA}{"devsalias"}}){ if(index($stardev,'*')!=-1){ my $starrexp = $stardev; $starrexp =~ s/\*/\(\.\*\)/; if( $realdev =~ m/$starrexp/ ){ $star = $1; $cmd = $hash->{DATA}{"command"}{$stardev}{$place}{$verb}{$reading}; $cmd =~ s/\$STAR/$star/g; if( defined($cmd) && $cmd ne "" ){ $device = $stardev; last; } } } } } #-- command found after all if( defined($cmd) && $cmd ne "" ){ #-- confirmation ? if( index($cmd,"\$CONFIRM") != -1 ){ $confirm=1; $cmd =~ s/;;\$CONFIRM$//; } #-- substitution $cmd =~ s/\$DEV/$device/g; $cmd =~ s/\$VALUE/$value/g; for(my $i=0;$i{DATA}{"devcontacts"}{$device}[2]; my $fhemdev = $hash->{DATA}{"devcontacts"}{$device}[1]; if( $contact == 0 ){ $res = fhem($cmd); }else{ my $ip = AttrVal($name,"remoteFHEM".$contact,undef); my $token = AttrVal($name,"remoteToken".$contact,undef); my $func = AttrVal($name,"remoteFunc".$contact,undef); if( $func && $func ne "" ){ $res = eval($func."(\"".$cmd."\")") }else{ $cmd =~ s/\s/\%20/g; my $url = "http://".$ip."/fhem?XHR=1&fwcsrf=".$token."&cmd.$fhemdev=$cmd"; HttpUtils_NonblockingGet({ url => $url, callback => sub($$$){} }); } } #-- confirm execution my $func = AttrVal($name,"confirmFunc",undef); if( $confirm ){ if ($func && $func ne "" ){ #-- substitution $func =~ s/\$DEV/$device/g; $func =~ s/\$VALUE/$value/g; for(my $i=0;$i{Rive}) ); my $rs = $hash->{Rive}; $reply = $rs->reply ('localuser',$sentence); if ($reply eq "ERR: No Reply Matched"){ $reply = $babble_tt->{dnu}; my $dnufile = AttrVal($name,"dnuFile",undef); if( $dnufile ){ open(my $fh, '>>', $dnufile); print $fh $sentence." => Category=$cat: ". $babble_tt->{"device"}."=$device ".$babble_tt->{"place"}."=$place ". $babble_tt->{"verb"}."=$verb ".$babble_tt->{"target"}."=$reading / $value\n"; close $fh; } } #-- no chatbot, use help text directly }else{ $reply = defined($hash->{DATA}{"help"}{$device}) ? $hash->{DATA}{"help"}{$device} : ""; } #-- get help function my $func = AttrVal($name,"helpFunc",undef); if( $func && $func ne "" ){ #-- substitution $func =~ s/\$HELP/$reply/g; $func =~ s/\$DEV/$device/g; $func =~ s/\$VALUE/$value/g; for(my $i=0;$i{NAME}; CommandAttr (undef,$name." babbleVerbs schalt,schalte:schalten") if( AttrVal($name,"babbleVerbs","") eq "" ); CommandAttr (undef,$name." babbleVerbParts zu auf ent wider ein an aus ab um") if( AttrVal($name,"babbleVerbParts","") eq "" ); CommandAttr (undef,$name." babblePrepos von vom des der in im auf bei am") if( AttrVal($name,"babblePrepos","") eq "" ); CommandAttr (undef,$name." babbleQuests wie wo wann") if( AttrVal($name,"babbleQuests","") eq "" ); CommandAttr (undef,$name." babbleArticles der die das den des dem zur") if( AttrVal($name,"babbleArticles","") eq "" ); CommandAttr (undef,$name." babbleStatus Status Wert Wetter Zeit") if( AttrVal($name,"babbleStatus","") eq "" ); CommandAttr (undef,$name." babbleWrites setzen ändern löschen") if( AttrVal($name,"babbleWrites","") eq "" ); CommandAttr (undef,$name." babbleTimes heute morgen übermorgen nacht") if( AttrVal($name,"babbleTimes","") eq "" ); #}else{ # $hash->{DATA}{"verbsi"}[0]="switching"; # $hash->{DATA}{"verbsicc"}[0][0]="switch"; # CommandAttr (undef,$name." babbleVerbParts re un"); # CommandAttr (undef,$name." babbleQuests by of in on at"); # CommandAttr (undef,$name." babbleAdverb how where when"); # CommandAttr (undef,$name." babbleArticles the to"); # CommandAttr (undef,$name." babbleStatus status value weather time"); #} } ######################################################################################### # # Babble_ModPlace # # Parameter name = name of the babble definition # ######################################################################################### sub Babble_ModPlace($$$){ my ($name,$place,$cmd) = @_; my $hash = $defs{$name}; #-- remove a place (parameter is just a number) if( $cmd == 0){ splice(@{$hash->{DATA}{"splaces"}},$place,1); #-- add a place }else{ push(@{$hash->{DATA}{"splaces"}},$place); } CommandAttr (undef,$name." babblePlaces ".join(" ",@{$hash->{DATA}{"splaces"}})); Babble_getplaces($hash,"new",undef); Babble_save($hash); } ######################################################################################### # # Babble_ModVerb # # Parameter name = name of the babble definition # ######################################################################################### sub Babble_ModVerb($$$$){ my ($name,$verbi,$verbc,$cmd) = @_; my $hash = $defs{$name}; my $verbi2 = $verbi; my $verbc2 = $verbc; # %{$hash->{DATA}{"verbs"}} = hash of all verb => infinitive_verb pairs # @{$hash->{DATA}{"verbsi"}} = array of all infinite verbs # @{$hash->{DATA}{"verbsicc"}} = array of all arrays of conjugated verbs #-- remove a verb - verbi is only a number,verbc is empty if( $cmd == 0){ $verbi2 = $hash->{DATA}{"verbsi"}[$verbi]; $verbc2 = join(',',$hash->{DATA}{"verbsicc"}[$verbi]); splice(@{ $hash->{DATA}{"verbsi"}},$verbi,1); splice(@{ $hash->{DATA}{"verbsicc"}},$verbi,1); #-- add a verb }elsif( $cmd==1) { push(@{$hash->{DATA}{"verbsi"}},$verbi); my @cc=split(',',$verbc); push(@{$hash->{DATA}{"verbsicc"}},\@cc); #-- modify a verb - verbi is only a number,verbc is a list of conjugations }else{ $verbi2 = $hash->{DATA}{"verbsi"}[$verbi]; my @cc=split(',',$verbc); $hash->{DATA}{"verbsicc"}[$verbi]=\@cc; } #-- recreate attribute my $att = ""; for(my $i=0;$i{DATA}{"verbsi"}});$i++){ $att .= join(',',@{ $hash->{DATA}{"verbsicc"}[$i]}).":".$hash->{DATA}{"verbsi"}[$i]." "; } CommandAttr (undef,$name." babbleVerbs ".$att); Babble_getverbs($hash,"new",undef); Babble_save($hash); } ######################################################################################## # # Babble_ModHlp # # Parameter name = name of the babble definition # ######################################################################################### sub Babble_ModHlp($$$){ my ($name,$bdev,$txt) = @_; my $hash = $defs{$name}; #-- lower case characters $bdev = lc($bdev); $hash->{DATA}{"help"}{$bdev}=$txt; } ######################################################################################## # # Babble_ModCmd # # Parameter name = name of the babble definition # ######################################################################################### sub Babble_ModCmd($$$$$$){ my ($name,$bdev,$place,$verb,$target,$cmd) = @_; my $hash = $defs{$name}; #-- lower case characters $bdev = lc($bdev); if( defined($target) && $target ne "" ){ $target = lc($target); delete($hash->{DATA}{"command"}{$bdev}{"none"}{"none"}{"none"}) }else{ $target="none" }; if( defined($verb) && $verb ne "" ){ $verb = lc($verb); delete($hash->{DATA}{"command"}{$bdev}{"none"}{"none"}) }else{ $verb="none" }; if( defined($place) && $place ne "" ){ $place = lc($place); delete($hash->{DATA}{"command"}{$bdev}{"none"}) }else{ $place="none" }; #Log 1,"[Babble_ModCmd] Setting in hash: $bdev.$place.$verb.$target"; $hash->{DATA}{"command"}{$bdev}{$place}{$verb}{$target}=$cmd; } ######################################################################################## # # Babble_RemCmd # # Parameter name = name of the babble definition # ######################################################################################### sub Babble_RemCmd($$$$$$){ my ($name,$bdev,$place,$verb,$target,$fallback) = @_; my $hash = $defs{$name}; #-- lower case characters $bdev = lc($bdev); $place = lc($place); $verb = lc($verb); $target = lc($target); $place="none" if( $place eq ""); $verb="none" if( $verb eq ""); $target="none" if( $target eq ""); #-- trying to delete from data obtained via web if( defined($hash->{DATA}{"command"}{$bdev}{$place}{$verb}{$target}) ){ Log3 $name, 1,"[Babble_RemCmd] Deleting from hash: $bdev.$place.$verb.$target => ".$hash->{DATA}{"command"}{$bdev}{$place}{$verb}{$target}; delete($hash->{DATA}{"command"}{$bdev}{$place}{$verb}{$target}); return #-- try to figure out data from index (fallback strategy) }else{ my $cmdstr = $babblerows[$fallback-1]; ($bdev,$place,$verb,$target)=split('\+\|\+',$cmdstr); Log3 $name, 1,"[Babble_RemCmd] Deleting in fallback strategy from hash: $bdev.$place.$verb.$target => ".$hash->{DATA}{"command"}{$bdev}{$place}{$verb}{$target}; delete($hash->{DATA}{"command"}{$bdev}{$place}{$verb}{$target}); return } } ######################################################################################### # # Babble_getids - Helper function to assemble id list # # Parameter hash = hash of device addressed # ######################################################################################### sub Babble_getids($$) { my ($hash,$type) = @_; my $name = $hash->{NAME}; my $res = ""; # @{$hash->{DATA}{"ids"}} = array of all ids my @ids; #--generate a new list if( $type eq "new" ){ push(@ids,$babble_tt->{"hallo"}); #-- get ids from attribute push(@ids,split(' ',AttrVal($name, "babbleIds", ""))); $hash->{DATA}{"re_ids"} = lc("((".join(")|(",@ids)."))"); return; #-- just do something with the current list }else{ return undef; } } ######################################################################################### # # Babble_getdevs - Helper function to assemble devices list # # Parameter hash = hash of device addressed # ######################################################################################### sub Babble_getdevs($$) { my ($hash,$type) = @_; my $name = $hash->{NAME}; # @{$hash->{DATA}{"devs"}} = array of all Babble devices # %{$hash->{DATA}{"devcontacts"}} = hash of all arrays of contact data (Babble Device, FHEM Device, remote type) my @remotes = (); # intermediate array of all remote groups of Babble device/FHEM device/contact data my @devs = (); # intermediate array of all Babble devices with _number appendix my %devshash = (); # intermediate hash of all Babble devices with _number appendix (for checking existence of name) my %devsalias= (); # hash of arrays of all Babble device aliases without _number appendix my @devcs = (); # intermediate array of all contact data for a certain device my ($bdev,$lbdev,$sbdev,$fhemdev,$contact); #--generate a new list if( $type eq "new" ){ my $ig = 0; $hash->{DATA}{"devs"}=(); $hash->{DATA}{"devcontacts"}=(); #-- local Babble devices raw data foreach my $fhemdev (sort keys %defs ) { $bdev = AttrVal($fhemdev, "babbleDevice",undef); if( defined($bdev) ) { Log3 $name,5,"[Babble_getdevs] finds local FHEM device $fhemdev with babbleDevice=$bdev"; $lbdev = lc($bdev); $sbdev = $lbdev; if(exists($devshash{$lbdev})) { Log3 $name,1,"[Babble_getdevs] Warning: local FHEM device $fhemdev has duplicate babbleDevice=$bdev, is ignored. You need to specifiy ".$bdev."_ instead."; }else{ Log3 $name,5,"[Babble_getdevs] local FHEM device $fhemdev with babbleDevice=$bdev entered into hashes with ig=$ig"; $devs[$ig] = $bdev; #-- take away trailing _ $sbdev =~ s/_\d+$//; #-- put into hash $hash->{DATA}{"devs"}[$ig] = $bdev; $hash->{DATA}{"devcontacts"}{$lbdev}[0] = $bdev; $hash->{DATA}{"devcontacts"}{$lbdev}[1] = $fhemdev; $hash->{DATA}{"devcontacts"}{$lbdev}[2] = 0; $devshash{$lbdev} = 1; if( !defined($devsalias{$sbdev}) ){ $devsalias{$sbdev}[0]=$ig; }else{ push(@{$devsalias{$sbdev}},$ig); } $ig++; #-- safeguard against empty device if( !defined($hash->{DATA}{"command"}{$lbdev})){ Log3 $name,1,"[Babble_getdevs] No entry in command table under $lbdev for local FHEM device $fhemdev with attribute babbleDevice=$bdev"; Babble_ModCmd($name,$sbdev,undef,undef,undef,undef) } } } } #-- get devices from attribute push(@remotes,split(' ',AttrVal($name, "babbleDevices", ""))); for (my $i=0;$i $sbdev =~ s/_\d+$//; if(exists($devshash{$lbdev})) { Log3 $name,1,"[Babble_getdevs] Warning: remote FHEM device $fhemdev has duplicate babbleDevice=$bdev, is ignored. You need to specifiy ".$bdev."_ instead."; }else{ Log3 $name,5,"[Babble_getdevs] remote FHEM device $fhemdev with babbleDevice=$bdev entered into hashes with ig=$ig"; $hash->{DATA}{"devs"}[$ig] = $bdev; $hash->{DATA}{"devcontacts"}{$lbdev}[0] = $bdev; $hash->{DATA}{"devcontacts"}{$lbdev}[1] = $fhemdev; $hash->{DATA}{"devcontacts"}{$lbdev}[2] = $contact; $devshash{$lbdev} = 1; if( !defined($devsalias{$sbdev}) ){ $devsalias{$sbdev}[0]=$ig; }else{ push(@{$devsalias{$sbdev}},$ig); } $ig++; #-- safeguard against empty device if( !defined($hash->{DATA}{"command"}{$lbdev})){ Log 1,"[Babble_getdevs] No entry in command table under $lbdev for remote FHEM device $fhemdev (remote $contact) with attribute babbleDevice=$bdev"; Babble_ModCmd($name,$sbdev,undef,undef,undef,undef) } } } #-- hash of devices without _ %{$hash->{DATA}{"devsalias"}} = %devsalias; #-- regex list for devices to check for validity $hash->{DATA}{"re_devs"} = lc("((".join(")|(",@{$hash->{DATA}{"devs"}})."))") if( defined($hash->{DATA}{"devs"}) ); #-- cleanup commands list for obsolete devices if( defined( $hash->{DATA}{"command"} )){ foreach my $device (keys %{$hash->{DATA}{"command"}}){ if( !defined($hash->{DATA}{"devcontacts"}{$device}) ){ delete($hash->{DATA}{"command"}{$device}); } } } } } ######################################################################################### # # Babble_antistupidity - check for stupid naming of devices or rooms # Parameter hash = hash of device addressed # ######################################################################################### sub Babble_antistupidity($) { my ($hash) = @_; my $name = $hash->{NAME}; my $regexp = $hash->{DATA}{"re_places"}; my $devs = $hash->{DATA}{"devs"}; return if( !defined($regexp) || !defined($devs) ); my $imax = int(@{$hash->{DATA}{"devs"}}); for( my $i=0; $i<$imax; $i++){ my $dev = lc($hash->{DATA}{"devs"}[$i]); Log 1,"[Babble] Baaaaah ! It is not a good idea to name a device $dev similar to a place in Babble" if( $dev =~ /$regexp/ ); } return undef; } ######################################################################################### # # Babble_gethelp - Helper function # Parameter hash = hash of device addressed # ######################################################################################### sub Babble_gethelp($$) { my ($hash,$bdev) = @_; my $name = $hash->{NAME}; my $lbdev = lc($bdev); } ######################################################################################### # # Babble_getplaces - Helper function to assemble places list # # Parameter hash = hash of device addressed # ######################################################################################### sub Babble_getplaces($$$) { my ($hash,$type,$sel) = @_; my $name = $hash->{NAME}; # @{$hash->{DATA}{"rooms"}} = array of all rooms that are not hidden # @{$hash->{DATA}{"splaces"}} = array of all special places for Babble # @{$hash->{DATA}{"places"}} = array of all places for Babble = rooms + special my %rooms; # intermediate hash of all rooms my @special; # intermediate array of all special places for Babble my @places; # intermediate array of rooms/all babble places my $nop = AttrVal($name,"babbleNotPlaces",""); #--generate a new list if( $type eq "new" ){ #-- code lifted from FHEMWEB %rooms = (); # Make a room hash my $hre = AttrVal($FW_wname, "hiddenroomRegexp", ""); foreach my $d (keys %defs ) { #next if(IsIgnored($d)); foreach my $r (split(",", AttrVal($d, "room", "Unsorted"))) { next if($hre && $r =~ m/$hre/); next if($r eq "Unsorted" || $r eq "hidden" || $r eq $babblehiddenroom || $r eq $babblepublicroom ); next if (index($nop, $r) != -1); $rooms{$r}{$d} = 1; } } if(AttrVal($FW_wname, "sortRooms", "")) { # Slow! my @sortBy = split( " ", AttrVal( $FW_wname, "sortRooms", "" ) ); my %sHash; map { $sHash{$_} = FW_roomIdx(\@sortBy,$_) } keys %rooms; @places = sort { $sHash{$a} cmp $sHash{$b} } keys %rooms; } else { @places = sort keys %rooms; } @{$hash->{DATA}{"rooms"}}=@places; #-- append special places from attribute @special = split(' ',AttrVal($name, "babblePlaces", "")); @{$hash->{DATA}{"splaces"}} = @special; push(@places, @special); @{$hash->{DATA}{"places"}} = @places; $hash->{DATA}{"re_places"} = lc("((".join(")|(",@places)."))"); #Babble_save($hash); return; #-- just do something with the current list }elsif( $type eq "html" ){ @places=@{$hash->{DATA}{"places"}}; #-- output if( !defined($sel) ){ return ""; }else{ $sel = lc($sel); #-- todo: geht das einfacher ? $sel =~ s/\xe3\xbc/ü/g; $sel =~ s/\xe3\xb6/ö/g; $sel =~ s/\xe3\xa4/ä/g; $sel =~ s/\xe3\x9f/ß/g; my $ret = ($sel eq "none") ? ''; for( my $i=0;$i' : ''; } return $ret; } }else{ return undef; } } ######################################################################################### # # Babble_getverbs - Helper function to assemble verbs list # # Parameter hash = hash of device addressed # ######################################################################################### sub Babble_getverbs($$$) { my ($hash,$type,$sel) = @_; my $name = $hash->{NAME}; my $res = ""; # %{$hash->{DATA}{"verbs"}} = hash of all verb => infinitive_verb pairs # @{$hash->{DATA}{"verbsi"}} = array of all infinite verbs # @{$hash->{DATA}{"verbsicc"}} = array of all arrays of conjugated verbs my @groups; # intermediate array of all conjugated_verb/infinitive_verb groups my @verbsic; # intermediate array of all conjugations for a certain verb #--generate a new list if( $type eq "new" ){ #-- get verbs from attribute push(@groups,split(' ',AttrVal($name, "babbleVerbs", ""))); for (my $i=0;$i{DATA}{"verbs"}{$vi} = $vi; $hash->{DATA}{"verbsi"}[$i] = $vi; @verbsic=split(',',$vc); for (my $j=0;$j< int(@verbsic);$j++){ my $vcc = $verbsic[$j]; $hash->{DATA}{"verbs"}{$vcc} = $vi; $hash->{DATA}{"verbsicc"}[$i][$j] = $vcc } } $hash->{DATA}{"re_verbsi"} = "(?P(".lc( join(")|(",@{$hash->{DATA}{"verbsi"}}))."))"; #$hash->{DATA}{"re_verbsc"} = lc("((".join(")|(",(keys %{$hash->{DATA}{"verbs"}}))."))"); my $verbsc="(("; while (my ($key, $value) = each %{$hash->{DATA}{"verbs"}}){ $verbsc.=lc($key).")|("; } $verbsc =~ s/\)\|\($/))/; $hash->{DATA}{"re_verbsc"}=$verbsc; return; #-- just do something with the current list }elsif( $type eq "html" ){ my @verbsi=@{$hash->{DATA}{"verbsi"}}; my $fnd = 0; #-- output if( !defined($sel) ){ return ""; }else{ $sel = lc($sel); #-- todo: geht das einfacher ? $sel =~ s/\xe3\xbc/ü/g; $sel =~ s/\xe3\xb6/ö/g; $sel =~ s/\xe3\xa4/ä/g; $sel =~ s/\xe3\x9f/ß/g; #my $sel1 = encode_utf8($sel); #my $sel2 = decode_utf8($sel); my $ret = ($sel eq "none") ? ''; for( my $i=0;$i'; } #if( $fnd==0 ){ # $ret .= ''; #} return $ret; } }else{ return undef; } } ######################################################################################### # # Babble_getwords - Helper function to assemble list of other word classes # # Parameter hash = hash of device addressed # ######################################################################################### sub Babble_getwords($$$$) { my ($hash,$class,$type,$sel) = @_; my $name = $hash->{NAME}; my $res = ""; my @words; if( $type eq "new" ){ if( $class eq "verbparts" || $class eq "all" ) { @words=split(' ',AttrVal($name, "babbleVerbParts", "")); @{$hash->{DATA}{"verbparts"}} = @words; $hash->{DATA}{"re_verbparts"} = lc("((".join(")|(",@words)."))"); } if( $class eq "prepos" || $class eq "all" ) { @words=split(' ',AttrVal($name, "babblePrepos", "")); @{$hash->{DATA}{"prepos"}} = @words; $hash->{DATA}{"re_prepos"} = lc("((".join(")|(",@words)."))"); } if( $class eq "articles" || $class eq "all" ) { @words=split(' ',AttrVal($name, "babbleArticles", "")); @{$hash->{DATA}{"articles"}} = @words; $hash->{DATA}{"re_articles"} = lc("((".join(")|(",@words)."))"); } if( $class eq "status" || $class eq "all" ) { @words=split(' ',AttrVal($name, "babbleStatus", "")); @{$hash->{DATA}{"status"}} = @words; $hash->{DATA}{"re_status"} = lc("((".join(")|(",@words)."))"); } if( $class eq "times" || $class eq "all" ) { @words=split(' ',AttrVal($name, "babbleTimes", "")); @{$hash->{DATA}{"times"}} = @words; $hash->{DATA}{"re_times"} = lc("((".join(")|(",@words)."))"); } if( $class eq "quests" || $class eq "all" ) { @words=split(' ',AttrVal($name, "babbleQuests", "")); @{$hash->{DATA}{"quests"}} = @words; $hash->{DATA}{"re_quests"} = lc("((".join(")|(",@words)."))"); } if( $class eq "writes" || $class eq "all" ) { @words=split(' ',AttrVal($name, "babbleStatus", "")); @{$hash->{DATA}{"writes"}} = @words; $hash->{DATA}{"re_writes"} = lc("((".join(")|(",@words)."))"); } delete($hash->{DATA}{"pronouns"}); #Babble_save($hash); return; #-- just do something with the current list }elsif( $class eq "targets" && $type eq "html" ){ my @targets=@{$hash->{DATA}{"status"}}; push(@targets,"----"); push(@targets,@{$hash->{DATA}{"verbparts"}}); #-- output if( !defined($sel) ){ return ""; }else{ $sel = lc($sel); #-- todo: geht das einfacher ? $sel =~ s/\xe3\xbc/ü/g; $sel =~ s/\xe3\xb6/ö/g; $sel =~ s/\xe3\xa4/ä/g; $sel =~ s/\xe3\x9f/ß/g; my $ret = ($sel eq "none") ? ''; for( my $i=0;$i' : ''; } return $ret; } }else{ return undef; } } ######################################################################################### # # Babble_Html - returns HTML code for the babble page # # Parameter name = name of the babble definition # ######################################################################################### sub Babble_Html($) { my ($name) = @_; my $ret = ""; my $rot = ""; my $hash = $defs{$name}; my $id = $defs{$name}{NR}; if( !defined($babble_tt) ){ #-- readjust language my $lang = AttrVal("global","language","EN"); if( $lang eq "DE"){ $babble_tt = \%babble_transtable_DE; }else{ $babble_tt = \%babble_transtable_EN; } } Babble_checkattrs($hash); Babble_getids($hash,"new"); Babble_getdevs($hash,"new"); my $pllist = Babble_getplaces($hash,"new",undef); Babble_antistupidity($hash); my $pmlist=""; for(my $i=0;$i{DATA}{"splaces"}});$i++){ $pmlist .= "{DATA}{"splaces"}[$i]."',$i)\">".$hash->{DATA}{"splaces"}[$i]." "; } my $vblist = Babble_getverbs($hash,"new",undef); my $vmlist=""; for(my $i=0;$i{DATA}{"verbsi"}});$i++){ my $vi = $hash->{DATA}{"verbsi"}[$i]; my $vmilist = join(',',@{$hash->{DATA}{"verbsicc"}[$i]}); $vmlist .= "".$vi." "; } my $vpmlist = Babble_getwords($hash,"all","new",undef); #-- update state display #readingsSingleUpdate( $hash, "state", Babble_getstate($hash)." ".$hash->{READINGS}{"short"}{VAL}, 1 ); #-- my $lockstate = ($hash->{READINGS}{lockstate}{VAL}) ? $hash->{READINGS}{lockstate}{VAL} : "unlocked"; my $showhelper = ($lockstate eq "unlocked") ? 1 : 0; #-- $ret .= "\n"; $rot .= "\n"; #-- test table $rot .= ""; $rot .= ""; #-- places table my $tblrow=1; $rot .= ""; $rot .= ""; #-- verbs table $tblrow=1; $rot .= ""; $rot .= ""; #-- devices table $tblrow = 0; my $ig = 0; my $devcount = 0; my @devrows = (); my $indrow = 0; @babblerows = (); my($devrow,$ip,$ipp); $rot .= ""; $rot .= ""; } $rot .= "
".$babble_tt->{"babbletest"}."
\n"; $rot .= "\n". "\n". "\n". "\n"; $rot .= "
".$babble_tt->{"input"}.": {"test"}."\" style=\"width:100px;\"/
".$babble_tt->{"result"}.":
".$babble_tt->{"exec"}."
".$babble_tt->{"babbleplaces"}."
\n"; $rot .= "\n". "\n". "". "\n"; $rot .= "
".$babble_tt->{"rooms"}."".join(" ",@{$hash->{DATA}{"rooms"}})."
".$babble_tt->{"places"}."".$pmlist."
{"add"}."\" style=\"width:100px;\"/>". "
".$babble_tt->{"babbleverbs"}."
\n"; $rot .= "\n". "". "\n". "". "\n"; $rot .= "
".$babble_tt->{"verbs"}."".$vmlist."
".$babble_tt->{"conjugations"}."".$babble_tt->{"infinitive"}."
{"add"}. "\" style=\"width:100px;\"/>
".$babble_tt->{"babbledev"}."
\n"; $rot .= "\n". "\n". "\n"; #-- loop over all unique devices to get some sorting if( defined($hash->{DATA}{"devsalias"}) ){ for my $alidev (sort keys %{$hash->{DATA}{"devsalias"}}) { #-- number of devices with this unique my $numalias = int(@{$hash->{DATA}{"devsalias"}{$alidev}}); for (my $i=0;$i<$numalias ;$i++){ $ig = $hash->{DATA}{"devsalias"}{$alidev}[$i]; my $bdev = $hash->{DATA}{"devs"}[$ig]; my $lbdev = lc($bdev); my $sbdev = $bdev; $sbdev =~s/_\d+$//g; my $lsbdev = $lbdev; $lsbdev =~s/_\d+$//g; my $hlp = $hash->{DATA}{"help"}{$lbdev}; if( !defined($hlp) ){ $hlp = $babble_tt->{"speak"}.": ".$sbdev.", ".$babble_tt->{"followedby"}." "; #-- places ? if( join('_',(keys %{$hash->{DATA}{"command"}{$lbdev}})) ne "none"){; $hlp .= $babble_tt->{"placespec"}.", ".$babble_tt->{"followedby"}." "; } } my $checked; my $fhemdev = $hash->{DATA}{"devcontacts"}{$lbdev}[1]; my $contact = $hash->{DATA}{"devcontacts"}{$lbdev}[2]; $devcount++; $tblrow++; $ig++; $devrow=1; #-- headline for device $rot .= sprintf("", ($tblrow&1)?"odd":"even"); $rot .= "\n\n"; $rot .= "\n"; #-- helptext $rot .= ""; $rot .= "\n";#$tblrow-$devcount.$devrow foreach my $place (keys %{$hash->{DATA}{"command"}{$lbdev}}){ foreach my $verb (keys %{$hash->{DATA}{"command"}{$lbdev}{$place}}){ foreach my $target (keys %{$hash->{DATA}{"command"}{$lbdev}{$place}{$verb}}){ my $cmd = $hash->{DATA}{"command"}{$lbdev}{$place}{$verb}{$target}; if( !defined($cmd) ){ Log3 $name,1,"[Babble] Warning: Entry \$hash->{DATA}{\"command\"}{\"".$lbdev."\"}{\"".$place."\"}{\"".$verb."\"}{\"".$target."\"} is undefined"; $cmd = "undefined" } if( index($cmd,"\$CONFIRM") != -1 ){ $checked = "checked=\"checked\" "; $cmd =~ s/;;\$CONFIRM$//; }else{ $checked=""; } push(@babblerows,$lbdev."+|+".$place."+|+".$verb."+|+".$target); $indrow++; $tblrow++; $devrow++; $rot .= sprintf("\n", ($tblrow&1)?"odd":"even"); $pllist = Babble_getplaces($hash,"html",$place); $vblist = Babble_getverbs($hash, "html",$verb); $vpmlist = Babble_getwords($hash,"targets","html",$target); $rot .= "". "". "\n"; $rot .= ""; $rot .= "\n";#$tblrow-$devcount.$devrow } } } push(@devrows,$devrow) } } $rot .= "
".$babble_tt->{"fhemname"}."".$babble_tt->{"device"}."".$babble_tt->{"place"}."".$babble_tt->{"verb"}."".$babble_tt->{"target"}."".$babble_tt->{"action"}."".$babble_tt->{"confirm"}."{"save"}. "\" style=\"width:100px;\"/>
"; #-- local link to device if( $contact == 0 ){ $rot .= "$fhemdev"; #-- remote link to device }else{ $ip = AttrVal($name,"remoteFHEM".$contact,undef); $ipp = $ip =~ s/:.*//sr; if( $ip ){ $rot .= "$fhemdev ($ipp)"; }else{ $rot .= $fhemdev." (R$contact)"; } } $rot .= "$bdev".$babble_tt->{"helptext"}."→"; $rot .= "". "{"add"}."\" style=\"width:100px;\"/>
"; $rot .= "{"remove"}."\" style=\"width:100px;\"/>
"; $ret .= "var devrows=[".( (@devrows) ? join(",",@devrows) : "")."];\n"; $ret .= "var devrowstart=devrows;\n"; return $ret.$rot; } 1; =pod =item helper =item summary for speech control of FHEM devices =begin html

Babble

    FHEM module for speech control of FHEM devices

    Usage

    See German Wiki page

    Define

    define <name> babble
    Defines the Babble device.

    Notes:
    • This module uses the global attribute language to determine its output data
      (default: EN=english). For German output set attr global language DE.
    • This module needs the JSON package.
    • Only when the chatbot functionality of RiveScript is required, the RiveScript module must be installed as well, see https://github.com/aichaos/rivescript-perl

    Usage

    To use this module, call the Perl function Babble_DoIt("<name>","<sentence>"[,<parm0>,<parm1>,...]). <name> is the name of the Babble device, <parm0> <parm1> are arbitrary parameters. The module will analyze the sentence passed an isolate a device to be addressed, a place identifier, a verb, a target and its value from the sentence passed. If a proper command has been stored with device, place, verb and target, it will be subject to substitutions and then will be executed. 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, and strings $PARM[0|1|2...] will be replaced by the corresponding parameters passed to the function Babble_DoIt
    • If no stored command ist found, the sentence is passed to the local RiveScript interpreter if present
    • To have a FHEM register itself as a Babble Device, it must get an attribute value babbleDevice=<name>. The name parameter must either be unique to the Babble system, or it muts be of the form <name>_<digits>
    • Devices on remote FHEM installations are defined in the babbleDevices attribute, see below

    Set

Get

  • get <name> version
    Display the version of the module
  • get <name> tokens
    Obtain fresh csrfToken from remote FHEM installations (needed after restart of remote FHEM)

Attributes

=end html =begin html_DE

Babble

=end html_DE =cut