######################################################################################## # # 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.42"; 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:textField-long babbleDevices:textField-long babblePlaces:textField-long babbleNotPlaces:textField-long babbleVerbs:textField-long ". "babbleVerbParts:textField-long babblePrepos:textField-long babbleQuests:textField-long babbleArticles:textField-long babbleStatus:textField-long ". "babbleWrites:textField-long babbleTimes:textField-long"; $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 =~ /^((talk)|(doit))/ ) { #-- put args together, then split again at comma boundaries my ($str,@newargs) = split(',',join(' ',@args)); return Babble_DoIt($name,$str,@newargs); #----------------------------------------------------------- }elsif ( $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 talk doit 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 = ""; readingsSingleUpdate( $hash, "text", $sentence, 0 ); #-- 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}; #Log3 $name,5,"[Babble_DoIt] Result after first access of Cmd-Hash =".((defined $cmd)?$cmd:"none"); #-- 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; } } #Log3 $name,5,"[Babble_DoIt] Result after second access of Cmd-Hash =".((defined $cmd)?$cmd:"none"); } #-- 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; } } } } #Log3 $name,5,"[Babble_DoIt] Result after third access of Cmd-Hash =".((defined $cmd)?$cmd:"none"); } #-- 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); readingsSingleUpdate( $hash, "cmd", $cmd, 0 ); }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."\")"); readingsSingleUpdate( $hash, "cmd", $res, 0 ); }else{ readingsSingleUpdate( $hash, "cmd", "remoteFHEM".$contact." ".$cmd, 0 ); $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; } } readingsSingleUpdate( $hash, "cmd", "none => ChatBot text = $reply", 0 ); #-- no chatbot, use help text directly }else{ $reply = defined($hash->{DATA}{"help"}{$device}) ? $hash->{DATA}{"help"}{$device} : ""; readingsSingleUpdate( $hash, "cmd", "none => Help text = $reply", 0 ); } #-- get help function - embed reply of chatbot here 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, 5,"[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, 5,"[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,
    1. call the Perl function Babble_DoIt("<name>","<sentence>"[,<parm0>,<parm1>,...]).
    2. execute the FHEM command set <name> talk|doit <sentence>[,<parm0>,<parm1>,...].
    <name> is the name of the Babble device, <parm0> <parm1> are arbitrary parameters passed to the executed command. 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. Attention: in case the FHEM command is used, <sentence> must not contain commas. 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