diff --git a/fhem/CHANGED b/fhem/CHANGED index 02a55b2cd..7fc39b439 100644 --- a/fhem/CHANGED +++ b/fhem/CHANGED @@ -1,5 +1,6 @@ # Add changes at the top of the list. Keep it in ASCII, and 80-char wide. # Do not insert empty lines here, update check depends on it. + - new: 39_Talk2Fhem: new module for language control - feature: 70_BRAVIA: TV input select for all active tuners Channel selection by channel uri Optimized fetch of app and input presets diff --git a/fhem/FHEM/39_Talk2Fhem.pm b/fhem/FHEM/39_Talk2Fhem.pm new file mode 100644 index 000000000..70f9fab6c --- /dev/null +++ b/fhem/FHEM/39_Talk2Fhem.pm @@ -0,0 +1,1973 @@ +################################################################ +# +# Copyright notice +# +# (c) 2018 Oliver Georgi +# +# This script 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. +# +# This copyright notice MUST APPEAR in all copies of the script! +# +################################################################ +# $Id$ +# +# 13.12.2017 0.0.2 diverses +# +# 16.12.2017 0.0.3 neuer pass check: else in @ sowie % +# nicht alle pass keys werden durchlaufen sondern nur die geforderten +# pass ^()$ ergänzt +# +# 19.12.2017 0.1.0 FHEM-Modul Funktionen eingefügt +# Attribute T2F_keywordlist und T2F_modwordlist erzeugt +## 30.12.2017 0.2.0 Umgebungssuchen in regexp unterstützt +# # Kommentierung ermöglicht +# Syntaxcheck der Definition +# Multiple Datumsangaben korrigiert +# Wochentagsangaben korrigiert +# Syntaxvereinfachung +# Regexp-Listen erweitert +# Multilingual DE EN +# 02.01.2018 0.2.1 Liste der erase Wörter erweitert +# problem bei wordlist ergänzung +# multideviceable +# Regexp in HASH auswertung +# Automatische Umlautescaping +# komma in wordlists +# 26.01.2018 0.3.2 extra word search && in phrase +# reihenfolge der DEF wird berücksichtigt +# FHEM helper hash für globale verwendet +# Code aufgeräumt +# including definition files +# zugriff auf Umgebungsmuster und Zeitphrasen +# Phraseindikator ? und ! +# $n@ for keylistsaccess added +# Zahlenwörter in Zeitphrase konvertieren +# Eventgesteurte Befehle +# Leerer set parameter löst den letzten befehl nochmal aus +# 10.02.2018 0.4.0 set CLEARTRIGGERS +# wieder Erkennung verbessert +# Logikfehler bei verschachtelten Sätzen mit "und" behoben +# Neue pass checks float, numeral +# Extraktion des Klammernarrays auch bei Keylistenselector $n@ +# Bug on none existing namelists +# Fhem $_ modifikations bug behoben +# Log ausgaben verbessert +# Neues Attribut T2F_if +# Neues Attribut T2F_origin +# Neuer GET standardfilter +# Neuer GET log +# Neue Variable $IF +# Errormessages detaliert +# Neuer Get @keylist @modlist +# 12.02.2018 0.4.1 Community Notes +# Nested Modifikations +# Neuer Get modificationtypes +################################################################ +# TODO: +# +# device verundung durch regexp klammern? eher durch try and error +# get compare lists +# answerx +# klammern in keywordlists sollen die $n nummerierung nicht beeinflussen +# + +package main; + +use strict; +use warnings; +use POSIX; +use Data::Dumper; +use Time::Local; +use Text::ParseWords; +use Encode qw(decode encode); +my %Talk2Fhem_globals; + + +$Talk2Fhem_globals{version}="0.4.1"; + +$Talk2Fhem_globals{EN}{erase} = ['\bplease\b', '\balso\b', '^msgtext:']; +$Talk2Fhem_globals{EN}{pass} = { + true => '^(yes|1|true|on|open|up|bright.*)$', + false => '^(no|0|false|off|close|down|dark.*)$', + integer => '\d+', + word => '\b(\S{4,})\b', + empty => '^\s*$' +}; +$Talk2Fhem_globals{EN}{numbers} = { +'^one\S*' => 1 +,'^(two|twice)' => 2 +,'^(three|third)' => 3 +,'^four\S*' => 4 +,'^five\S*' => 5 +,'^six\S*' => 6 +,'^seven\S*' => 7 +,'^eight\S*' => 8 +,'^nine\S*' => 9 +,'^ten\S*' => 10 +,'^eleven\S*' => 11 +,'^twelve\S*' => 12 +};$Talk2Fhem_globals{EN}{datephrase} = { + 'tomorrow'=> {days=>1} +, 'day after tomorrow'=> {days=>2} +, 'yesterday'=> {days=>-1} +, 'the day before yesterday'=> {days=>-2} +, 'in (\d+) week\S?'=> {days=>'(7*$1)'} +, 'in (\d+) month(\S\S)?'=> {month=>'"$1"'} +, 'in (\d+) year(\S\S)?'=> {year=>'"$1"'} +, 'next week'=> {days=>7} +, 'next month'=> {month=>1} +, 'next year'=> {year=>1} +, '(on )?sunday'=> {wday=>0} +, '(on )?monday'=> {wday=>1} +, '(on )?tuesday'=> {wday=>2} +, '(on )?Wednesday'=> {wday=>3} +, '(on )?thursday'=> {wday=>4} +, '(on )?friday'=> {wday=>5} +, '(on )?saturday'=> {wday=>6} +, 'in (\d+) days?'=> {days=>'"$1"'} +, 'on (\d\S*(\s\d+)?)'=> {date=>'"$1"'} +}; +$Talk2Fhem_globals{EN}{timephrase} = { + '(in|and|after)? (\d+) hours?' => {hour=>'"$2"'} +, '(in|and|after)? (\d+) minutes?' => {min=>'"$2"'} +, '(in|and|after)? (\d+) seconds?' => {sec=>'"$2"'} +, 'now' => {min=>3} +, 'after' => {min=>30} +, 'later' => {hour=>1} +, 'right now' => {unix=>'time'} +, 'immediately' => {unix=>'time'} +, 'by (\d+) (o.clock)?' => {time=>'"$1"'} +, 'at (\d+) (o.clock)?' => {time=>'"$1"'} +, 'morning' => {time=>'"09:00"'} +, 'evening' => {time=>'"18:00"'} +, 'afternoon' => {time=>'"16:00"'} +, 'morning' => {time=>'"10:30"'} +, 'noon' => {time=>'"12:00"'} +, 'at lunchtime' => {time=>'"12:00"'} +, 'today' => {time=>'"12:00"'} +}; + + +#$Talk2Fhem_globals{DE}{erase} = ['\bbitte\b', '\bauch\b', '\smachen\b', '\sschalten\b', '\sfahren\b', '\bkann\b', '\bsoll\b', '\bnach\b', '^msgtext:']; +$Talk2Fhem_globals{DE}{erase} = ['\bbitte\b', '\bauch\b','\bkann\b', '\bsoll\b']; +# true => '^(ja|1|true|wahr|ein|eins.*|auf.*|öffnen|an.*|rauf.*|hoch.*|laut.*|hell.*)$', +# false => '^(nein|0|false|falsch|aus.*|null|zu.*|schlie\S\S?en|runter.*|ab.*|leise.*|dunk.*)$', +$Talk2Fhem_globals{DE}{numbers} = { +'(ein\S*|erste\S*)' => 1 +,'zwei\S*' => 2 +,'(drei\S*|dritt\S*)' => 3 +,'vier\S*' => 4 +,'fünf\S*' => 5 +,'sechs\S*' => 6 +,'sieb\S*' => 7 +,'acht\S*' => 8 +,'neun\S*' => 9 +,'zehn\S*' => 10 +,'elf\S*' => 11 +,'zwölf\S*' => 12 +}; +$Talk2Fhem_globals{DE}{numberre} = join("|", ('\d+', keys %{$Talk2Fhem_globals{DE}{numbers}})); +$Talk2Fhem_globals{DE}{pass} = { + true => '\b(ja|1|true|wahr|ein|eins.*|auf.*|öffnen|an.*|rauf.*|hoch.*|laut.*|hell.*|start.*|(ab)?spiele\S?)\b', + false => '\b(nein|0|false|falsch|aus.*|null|zu.*|schlie\S\S?en|runter.*|ab.*|leise.*|dunk.*|stop.*|beende\S?)\b', + numeral => {re=>"($Talk2Fhem_globals{DE}{numberre})",fc=>sub{ + return ($_[0]) if $_[0] =~ /\d+/; + my $v = $_[0]; + foreach ( keys %{$Talk2Fhem_globals{DE}{numbers}} ) { + my $tmp = Talk2Fhem_escapeumlauts($_); + last if ($v =~ s/$tmp/$Talk2Fhem_globals{DE}{numbers}{$_}/i); + } + return($v);} + }, + integer => '\b(\d+)\b', + float => {re=>'\b(\d+)(\s*[,.])?(\s*(\d+))?\b',fc=>'"$1".("$4"?".$4":"")'}, + word => '\b(\S{4,})\b', + empty => '^\s*$' +}; +$Talk2Fhem_globals{DE}{datephrase} = { + '(? {days=>1} +, 'übermorgen'=> {days=>2} +, 'gestern'=> {days=>-1} +, 'vorgestern'=> {days=>-2} +, 'in ('.$Talk2Fhem_globals{DE}{numberre}.') woche\S?'=> {days=>'(7*$1)'} +, 'in ('.$Talk2Fhem_globals{DE}{numberre}.') monat(\S\S)?'=> {month=>'"$1"'} +, 'in ('.$Talk2Fhem_globals{DE}{numberre}.') jahr(\S\S)?'=> {year=>'"$1"'} +, 'nächste.? woche'=> {days=>7} +, 'nächste.? monat'=> {month=>1} +, 'nächste.? jahr'=> {year=>1} +, '(am )?sonntag'=> {wday=>0} +, '(am )?montag'=> {wday=>1} +, '(am )?dienstag'=> {wday=>2} +, '(am )?mittwoch'=> {wday=>3} +, '(am )?donnerstag'=> {wday=>4} +, '(am )?freitag'=> {wday=>5} +, '(am )?samstag'=> {wday=>6} +, 'in ('.$Talk2Fhem_globals{DE}{numberre}.') tag(\S\S)?'=> {days=>'"$1"'} +, 'am (\d\S*(\s\d+)?)'=> {date=>'"$1"'} +}; +$Talk2Fhem_globals{DE}{timephrase} = { + '(in|und|nach)? ('.$Talk2Fhem_globals{DE}{numberre}.') stunde.?' => {hour=>'"$2"'} +, '(in|und|nach)? ('.$Talk2Fhem_globals{DE}{numberre}.') minute.?' => {min=>'"$2"'} +, '(in|und|nach)? ('.$Talk2Fhem_globals{DE}{numberre}.') sekunde.?' => {sec=>'"$2"'} +, 'gleich' => {min=>3} +, 'nachher' => {min=>30} +, 'später' => {hour=>1} +, 'jetzt' => {unix=>'time'} +, 'sofort' => {unix=>'time'} +, 'um ('.$Talk2Fhem_globals{DE}{numberre}.') (uhr)?' => {time=>'"$1"'} +, 'um ('.$Talk2Fhem_globals{DE}{numberre}.') uhr ('.$Talk2Fhem_globals{DE}{numberre}.')' => {hour=>'"$1"', min=>'"$1"'} ############ ZU TESTEN +, 'früh' => {time=>'"09:00"'} +, '(? {time=>'"18:00"'} +, 'nachmittags?' => {time=>'"16:00"'} +, 'vormittags?' => {time=>'"10:30"'} +, 'mittags?' => {time=>'"12:00"'} +, 'heute' => {time=>'"12:00"'} +}; + + +sub Talk2Fhem_Initialize($); +sub Talk2Fhem_Define($$); +sub Talk2Fhem_Undef($$); +sub Talk2Fhem_Delete($$); +sub Talk2Fhem_Notify($$); +sub Talk2Fhem_Set($@); +sub Talk2Fhem_addND($); +sub Talk2Fhem_UpdND($); +sub Talk2Fhem_Get($$@); +sub Talk2Fhem_Attr(@); +sub Talk2Fhem_Loadphrase($$$); +sub Talk2Fhem_parseParams($); +sub Talk2Fhem_realtrim($); +sub Talk2Fhem_normalize($); +sub Talk2Fhem_parseArray($;$$); +sub Talk2Fhem_loadList($$;$); +sub Talk2Fhem_language($); +sub Talk2Fhem_mkattime($$); +sub Talk2Fhem_exec($$$); +sub T2FL($$$); +sub Talk2Fhem_Initialize($) +{ + my ($hash) = @_; + + $hash->{DefFn} = "Talk2Fhem_Define"; + $hash->{UndefFn} = "Talk2Fhem_Undef"; +# $hash->{DeleteFn} = "X_Delete"; + $hash->{SetFn} = "Talk2Fhem_Set"; + $hash->{GetFn} = "Talk2Fhem_Get"; +# $hash->{ReadFn} = "X_Read"; +# $hash->{ReadyFn} = "X_Ready"; + $hash->{AttrFn} = "Talk2Fhem_Attr"; + $hash->{NotifyFn} = "Talk2Fhem_Notify"; +# $hash->{RenameFn} = "X_Rename"; +# $hash->{ShutdownFn} = "X_Shutdown"; + $hash->{AttrList} = + "disable:0,1 T2F_disableumlautescaping:0,1 T2F_origin T2F_filter T2F_if:textField-long T2F_keywordlist:textField-long T2F_modwordlist:textField-long T2F_language:EN,DE"; + + + +} + +sub Talk2Fhem_Define($$) +{ + my ( $hash, $def ) = @_; + + $hash->{STATE} = "Loading"; + + if ($def =~ /^\S+ Talk2Fhem$/) { + $hash->{DEF} = ""; + + return; + } + + my $error = undef; + + my @def = split(/ /, $def); + my $name = shift(@def); + my $dev = shift(@def); + + + $error = Talk2Fhem_Loadphrase($hash, "phrase", "@def"); + + ($_ = Talk2Fhem_loadList($hash, "T2F_keywordlist")) && return; + ($_ = Talk2Fhem_loadList($hash, "T2F_modwordlist")) && return; + + T2FL($name, 1, $error) if $error; +# T2FL($name, 5, "T2F Phrasehash:\n".Dumper($Talk2Fhem_phrase{$name})) unless $error; + T2FL($name, 5, "T2F Phrasehash:\n".Dumper($hash->{helper}{phrase})) unless $error; + + $hash->{STATE} = "Initialized"; + return $error; +} + +sub Talk2Fhem_Loadphrase($$$) { + + my $hash = shift; + my $target = shift; + my $text = "@_"; + my @h = Talk2Fhem_parseParams($text); + return ("Error while parsing Definition.\n$h[0]"."\n\n$text" ) unless(ref($h[0]) eq "HASH"); + + # Not ready yet + return unless $hash->{helper}; + + my $disu =AttrVal($hash, "T2F_disableumlautescaping", 0); + my %keylist = %{$hash->{helper}{T2F_keywordlist}} if $hash->{helper}{T2F_keywordlist}; + + + my $i=0; + while ($i <= $#h) { + my $elmnt = $h[$i]; + if ($$elmnt{key} eq '$include') { + T2FL $hash->{NAME}, 4, "Loading Configfile $$elmnt{val}"; + +# open(my $fh, '<:encoding(UTF-8)', $$elmnt{val}) +# open fh, "<", $$elmnt{val} +# or return "Could not open file '$$elmnt{val}' $!"; + my ($error, @content) = FileRead($$elmnt{val}); + return "$error '$$elmnt{val}'" if $error; + + #local $/; + my @file = Talk2Fhem_parseParams(join("\n",@content)); + #close("fh"); + return ("Error while parsing File $$elmnt{val}.\n$file[0]"."\n\n$text" ) unless(ref($file[0]) eq "HASH"); + splice @h, $i, 1; + splice @h, $i, 0, @file; + +# push(@h, @file); + next; + } + + + + if ($$elmnt{val} =~ /^\((.*)\)/) { + #my %r = eval($$elmnt{val}); + #Log 1, "Hallo: ".$1; + my %r; + my $harr = Talk2Fhem_parseArray($1, undef, 1); + for (@$harr) { + my $h = Talk2Fhem_parseArray($_, "=>", /^[^=]*=>[\t\s\n]*[^"']/); + #my @arr = /(.*?)=>(.*)/; + #$h = Talk2Fhem_parseArray($_, "=>", 1) if $$h[0]=~ /answer/; + + $r{$$h[0]} = $$h[1]; + } + return("Error while parsing Definition HASH.\n".$$elmnt{val}."\n\n$text") unless (%r); + $$elmnt{val} = \%r; + }elsif ($$elmnt{val} =~ /^\(.*[^)]$/) { + return("Error while parsing Definition HASH.\nDid you forget closing ')' in:\n".$$elmnt{val}."\n\n$text"); + } else { + my $tmp=$$elmnt{val}; + $$elmnt{val} = undef; + $$elmnt{val}{($target eq "phrase") ? "cmd" : $target} = $tmp; +# $$elmnt{val}{cmd} = $tmp; + } + + #alternative syntax wenn nur ein value +# elsif ($$elmnt{key} =~ /^\$if.*?\s+(.*)/) { + #return("Syntax Error. Can't locate IF condition.") unless $1; + #return("Syntax Error. Can't locate IF regexp.") unless $$elmnt{val}; + #$hash->{helper}{ifs} = { IF=>$$elmnt{val}, regexp=>"$1" }; + #splice @h, $i, 1; + #next; +# } + $i++; + + # Regexp Auflösung und Analyse + my $d=0; + my @hitnokeylist=(AttrVal($hash->{NAME}, "T2F_origin", undef)); + my @phrs = map { Talk2Fhem_realtrim($_) } split(/[\t\s]*\&\&[\t\s]*/, $$elmnt{key}); + for my $phr (@phrs) { + my $keylistname; + my $tmp = $phr; + # klammern zählen die nicht geslasht sind und kein spezialklammern sind (? + while ($tmp =~ /(?{helper}{$target} = \@h; + + return(undef); + +} + + +sub Talk2Fhem_Undef($$) +{ + my ( $hash, $name) = @_; + + $hash->{helper} = undef; + + return undef; +} + +sub Talk2Fhem_Delete($$) +{ + my ( $hash, $name ) = @_; + + return undef; +} + +sub Talk2Fhem_Notify($$) +{ + my ($own_hash, $dev_hash) = @_; + my $ownName = $own_hash->{NAME}; + + my $devName; # Device that created the events + for (@{$$own_hash{helper}{notifiers}}) { + $devName = $dev_hash->{NAME} if $_ eq $dev_hash->{NAME}; + } + return "" unless $devName; + my $events = deviceEvents($dev_hash, 1); + + my @nots = @{$$own_hash{helper}{notifies}}; + my $i=0; +# for my $i (0 .. $#nots) { + while ($i <= $#{$$own_hash{helper}{notifies}}) { + my $not = ${$$own_hash{helper}{notifies}}[$i]; + if (grep { $devName eq $_ } (@{$$not{devs}})) { + T2FL $own_hash, 4, "Event detected ".$$not{if}; + my $res = fhem($$not{if}); + T2FL $own_hash, 5, "Result: ".$res; + if ($res == 1) { + T2FL $own_hash, 3, "Execute command: ".$$not{cmd}; + + my $fhemres = fhem($$not{cmd}); + readingsSingleUpdate($own_hash, "response", $fhemres, 1); + splice(@{$$own_hash{helper}{notifies}}, $i--, 1); + Talk2Fhem_UpdND($own_hash); + } elsif ($res) { + T2FL $own_hash, 1, "Error on condition ($$not{if}): $res"; + readingsSingleUpdate($own_hash, "response", $res, 1); + splice(@{$$own_hash{helper}{notifies}}, $i--, 1); + Talk2Fhem_UpdND($own_hash); + } + } + $i++; + } + + return "" if(IsDisabled($ownName)); + + if($devName eq "global" && grep(m/^INITIALIZED|REREADCFG$/, @{$events})) + { + #Talk2Fhem_parseKeys($own_hash); + } +} + +sub Talk2Fhem_Set($@) +{ + my ( $hash, $name, @args ) = @_; + (return "\"set $name\" needs at least one argument") unless(scalar(@args)); + (return "Unknown argument ?, choose one of ! cleartriggers:noArg cleartimers:noArg") if($args[0] eq "?"); + + if ($hash->{STATE} ne "Initialized") { + #Fülle nur cmds array + } elsif ($args[0] eq "cleartimers") { + AnalyzeCommand($hash->{CL}, "delete at_".$name."_.*"); + } elsif ($args[0] eq "cleartriggers") { + + $$hash{helper}{notifies} = []; + Talk2Fhem_UpdND($hash); + } else { + $hash->{STATE} = "Loading"; + shift @args if $args[0] eq "!"; + @args = ReadingsVal($name, "set", undef) unless(scalar(@args)); + + #my $txt = s/[^\x00-\xFF]//g; + #my $txt = decode("utf8", "@args"); + my $txt = "@args"; + Talk2Fhem_Loadphrase($hash, "phrase", $hash->{DEF}) unless $hash->{helper}{phrase}; + Talk2Fhem_Loadphrase($hash, "if", AttrVal($name, "T2F_if","")) if (AttrVal($name, "T2F_if",0) and ! $hash->{helper}{if}); + + readingsSingleUpdate($hash, "set", "$txt", 1); + + $hash->{STATE} = "Initialized"; + + $hash->{STATE} = "Working"; + + + + my %res = Talk2Fhem_exec("$txt", $hash, $name); + + if (%res && ! $res{err} && $res{cmds}) { + #Ausführen + if ($res{cmds}) { + for my $h (@{$res{cmds}}) { + my $fhemcmd = ($$h{at}?Talk2Fhem_mkattime($name, $$h{at})." ":"").$$h{cmd}; + + unless ($$h{ifs}) { # kein IF + + T2FL $name, 5, "Executing Command: ".$fhemcmd; + my $fhemres = AnalyzeCommandChain ($hash->{CL}, $fhemcmd) unless (IsDisabled($name)); + $$h{"fhemcmd"} = $fhemcmd; + push(@{$res{fhemres}}, $fhemres) if ($fhemres); + T2FL $name, 5, "Pushed: ".$fhemcmd; + } else { # If + #Event erstellen + my %r; + $r{hash} = $hash; + $r{if} = "IF ((".(join(") and (", @{$$h{ifs}})).")) ({1})"; + my $test = AnalyzeCommandChain ($hash->{CL}, $r{if}); + if ($test and $test ne "1") { + T2FL $name, 1, "Condition $r{if} failed: ".$test; + push(@{$res{fhemres}}, $test); + next; + } my %s = (); # make it unique + push(@{$r{devs}}, grep { ! $s{$_}++ } map {/\[(.*?)[:\]]/g} @{$$h{ifs}}); + $r{cmd} = $fhemcmd; + Talk2Fhem_addND(\%r); + } + } + } + } else { + # Nothing to do + T2FL $name, 1, "Nothing to do: ".$txt; + } + + #push(@{$res{err}}, "FHEM: ".$fhemres) if $fhemres; + + my $status; + if ($res{fhemres}) { $status = "response" } + elsif (IsDisabled($name)) {$status = "disabled"} + elsif ($res{err}) {$status = "err"} + elsif ($res{answers}) {$status = "answers"} + else {$status = "done"} + + + readingsBeginUpdate($hash); + #T2FL($hash, 1, "CL:\n".Dumper($hash->{CL})); + #readingsBulkUpdate($hash, "client", $hash->{CL}{NAME}); + readingsBulkUpdate($hash, "ifs", join(" and ", @{$res{ifs}})) if $res{ifs}; + #readingsBulkUpdate($hash, "cmds", join(";\n", map { ($$_{at}?Talk2Fhem_mkattime($name, $$_{at})." ":"").$$_{cmd} } @{$res{cmds}})) if $res{cmds}; + readingsBulkUpdate($hash, "cmds", join(";\n", map { $$_{"fhemcmd"} } @{$res{cmds}})) if $res{cmds}; + readingsBulkUpdate($hash, "answers", join(" und ", @{$res{answers}})) if $res{answers}; + readingsBulkUpdate($hash, "err", join("\n", @{$res{err}})) if $res{err}; + readingsBulkUpdate($hash, "response", join("\n", @{$res{fhemres}})) if $res{fhemres}; + readingsBulkUpdate($hash, "status", $status); + ### in done könnte + readingsEndUpdate($hash, 1); + + + } + $hash->{STATE} = "Initialized"; + return; +} + +sub Talk2Fhem_addND($) { + #Log 1, Dumper $_[0]{cmds}; + my $hash = $_[0]{hash}; + unless(IsDisabled($$hash{NAME})) { + my %h; + for (keys %{$_[0]}) { + next if /hash/; + $h{$_} = $_[0]{$_}; + } + push(@{$$hash{helper}{notifies}}, \%h); + Talk2Fhem_UpdND($hash); + } +} + +sub Talk2Fhem_UpdND($) { + my ($hash) = @_; + my %s = (); # make it unique + my @ntfs = @{$$hash{helper}{notifies}}; + @{$$hash{helper}{notifiers}} = grep { ! $s{$_}++ } map { @{$$_{devs}} } @ntfs; + #$$hash{NOTIFYDEV} = join ",",@{$$hash{helper}{notifiers}}; + notifyRegexpChanged($hash, join "|",@{$$hash{helper}{notifiers}}); + readingsSingleUpdate($hash, "notifies", join( "\\n", map {$$_{if}} @ntfs), 1); + T2FL $hash, 4, "Updated NotifyDev: ".join( "|", @{$$hash{helper}{notifiers}}); + T2FL $hash, 5, "Updated NotifyDev: ".Dumper @ntfs; +} + +sub Talk2Fhem_Get($$@) +{ + my ( $hash, $name, $opt, @args ) = @_; + my $lang = Talk2Fhem_language($hash); + return "\"get $name\" needs at least one argument" unless(defined($opt)); + + if($opt eq "keylistno") + { + my $res; + my $keylist = Talk2Fhem_parseParams(AttrVal($name, "T2F_keywordlist", "")); + foreach (keys %$keylist) { + $res .= $_.":\n"; + my $arr = Talk2Fhem_parseArray($$keylist{$_}); + for (my $i=0;$i<=$#$arr;$i++) { + $res .= ($i+1).": ".$arr->[$i]."\n"; + } + } + return $res; + } + elsif($opt =~ /^\@/) + { + my $keylist = Talk2Fhem_parseParams(AttrVal($name, "T2F_keywordlist", "")); + my $modlist = Talk2Fhem_parseParams(AttrVal($name, "T2F_modwordlist", "")); + + + my $r; + + (my $kwl = $opt) =~ s/^\@//; + (my $mwl = $args[0]) =~ s/^\@//; + my $kw = Talk2Fhem_parseArray($$keylist{$kwl}); + my $mw = Talk2Fhem_parseArray($$modlist{$mwl}); + + my $l=11; + map { $l = length($_) if length($_) > $l } (@$kw); + $r .= "Keywordlist".(" " x ($l-11))." : "."Modwordlist\n"; + $r .= $opt.(" " x ($l-length($opt)))." : ".$args[0]."\n\n"; + + for my $i (0..$#$kw) { + $r .= ($$kw[$i]//"").(" " x ($l-length(($$kw[$i]//""))))." : ".($$mw[$i]//"")."\n"; + } + + + return($r); + } + elsif($opt eq "standardfilter") + { + my $atr=AttrVal($name, "T2F_filter", 0); + my $filter = join(',',@{$Talk2Fhem_globals{Talk2Fhem_language($name)}{erase}}); + if ($atr) { + return("Attribute T2F_filter is not empty please delete it."); + } else { + fhem("attr $name T2F_filter $filter"); + return("Filterattribute set to standard."); + } + } + elsif($opt eq "log") + { + return($hash->{helper}{LOG}); + } + elsif($opt eq "modificationtypes") + { + my $res = ref $Talk2Fhem_globals{$lang}{pass}{$args[0]} && $Talk2Fhem_globals{$lang}{pass}{$args[0]}{re} || $Talk2Fhem_globals{$lang}{pass}{$args[0]}; + return(($lang eq "DE" ? "Folgende RegExp wird erwartet:\n" : "The following regexp is expected:\n").$res); + } + elsif($opt eq "datedefinitions") + { + return(Dumper %{$Talk2Fhem_globals{$lang}{datephrase}}); + } + elsif($opt eq "timedefinitions") + { + return(Dumper %{$Talk2Fhem_globals{$lang}{timephrase}}); + } + elsif($opt eq "version") + { + return(Dumper $Talk2Fhem_globals{version}); + } +# ... + else + { + my $keylist = Talk2Fhem_parseParams(AttrVal($name, "T2F_keywordlist", "")); + my $modlist = Talk2Fhem_parseParams(AttrVal($name, "T2F_modwordlist", "")); + return "Unknown argument $opt, choose one of keylistno:noArg log:noArg standardfilter:noArg version:noArg". + " @".join(" @",map { $_.":@".join(",@", sort keys %$modlist) } sort keys %$keylist). + " modificationtypes:".join(",", sort keys %{$Talk2Fhem_globals{$lang}{pass}}). + " datedefinitions:noArg timedefinitions:noArg"; + } +} + +sub Talk2Fhem_Attr(@) +{ + my ( $cmd, $name, $attrName, $attrValue ) = @_; + + # $cmd - Vorgangsart - kann die Werte "del" (löschen) oder "set" (setzen) annehmen + # $name - Gerätename + # $attrName/$attrValue sind Attribut-Name und Attribut-Wert + + #Log 1, Dumper @_; + if ($attrName eq "T2F_keywordlist" or $attrName eq "T2F_modwordlist") { + $defs{$name}{helper}{phrase} = undef; + $defs{$name}{helper}{if} = undef; + if ($cmd eq "set") { + T2FL $name, 4, "Attribute checking!"; + return Talk2Fhem_loadList($defs{$name}, $attrName, $attrValue); + } else { + delete $defs{$name}{helper}{$attrName}; + } + } + + if ($attrName eq "T2F_if") { + if ($cmd eq "set") { + return(Talk2Fhem_Loadphrase($defs{$name}, "if", $attrValue)); + } else { + delete $defs{$name}{helper}{if}; + } + } + + + #elsif ($attrName eq "T2F_filter") { + #Log 1, "HALLO".$defs{global}{STATE}; + #my $preattr = AttrVal($name, "T2F_filter", ""); + #if ($preattr eq "") { + # $_[3] = join(",", @{$Talk2Fhem_globals{Talk2Fhem_language($name)}{erase}}).",".$attrValue; + #}} + return undef; +} + +sub Talk2Fhem_parseParams_old($) +{ + my ($val) = @_; + my %res; my $i=0; + foreach my $v (split(/\n/,$val)) { +# if ($v =~ /^[ \t]*(?!#)(.*?)[ \t]+=[ \t]+(.*?)[ \t]*$/) { + $i++; + $v =~ s/#.*//; + next unless $v; + + if ($v =~ /^[ \t]*(.*?)[ \t]+=[ \t]+(.*?)[ \t]*$/) { + return ("#$i Missing REGEXP '$v'") unless ($1); + return ("#$i Missing Command '$v'") unless ($2); + $res{$1} = $2; + } else { + return ("#$i Syntaxerror. '$v'\nDid you forget whitespace before or after '='"); + } + } + return(\%res); +} + +sub Talk2Fhem_realtrim($) +{ + my $string = shift; + $string =~ s/^[\s\t\n]*|[\s\t\n]*$//g; +# $string =~ s/^[\s\t\n]*|[\s\t\n]*$//g; + return $string; +} + +sub Talk2Fhem_normalize($) +{ + my $string = shift; + $string =~ s/\s{2,}|\b\w\b|\t|\n|['".,;:\!\?]/ /g; + return $string; +} + +sub Talk2Fhem_parseParams($) +{ + my ($def) = @_; + my $val = $def; + my $i=0; + my %hres; + my @res; + while ($val =~ /(.*?)[ \t]+=[ \t\n]+((.|\n)*?)(?=(\n.*?[ \t]+=[ \t\n]|$))/) { + my $pre = Talk2Fhem_realtrim($`); + if ($pre) { + return ("Syntaxerror: $pre") if ($pre !~ /^#/); + } + $val = $'; + next if (Talk2Fhem_realtrim($1) =~ /^#/); + my $key = $1; + my $val = $2; my $r; + $key = Talk2Fhem_realtrim($key); + foreach my $line (split("\n", $val)) { + $line =~ s/#.*//; + $line = Talk2Fhem_realtrim($line); + $r .= $line; + } + if ( wantarray ) { + push(@res, {key => $key, val => $r}); + } else { + $hres{$key} = $r; + } + + } + return ("Syntaxerror: $val") if (Talk2Fhem_realtrim($val)); + + return(@res) if ( wantarray ); + return(\%hres); + +} + +sub Talk2Fhem_parseArray($;$$) +{ + my ($val, $split, $keep) = @_; + $split = "," unless $split; + my @r = map {Talk2Fhem_realtrim($_)} quotewords($split, $keep, $val); + return(\@r); +} + +sub Talk2Fhem_loadList($$;$) +{ +my $hash = shift; +my $type = shift; +my $list = (shift || AttrVal($hash->{NAME}, $type, "")); + + $list = Talk2Fhem_parseParams($list); + #Log 1, Dumper $list; + return ("Error while parsing Keywordlist.\n$list" ) unless(ref($list) eq "HASH"); + foreach (keys %$list) { +# $$list{$_} = Talk2Fhem_parseArray($$list{$_}); + $hash->{helper}{$type}{$_} = Talk2Fhem_parseArray($$list{$_}); + } + +# my $modlist = Talk2Fhem_parseParams(AttrVal($name, "T2F_modwordlist", ""));; +# return ("Error while parsing Modwordlist.\n$modlist" ) unless(ref($modlist) eq "HASH"); +# foreach (keys %$modlist) { +## $$modlist{$_} = Talk2Fhem_parseArray($$modlist{$_}); +# $hash->{helper}{modlist}{$_} = Talk2Fhem_parseArray($$modlist{$_}); +# } +} + +sub Talk2Fhem_language($) +{ +my ($name) = @_; +my $lang = AttrVal($name, "T2F_language", AttrVal("global", "language", "DE")); +$lang=uc($lang); +$lang = "DE" unless $lang =~ /DE|EN/; +return($lang); +} + +sub Talk2Fhem_mkattime($$) { +my $myname = $_[0]; +my $i = $_[1]; +my @ltevt = localtime($i); +my $d=0; my $dev="at_".$myname."_".$i."_".$d; +while ($defs{$dev}) {$dev = "at_".$myname."_".$i."_".++$d} + +return("define at_".$myname."_".$i."_".$d." at " + .($ltevt[5]+1900) + ."-".sprintf("%02d", ($ltevt[4]+1)) + ."-".sprintf("%02d", $ltevt[3]) + ."T".sprintf("%02d", $ltevt[2]) + .":".sprintf("%02d", $ltevt[1]) + .":".sprintf("%02d", $ltevt[0])); +} + + +sub Talk2Fhem_exec($$$) { + +my %assires; +my %lastcmd; + +sub Talk2Fhem_get_time_by_phrase($$$$$%); +sub Talk2Fhem_addevt($$$$;$$); +sub Talk2Fhem_err($$$;$); +sub Talk2Fhem_filter($$); +sub Talk2Fhem_escapeumlauts($;$); +sub Talk2Fhem_test($$); + +my ($txt, $me, $myname) = @_; +$me->{helper}{LOG}=""; + +#my $kl = $me->{helper}{T2F_keywordlist}; +#my $ml = $me->{helper}{T2F_modwordlist}; + +(Talk2Fhem_err($myname, "No Text given!",\%assires,1) && return(%assires)) unless $txt; + +my $lang = Talk2Fhem_language($myname); + +my %Talk2Fhem = %{$Talk2Fhem_globals{$lang}}; + +T2FL($myname, 5, "Talk2Fhem Version: ".$Talk2Fhem_globals{version}); +T2FL($myname, 3, "Decoding Text: ".$txt); +my $t2ffilter = AttrVal($myname,"T2F_filter",0); +T2FL($me, 5, "Using User Filter: ".$t2ffilter) if $t2ffilter; + +my $lastevt; +my $lastif; +my $lastifmatch; + + +my $origin = AttrVal($myname, "T2F_origin", ""); +$txt =~ s/$origin//; +$origin = $&; +$txt = Talk2Fhem_normalize(Talk2Fhem_realtrim($txt)); +readingsSingleUpdate($me, "origin", $origin, 1); + +#Zeiten könnten auch ein und enthalten deswegen nicht wenn auf und eine Zahl folgt +my @cmds = split(/ und (?!$Talk2Fhem_globals{DE}{numberre})/, $txt); + + +foreach (@cmds) { + next unless $_; + my $cmd = $_; + my $specials; + $$specials{origin} = $origin; + + +T2FL($myname, 4, "Command part: '$cmd'"); + my $rawcmd = $cmd; + + +my $time = time; + ### wieder und dann/danach am Anfang legen die zeit auf das vorherige event +if ($lastevt and ($cmd =~ /\bwieder |^(dann|danach).*/i)) { + T2FL($myname, 5, "Word again found. Reusing timeevent. ".localtime($lastevt)); + $time = $lastevt; +} +my $evtime = Talk2Fhem_get_time_by_phrase($myname, $time, $time, \$cmd, \$specials, %{$Talk2Fhem{datephrase}}); +$evtime = Talk2Fhem_get_time_by_phrase($myname, $evtime, $time, \$cmd, \$specials, %{$Talk2Fhem{timephrase}}); + +#T2FL($myname, 4, "Extracted Timephrase. '$$specials{timephrase}'") if $$specials{timephrase}; +T2FL($myname, 4, "Extracted Timephrase. '$$specials{timephrase}'") if $$specials{timephrase}; +T2FL($myname, 5, "Commandpart after datedecoding. '$cmd'") if $cmd ne $rawcmd; + +unless($evtime) { + Talk2Fhem_err($myname, "Error while time calculating: $rawcmd",\%assires,1); + next; +} + +$cmd = Talk2Fhem_filter($myname, $cmd); + +if ($time < $evtime) { + T2FL($myname, 4, "Eventtime found: ".localtime($evtime)); + $lastevt=$evtime; +} elsif ($time-10 > $evtime) { + T2FL($myname, 3, "Time is in past: $time $evtime"); + $lastevt=0; +} elsif ($lastevt) {$lastevt++} + +foreach my $phr (@{$me->{helper}{if}}) { + my $sc = Talk2Fhem_addevt($myname, $phr, $lastevt, $cmd, \%assires, $specials); +} + +push(@{$$specials{ifs}} , @{$lastif}) if ($lastif); +$lastif = $$specials{ifs}; +$lastifmatch .= ($lastifmatch ? " und " : " ").$$specials{match}; +$$specials{ifmatch} = $lastifmatch; + +$cmd = Talk2Fhem_normalize(Talk2Fhem_realtrim($cmd)); + +# Maximal 2 Wörter vor dem wieder, ansonsten wird von einem neuen Kommando ausgegangen. +# dann wird nach der letzten Zahl, wort länger als 3 buchstaben oder wahr falsch wörter gesucht. +#if ($cmd =~ /^.?(\S+\s){0,2}wieder.* (\S+)$/i) { +if (%lastcmd and +( $cmd =~ /wieder\b.*($Talk2Fhem{pass}{float})/i || + $cmd =~ /wieder\b.*($Talk2Fhem{pass}{integer})/i || + $cmd =~ /wieder\b.*($Talk2Fhem{pass}{word})/i || + $cmd =~ /wieder\b.*($Talk2Fhem{pass}{true})/i || + $cmd =~ /wieder\b.*($Talk2Fhem{pass}{false})/i || + $cmd =~ /wieder\b.*($Talk2Fhem{numberre})/i)) { + $$specials{dir} = $1; + # hier erfolgt ein hitcheck, damit erkannt wird ob das kommando ohne wieder ein eigenständiger befehl ist. + # frage ist ob zusätzlich über specials eine rückgabe gegeben werden soll ob die konfig "wieder" fähig ist. z.b. überhaupt ein $n vorhanden ist. + # ist der 2 wörter check noch notwendig? + unless (Talk2Fhem_test($me, $cmd =~ s/\s?wieder\s/ /r)) { + #Vorhiges Kommando mit letztem wort als "direction" + # Log 1, Dumper Talk2Fhem_test($me, $_ =~ s/\s?wieder\s/ /r); + T2FL($myname, 4, "Word again with direction ($$specials{dir}) found. Using last command. ${$lastcmd{phr}}{key}"); + Talk2Fhem_addevt($myname, $lastcmd{phr}, $lastevt, $lastcmd{cmd}, \%assires, $specials); + next; + } else { + T2FL($myname, 3, "Again word ignored because Command matches own Phrase!"); + $$specials{dir} = undef; + } +} +#wieder wird nicht mehr benötigt +$cmd =~ s/\bwieder\b|^(dann|danach) / /g; +$cmd = Talk2Fhem_filter($myname, $cmd); + +T2FL($myname, 4, "Command left: '$cmd'") if $rawcmd ne $cmd; + + my $sc; + + #foreach my $phr (keys(%{$Talk2Fhem_phrase{$myname}})) { + foreach my $phr (@{$me->{helper}{phrase}}) { + #Teste Phrasenregex + $lastcmd{phr} = $phr; + $lastcmd{cmd} = $cmd; + $sc = Talk2Fhem_addevt($myname, $phr, $lastevt, $cmd, \%assires, $specials); + # undef nicht gefunden, 0 fehler beim umwandeln, 1 erfolgreich + last if defined($sc); + } + + unless ($sc) { + unless(defined($sc)) { + # undef + Talk2Fhem_err($myname, "No match: '$rawcmd'",\%assires,1); + } else { + # 0 + Talk2Fhem_err($myname, "Error on Command: '$rawcmd'",\%assires,1) unless $assires{err}; + last; + } + } +# eventuell ganz abbrechen bei fehler, jetzt wird noch das nächste und ausgewertet +next; + +} +return(%assires); + +sub Talk2Fhem_filter($$) { + my ($name, $cmd) = @_; + my $filter = AttrVal($name,"T2F_filter",$Talk2Fhem_globals{Talk2Fhem_language($name)}{erase}); +unless (ref($filter) eq "ARRAY") { + $filter = Talk2Fhem_parseArray($filter); +}; + + for (@$filter) { + $cmd =~ s/$_/ /gi; + } + $cmd =~ s/\s{2,}/ /g; + return(Talk2Fhem_realtrim($cmd)); +} + +sub Talk2Fhem_get_time_by_phrase($$$$$%) { +my ($myname, $evt, $now, $cmd, $spec, %tp) = @_; +#T2FL($myname, 5, "get_time_by_phrase. Using eventtime: ".localtime($evt)." now: ".localtime($now)." command: ".$$cmd); +return(0) unless ($evt); +my @lt = localtime($evt); +my @now = localtime($now); +my $disu = AttrVal($myname, "T2F_disableumlautescaping", 0); + + foreach my $key (keys(%tp)) { + my $esckey = Talk2Fhem_escapeumlauts($key, $disu); + my @opt = ($$cmd =~ /\b$esckey\b/i); + while ($$cmd =~ s/\b$esckey\b/ /i) { + $$$spec{timephrase} .= $&." "; + my %tf = %{$tp{$key}}; + T2FL($myname, 4, "Timephrase found: =~ s/\\b$key\\b/"); + foreach my $datemod (keys(%tf)) { + # Suche Ersetzungsvariablen + my $dmstore = $tf{$datemod}; + while ($tf{$datemod} =~ /\$(\d+)/) { + my $d=$1; + my $v = $opt[($d-1)]; + if ($v !~ /^\d+$/) { + #Log 1, "KEINE Zahl ".$v; + foreach ( keys %{$Talk2Fhem_globals{DE}{numbers}} ) { + my $tmp = Talk2Fhem_escapeumlauts($_, $disu); + last if ($v =~ s/$tmp/$Talk2Fhem_globals{DE}{numbers}{$_}/i); + } + } + $tf{$datemod} =~ s/\$\d+/$v/; + } + $tf{$datemod} = eval($tf{$datemod}); + T2FL($myname, 5, "TIMEPHRASEDATA mod: '$datemod' raw: '$dmstore' result: '$tf{$datemod}' opt: '@opt'"); + if ($datemod eq "days") { + $evt = POSIX::mktime(0,0,12,($lt[3]+$tf{days}),$lt[4],$lt[5]) || 0; + } elsif ($datemod eq "wday") { + $evt = POSIX::mktime(0,0,12,($lt[3]-$lt[6]+$tf{wday}+(( $tf{wday} <= $lt[6] )?7:0)),$lt[4],$lt[5]) || 0; + } elsif ($datemod eq "year") { + $evt = POSIX::mktime(0,0,12,$lt[3],$lt[4],($lt[5]+$tf{year})) || 0; + } elsif ($datemod eq "month") { + $evt = POSIX::mktime(0,0,12,$lt[3],($lt[4]+$tf{month}),$lt[5]) || 0; + } elsif ($datemod eq "sec") { + $evt = POSIX::mktime(($now[0]+$tf{sec}),$now[1],$now[2],$lt[3],$lt[4],$lt[5]) || 0; + } elsif ($datemod eq "min") { + $evt = POSIX::mktime($now[0],($now[1]+$tf{min}),$now[2],$lt[3],$lt[4],$lt[5]) || 0; + } elsif ($datemod eq "hour") { + $evt = POSIX::mktime($now[0],$now[1],($now[2]+$tf{hour}),$lt[3],$lt[4],$lt[5]) || 0; + } elsif ($datemod eq "time") { + my @t = split(":", $tf{time}); + $evt = POSIX::mktime($t[2] || 0,$t[1] || 0,$t[0],$lt[3],$lt[4],$lt[5]) || 0; + } elsif ($datemod eq "date") { + my @t = split(/\.|\s/, $tf{date}); + if ($t[1]) {$t[1]--} else {$t[1] = $now[4]+1} + if ($t[2]) {if (length($t[2]) eq 2) { $t[2] = "20".$t[2] }; $t[2]=$t[2]-1900} else {$t[2] = $now[5]} + $evt = POSIX::mktime(0,0,12,$t[0], $t[1], $t[2]) || 0; + } elsif ($datemod eq "unix") { + $evt = localtime($tf{unix}); + } + @now = localtime($evt); + } + @lt = localtime($evt); + } + } +return($evt); +} + +sub Talk2Fhem_test($$) { +my ($hash, $cmd) = @_; + foreach my $phr (@{$hash->{helper}{phrase}}) { + my $r = Talk2Fhem_addevt($hash->{NAME}, $phr, undef, $cmd); + return $r if $r; + } +} + +sub Talk2Fhem_addevt($$$$;$$) { +#print Dumper @_; +my ($myname, $phr, $lastevt, $cmd, $res, $spec) = @_; +my $success; +my $rawcmd = $cmd; +my $cmdref = \$_[3]; +my $disu =AttrVal($myname, "T2F_disableumlautescaping", 0); + +my %keylist = %{$defs{$myname}{helper}{T2F_keywordlist}} if $defs{$myname}{helper}{T2F_keywordlist}; +my %modlist = %{$defs{$myname}{helper}{T2F_modwordlist}} if $defs{$myname}{helper}{T2F_modwordlist}; +#T2FL($me, 5, "Using lists:\n".Dumper(%keylist, %modlist)); + +# my @phrs = map { Talk2Fhem_realtrim($_) } split(/[\t\s]*\&\&[\t\s]*/, $$phr{key}); + +my @hitnokeylist = @{$$phr{hitnokeylist}}; +my @fphrs = @{$$phr{regexps}}; + +my $pmatch; +my $punmatch = $cmd; + +my @dir = ($$spec{origin}); +T2FL($myname, 5, "$myname Evaluate search:\n$cmd =~ /$$phr{key}/i") if ref $res; +for my $fphr (@fphrs) { +# if (my @d = ($cmd =~ qr/$fphr/i)){ + if ($fphr =~ s/^\?//){ + my @d = ($cmd =~ /$fphr/i); + my $m = $&; + #Log 1, "A: ".$fphr; + #Log 1, "A: ".Dumper $m; + #Log 1, "B: ".Dumper @d; + my $b = () = $fphr =~ m/(? $a } ($raw =~ /\$(\d+)/g))[0] unless ($mainbracket); + my $do = $raw; + my $dirbracket = $react{offset}; + T2FL($myname, 5, "Handle reaction $type: $raw"); + if ($raw) { + # Suche Ersetzungsvariablen + + $do =~ s/\!\$\&/$punmatch/g; + $do =~ s/\$\&/$pmatch/g; + $do =~ s/\$DATE/$$spec{timephrase}/g; + my $tagain = ($$spec{dir} ? "wieder" : ""); + $do =~ s/\$AGAIN/$tagain/g; + $do =~ s/\$TIME/$lastevt/g; + $do =~ s/\$NAME/$myname/g; +# $do =~ s/\$ORIGIN/$$spec{origin}/g; + $do =~ s/\$IF/$$spec{ifmatch}/g; + + while ($do =~ /\$(\d+)\@/) { + my $no = $1; + my @keywords; + # wenn kein @array in klammer clipno + unless ($hitnokeylist[$no]) { + T2FL($myname, 5, "Clipnumber $no is no array! Try to extract by seperator '|'"); + my @cs = map { my @t = split('\|', $_ =~ s/^\(|\)$//gr); \@t } $$phr{key} =~ /(? $do") if $raw ne $do; + + + while ($do =~ s/(.*)\$(\d+)(\[|\{|\()(.*?)(\]|\}|\))/$1###/) { + #Klammer aus Value in Hash überführen + my $clipno = $2; + my $uhash = $4; + my $utype = $3; + T2FL($myname, 4, "Advanced bracket replacement. \$$clipno$uhash = $do"); + if ($uhash =~ /@(\w+)/) { + if ($modlist{$1}) { + $uhash = $`.'"'.Talk2Fhem_escapeumlauts(join('","', @{$modlist{$1}}), $disu).'"'.$' ; + #ersetze ,, durch "","", + # zwei mal weil immer eins zu weit geschoben wird + #### ist noch notwendig??? + $uhash =~ s/([\[,])([,\]])/$1""$2/g; + $uhash =~ s/([\[,])([,\]])/$1""$2/g; + T2FL($myname, 5, "Adding modlist: ".$uhash); + } else { + Talk2Fhem_err($myname, T2FL($myname, 1, "Unbekannte modwordlist in '$$phr{key}' \@$1"),$res,1); + return(0); + } + } + + my $hash; + if ($utype eq "[") { + $hash = Talk2Fhem_parseArray($uhash) + } elsif ($utype eq "{") { + #$hash = eval($uhash) + my $harr = Talk2Fhem_parseArray($uhash); + for (@$harr) { + my $h = Talk2Fhem_parseArray($_, "=>"); + $$hash{$$h[0]} = $$h[1]; + } + } elsif ($utype eq "(") { + ##### klappt nicht weil in while regex nicht bis zur schließenden klammer getriggert wird wenn vorher ein } oder ] kommt + #$hash = eval($uhash); + T2FL($myname, 1, '$n() has no function at this moment. Possible worng Syntax: '.$$phr{key}); + next; + + } else { + #sollte eigentlich nie eintreffen weil auf die zeichen explizit gesucht wird + T2FL($myname, 1, "Unkown modwordtype ($utype) in '$$phr{key}'"); + next; + } + #aktuelles Wort im Key auswählen + if (($clipno-1) > $#dir) { + T2FL($myname, 1, "Not enough clips in phrase '$$phr{key} =~ $raw'"); + next; + } + my $d = ($$spec{dir} and ($clipno) == $mainbracket) ? $$spec{dir} : $dir[$clipno]; + + T2FL($myname, 4, "Keyword (".($clipno)."): '".Dumper($d)."'"); + + # Wort übersetzen + if (ref($hash) eq "HASH") { + T2FL($myname, 5, "HASH evaluation:\n".Dumper($hash)); + #my $passed=0; + foreach my $h (keys(%$hash)) { + #sollte eigentlich in den syntaxcheck + unless (defined $$hash{$h}) { + T2FL($myname, 1, "Empty replacementstring! $h"); + #return(0); + next; + }; + next if ($h eq "else"); + unless ($h =~ /^\/.*\/$/ or defined ${$Talk2Fhem{pass}}{$h}) { + T2FL($myname, 1, "Replacementtype unkown! $h"); + #return(0); + next; + }; + + #$passed=1; + next if ($h eq "empty"); + next unless $d; + + my $re; + my $fc; + if ($h =~ /^\/(.*)\/$/) { + $re = $1; + } else { + $re = ${$Talk2Fhem{pass}}{$h}; + if (ref($re) eq "HASH") { + $fc=$$re{fc}; + $re=$$re{re}; + } + } + + $re = Talk2Fhem_escapeumlauts($re, $disu); + + if ($d =~ qr/$re/i) { + my $rp = $$hash{$h}; + if (ref $fc eq "CODE") { + T2FL($myname,5,"Functionmod '$fc' $rp"); + my @res = $d =~ qr/$re/i; + $rp = &$fc(@res); + } elsif ($fc) { + T2FL($myname,5,"Functionmod '$$fc' $rp"); + my $ev = eval($fc); + $rp =~ s/$re/$ev/gi; + } + T2FL($myname, 5, "Word found ($h): '$d' replace with '$rp'"); + $do =~ s/###/$rp/; + last; + } + } + # empty != undef +# if (defined($d) and $d =~ qr/${$Talk2Fhem{pass}}{empty}/ and ($$hash{empty} or (! $$hash{empty} and $$hash{else}))) { + # empty undef + if (! defined($d) or $d =~ qr/${$Talk2Fhem{pass}}{empty}/) { + #$d existiert nicht + my $e = ($$hash{empty} || $$hash{else}); + T2FL($myname, 5, "Empty word replace with '$e'"); + $do =~ s/###/$e/; + } + + + ######### + if ($do =~ /###/) { + #Vergleich fehlgeschlagen + if ($$hash{else}) { + T2FL($myname, 5, "Unkown word '$d' replace with '$$hash{else}'"); + $do =~ s/###/$$hash{else}/; + } else { + T2FL($myname, 1, "HASH Replacement Failed! $do"); + #%$res = undef; + #return(); + } + } + } + + if (ref($hash) eq "ARRAY") { + my $else=""; + my $empty=""; + # keywords else und empty löschen und nächsten wert als parameter nehmen + @$hash = grep { + if ("$_" eq "else") { $else = " "; 0 } + else { if ($else eq " ") { $else = $_; 0 } + else { 1 } } } @$hash; + @$hash = grep { + if ("$_" eq "empty") { $empty = " "; 0 } + else { if ($empty eq " ") { $empty = $_; 0 } + else { 1 } } } @$hash; + + T2FL($myname, 5, "ARRAY evaluation: else: $else empty: $empty\narray: @$hash"); +# if (($d =~ qr/${$Talk2Fhem{pass}}{empty}/) and defined($d)) { + if (($d =~ qr/${$Talk2Fhem{pass}}{empty}/) or ! defined($d)) { + T2FL($myname, 5, "Empty word replace with! $empty"); + $do =~ s/###/$empty/; + } elsif (IsInt($d)) { + unless ($$hash[$d]) { + my $err = T2FL($myname, 3, "Field #$d doesn't exist in Array!"); + if ($else eq "") { + Talk2Fhem_err($myname, $err, $res,1); + return(0); + } + + } else { + T2FL($myname, 5, "Integer ($d) used for array selection! $$hash[$d]"); + $do =~ s/###/$$hash[$d]/ if $$hash[$d]; + } + } elsif ($d) { + my @keywords; + # wenn kein @array in klammer clipno + unless (defined($hitnokeylist[$clipno])) { + T2FL($myname, 5, "Clipnumber $clipno is no array! Try to extract by seperator '|'"); + my @cs = map { my @t = split('\|', $_ =~ s/^\(|\)$//gr); \@t } $$phr{key} =~ /(?{NAME}}) { + $h->{helper}{LOG} .= $_[2]."\n"; + } +return($_[2]); +} + +1; + + +# Beginn der Commandref + +=pod +=item helper +=item summary A RegExp based language control module +=item summary_DE Ein auf RegExp basierendes Sprachsteuerung Modul + +=begin html + + +

Talk2Fhem

+ + + +=end html +=begin html_DE + + +

Talk2Fhem

+ + + +=end html_DE +=cut diff --git a/fhem/MAINTAINER.txt b/fhem/MAINTAINER.txt index 69cbecdec..bc3de329c 100644 --- a/fhem/MAINTAINER.txt +++ b/fhem/MAINTAINER.txt @@ -204,6 +204,7 @@ FHEM/38_netatmo.pm markus-m http://forum.fhem.de/index.php FHEM/38_CO20.pm markus-m Sonstiges FHEM/38_JawboneUp.pm domschl Sonstiges FHEM/39_alexa.pm justme1968 Frontends/Sprachsteuerung +FHEM/39_Talk2Fhem.pm Phill Frontends/Sprachsteuerung FHEM/39_siri.pm justme1968 Frontends/Sprachsteuerung FHEM/40_RFXCOM.pm wherzig RFXTRX FHEM/41_OREGON.pm Sidey/Ralf9 Sonstiges