diff --git a/fhem/FHEM/39_Talk2Fhem.pm b/fhem/FHEM/39_Talk2Fhem.pm index b712987bf..c90d26b72 100644 --- a/fhem/FHEM/39_Talk2Fhem.pm +++ b/fhem/FHEM/39_Talk2Fhem.pm @@ -89,14 +89,26 @@ # 21.02.2018 0.4.4 # bracket extraction bug fixed # def not load at bootup fixed +# 03.03.2018 0.4.5 +# timephrase modified +# recognize order in hash replacement +# Commandref fix unwanted characters +# possibility of nested brackets in modifiacator +# stabitility fixes in user regexp +# replace ; to ;; in timecommands +# Add 1 day if timecode is in past in hour phrases +# Added async warning if keywordlist is unkown ################################################################ # TODO: # # device verundung durch regexp klammern? eher durch try and error -# get compare lists # answerx +# # klammern in keywordlists sollen die $n nummerierung nicht beeinflussen -# +# in keywordlists sind vermutlich nur maximal eine klammerebene möglich direkte regex arrays sind endlos verschachtelbar +# zusätzlich unmodifizierte zeit greifbar machen +# timephrase kombies morgen früh um 9 uhr ist unzuverlässig. evtl order einführen, dann kann auch die splittung weg +# viertel zeitphrasen package main; @@ -111,7 +123,7 @@ use Encode qw(decode encode); my %Talk2Fhem_globals; -$Talk2Fhem_globals{version}="0.4.4"; +$Talk2Fhem_globals{version}="0.4.5"; $Talk2Fhem_globals{EN}{erase} = ['\bplease\b', '\balso\b', '^msgtext:']; $Talk2Fhem_globals{EN}{numbers} = { @@ -225,7 +237,7 @@ $Talk2Fhem_globals{DE}{pass} = { empty => '^\s*$' }; $Talk2Fhem_globals{DE}{datephrase} = { - '(? {days=>1} + 'morgen'=> {days=>1} , 'übermorgen'=> {days=>2} , 'gestern'=> {days=>-1} , 'vorgestern'=> {days=>-2} @@ -245,6 +257,7 @@ $Talk2Fhem_globals{DE}{datephrase} = { , 'in ('.$Talk2Fhem_globals{DE}{numberre}.') tag(\S\S)?'=> {days=>'"$1"'} , 'am (\d\S*(\s\d+)?)'=> {date=>'"$1"'} }; +# fc modify time. $_[0] = ermittelte zeit. Zugriff auf $1 $2 usw $Talk2Fhem_globals{DE}{timephrase} = { '(in|und|nach)? ('.$Talk2Fhem_globals{DE}{numberre}.') stunde.?' => {hour=>'"$2"'} , '(in|und|nach)? ('.$Talk2Fhem_globals{DE}{numberre}.') minute.?' => {min=>'"$2"'} @@ -254,10 +267,17 @@ $Talk2Fhem_globals{DE}{timephrase} = { , '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 +, 'um (\d+\s?\:\s?\d+|'.$Talk2Fhem_globals{DE}{numberre}.') (uhr)?' => { + time=>'"$1"', + fc=>sub () {(($_[0] + 3600) < time) ? ($_[0]+3600*24) : $_[0] } + } +, 'um ('.$Talk2Fhem_globals{DE}{numberre}.') uhr ('.$Talk2Fhem_globals{DE}{numberre}.')' => { + hour=>'"$1"', + min=>'"$1"', + fc=>sub () {(($_[0] + 3600) < time) ? ($_[0]+3600*24) : $_[0] } + } ############ ZU TESTEN , 'früh' => {time=>'"09:00"'} -, '(? {time=>'"18:00"'} +, 'abends?' => {time=>'"18:00"'} , 'nachmittags?' => {time=>'"16:00"'} , 'vormittags?' => {time=>'"10:30"'} , 'mittags?' => {time=>'"12:00"'} @@ -314,7 +334,7 @@ sub Talk2Fhem_Define($$) $hash->{STATE} = "Loading"; if ($def =~ /^\S+ Talk2Fhem$/) { - $hash->{DEF} = ""; + $hash->{DEF} = "# = \n# Examples:\n# timer (löschen|zurück)\t= set \$NAME cleartimers\n# ereignis\\S* (löschen|zurück)\t= set \$NAME cleartriggers"; return; } @@ -432,7 +452,9 @@ sub Talk2Fhem_Loadphrase($$$) { if ($1) { $keylistname = $2; unless ($keylist{$keylistname}) { - return(T2FL($hash, 1, "Unkown keywordlist $1. In phrase: $phr")); + asyncOutput($hash->{CL}, "Warning: Unkown keywordlist $1. In phrase: $phr"); + next; + #return(T2FL($hash, 1, "Unkown keywordlist $1. In phrase: $phr")); } my $re = join("|", @{$keylist{$keylistname}}); $phr =~ s/@(\w+)/$re/; @@ -568,7 +590,7 @@ sub Talk2Fhem_Set($@) #Ausführen if ($res{cmds}) { for my $h (@{$res{cmds}}) { - my $fhemcmd = ($$h{at}?Talk2Fhem_mkattime($name, $$h{at})." ":"").$$h{cmd}; + my $fhemcmd = ($$h{at}?Talk2Fhem_mkattime($name, $$h{at})." ":"").($$h{cmd} =~ s/;/;;/gr ); unless ($$h{ifs}) { # kein IF @@ -814,7 +836,7 @@ sub Talk2Fhem_normalize($) my $string = shift; #mach probleme bei "ue" # $string =~ s/\s{2,}|\b\w\b|\t|\n|['".,;:\!\?]/ /g; - $string =~ s/\s{2,}|\t|\n|['".,;:\!\?]/ /g; + $string =~ s/\s{2,}|\t|\n|['".,;\!\?]/ /g; return $string; } @@ -949,8 +971,20 @@ $txt =~ s/$origin//; $origin = $&; $txt = Talk2Fhem_normalize(Talk2Fhem_realtrim($txt)); readingsSingleUpdate($me, "origin", $origin, 1); + +#:START #Zeiten könnten auch ein und enthalten deswegen nicht wenn auf und eine Zahl folgt my @cmds = split(/ und (?!$Talk2Fhem_globals{DE}{numberre})/, $txt); +# CHECK if $cmd[0] hit Talk2Fhem_test. Unless dont split. And make a deeper analysis. +#if ($#cmd) +# before test remove time and if phrases simple +# unless (Talk2Fhem_test($me, $cmds[0])) { +# Nun schauen wir mal was vor und nach dem und ist. +# könnte phrasentreffer auf kompletten satz ausschluss geben +# +# } +#} + foreach (@cmds) { @@ -1030,7 +1064,7 @@ if (%lastcmd and } #wieder wird nicht mehr benötigt $cmd =~ s/\bwieder\b|^(dann|danach) / /g; -$cmd = Talk2Fhem_filter($myname, $cmd); +$cmd = Talk2Fhem_normalize(Talk2Fhem_realtrim(Talk2Fhem_filter($myname, $cmd))); T2FL($myname, 4, "Command left: '$cmd'") if $rawcmd ne $cmd; @@ -1092,6 +1126,7 @@ my $disu = AttrVal($myname, "T2F_disableumlautescaping", 0); my %tf = %{$tp{$key}}; T2FL($myname, 4, "Timephrase found: =~ s/\\b$key\\b/"); foreach my $datemod (keys(%tf)) { + next if $datemod eq "fc"; # Suche Ersetzungsvariablen my $dmstore = $tf{$datemod}; while ($tf{$datemod} =~ /\$(\d+)/) { @@ -1123,7 +1158,7 @@ my $disu = AttrVal($myname, "T2F_disableumlautescaping", 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}); + my @t = map { s/\s//gr } 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}); @@ -1137,6 +1172,14 @@ my $disu = AttrVal($myname, "T2F_disableumlautescaping", 0); } @lt = localtime($evt); } + + if ($tp{$key}{fc}) { + if (ref $tp{$key}{fc} eq "CODE") { + my $lock = $evt; + $evt = &{$tp{$key}{fc}}($evt); + T2FL($myname, 4, "Time modified by function. ".$evt) if $lock != $evt; + } + } } return($evt); } @@ -1174,7 +1217,7 @@ 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 @d = (eval { $cmd =~ /$fphr/i}); my $m = $&; #Log 1, "A: ".$fphr; #Log 1, "A: ".Dumper $m; @@ -1195,8 +1238,8 @@ for my $fphr (@fphrs) { $punmatch =~ s/$m//gi; #$cmd =~ s/$m//gi; } elsif ($fphr =~ /^\!/) { - return if ($cmd =~ /$'/i); - } elsif (my @d = ($cmd =~ /$fphr/i)){ + return if (eval { $cmd =~ /$'/i }); + } elsif (my @d = (eval { $cmd =~ /$fphr/i } )){ my $m = $&; $pmatch .= $m; $punmatch =~ s/$m//gi; @@ -1293,11 +1336,25 @@ my %react; T2FL($myname, 4, "Replaced bracket: $raw -> $do") if $raw ne $do; - while ($do =~ s/(.*)\$(\d+)(\[|\{|\()(.*?)(\]|\}|\))/$1###/) { - #Klammer aus Value in Hash überführen +# while ($do =~ s/(.*)\$(\d+)(\[|\{|\()(.*?)(?3)/$1###/) { +# while ($do =~ s/(.*)\$(\d+)(\[|\{|\()(.*?)(\]|\}|\))/$1###/) { + while ($do =~ /(.*)\$(\d+)(?=\[|\{|\()/) { + my $pre = $1; my $clipno = $2; - my $uhash = $4; - my $utype = $3; + my $post = $'; + + my ($found, $rest) = extract_bracketed( $post, '{}[]()' ); + unless ($found) { + Talk2Fhem_err($myname, T2FL($myname, 1, "'$raw': Fehler in Kommandoteilmodifikator Nr. '\$$clipno' nach: '$pre'"),$res,1); + return(0); + } + #Klammer aus Value in Hash überführen + $do = $pre."###".$rest; + $found =~ /(.)(.*)./; + my $utype = $1; + my $uhash = $2; + + T2FL($myname, 4, "Advanced bracket replacement. \$$clipno$uhash = $do"); if ($uhash =~ /@(\w+)/) { if ($modlist{$1}) { @@ -1319,10 +1376,11 @@ my %react; $hash = Talk2Fhem_parseArray($uhash) } elsif ($utype eq "{") { #$hash = eval($uhash) - my $harr = Talk2Fhem_parseArray($uhash); + my $harr = Talk2Fhem_parseArray($uhash); my $i=0; for (@$harr) { my $h = Talk2Fhem_parseArray($_, "=>"); - $$hash{$$h[0]} = $$h[1]; + $$hash{$$h[0]} = {val=>$$h[1],order=>$i++}; + } } elsif ($utype eq "(") { ##### klappt nicht weil in while regex nicht bis zur schließenden klammer getriggert wird wenn vorher ein } oder ] kommt @@ -1348,9 +1406,9 @@ my %react; if (ref($hash) eq "HASH") { T2FL($myname, 5, "HASH evaluation:\n".Dumper($hash)); #my $passed=0; - foreach my $h (keys(%$hash)) { + foreach my $h (sort {$$hash{$a}{order} <=> $$hash{$b}{order} } keys(%$hash)) { #sollte eigentlich in den syntaxcheck - unless (defined $$hash{$h}) { + unless (defined $$hash{$h}{val}) { T2FL($myname, 1, "Empty replacementstring! $h"); #return(0); next; @@ -1381,7 +1439,7 @@ my %react; $re = Talk2Fhem_escapeumlauts($re, $disu); if ($d =~ qr/$re/i) { - my $rp = $$hash{$h}; + my $rp = $$hash{$h}{val}; if (ref $fc eq "CODE") { T2FL($myname,5,"Functionmod '$fc' $rp"); my @res = $d =~ qr/$re/i; @@ -1397,11 +1455,11 @@ my %react; } } # empty != undef -# if (defined($d) and $d =~ qr/${$Talk2Fhem{pass}}{empty}/ and ($$hash{empty} or (! $$hash{empty} and $$hash{else}))) { +# if (defined($d) and $d =~ qr/${$Talk2Fhem{pass}}{empty}/ and ($$hash{empty}{val} or (! $$hash{empty}{val} and $$hash{else}{val}))) { # empty undef if (! defined($d) or $d =~ qr/${$Talk2Fhem{pass}}{empty}/) { #$d existiert nicht - my $e = ($$hash{empty} || $$hash{else}); + my $e = ($$hash{empty}{val} || $$hash{else}{val}); T2FL($myname, 5, "Empty word replace with '$e'"); $do =~ s/###/$e/; } @@ -1410,9 +1468,9 @@ my %react; ######### if ($do =~ /###/) { #Vergleich fehlgeschlagen - if ($$hash{else}) { - T2FL($myname, 5, "Unkown word '$d' replace with '$$hash{else}'"); - $do =~ s/###/$$hash{else}/; + if ($$hash{else}{val}) { + T2FL($myname, 5, "Unkown word '$d' replace with '$$hash{else}{val}'"); + $do =~ s/###/$$hash{else}{val}/; } else { T2FL($myname, 1, "HASH Replacement Failed! $do"); #%$res = undef; @@ -1458,15 +1516,33 @@ my %react; T2FL($myname, 5, "Clipnumber $clipno is no array! Try to extract by seperator '|'"); # my @cs = map { my @t = split('\|', $_ =~ s/^\(|\)$//gr); \@t } $$phr{key} =~ /(? 10; + } + + # @keywords = @{$cs[($clipno-1)]}; - #Log 1, Dumper @cs; - @cs = grep { /^\(/ } @cs; - #Log 1, Dumper @cs; -# Log 1, "-----> ".$$phr{key}; - @keywords = split('\|', $cs[($clipno-1)] =~ s/^\(|\)$//gr); -# Log 1, Dumper @keywords; +# Log 1, Dumper @cs; +# @cs = grep { /^\(/ } @cs; +# Log 1, Dumper @cs; +# Log 1, "-----> ".$cs[($clipno-1)]; + (my $clip = $cs[($clipno)]) =~ s/^\(|\)$//g; +# push(@keywords, split('\|', $clip) extract_bracketed($clip, '()')); + @keywords = map { /^\(/ ? $_ : split('\|', $_=~s/^\||\|$//gr) } extract_multiple($clip, [sub { extract_bracketed($_[0], '()') }]); +# @keywords = split('\|',); + + #Log 1, Dumper @keywords; #wenn keine Liste in Klammer ist if ($#keywords == -1) { Talk2Fhem_err($myname, T2FL($myname, 1, "Clipnumber $clipno includes no array or integer in '$$phr{key}!"),$res,1); @@ -1475,12 +1551,13 @@ my %react; } else { @keywords = @{$keylist{$hitnokeylist[$clipno]}}; } + T2FL($myname, 4, "Searching position of $d in @keywords"); @keywords = map { Talk2Fhem_escapeumlauts($_, $disu) } @keywords; T2FL($myname, 4, "Searching position of $d in @keywords"); my $i=0; foreach (@keywords) { # if ($d =~ /^\Q$_\E$/i) { - if ($d =~ /^$_$/i) { + if (eval{$d =~ /^$_$/i}) { unless (defined($$hash[$i])) { my $err = T2FL($myname, 1, "Not enough elements in modwordlist! Position $i in (@$hash) doesn't exist."); if ($else eq "") { @@ -1628,6 +1705,10 @@ return($_[2]); The command part begins after the equals sign with a space, tab, or newline.

<regexp> = <command>

+ Short refernce: +
+ <RegExpPart> [&& [?!]<RegExpPart_n>] = [ <FHEM command> | { <Perl code> } | (<option> => '<wert>' , ... ) ] +

Example: helo world = {Log 1, Helo World}

Everything after a hashtag '#' is ignored until the end of the line. @@ -1673,7 +1754,7 @@ return($_[2]);
  • $n[<list>]
    Comma separated list: [value1,value2,...,[else,value], [empty,value]] or [@modwordlist]
    If $n is a number, the word at that position in <list> is selected.

    - If $n is a text, it searches for a list in its parenthesis in the part. (a|b|c) or (@keywordlist) + If $n is a text, it searches for a list in its parenthesis in the <regexp> part. (a|b|c) or (@keywordlist) In this list, $n is searched for and successively positioned in <list> chosen for $n.
    Example: light .* (kitchen|corridor|bad) (\S*) on = set $1[dev_a,dev_b,dev_c] $2{true => on,false => off}
    • @@ -1683,8 +1764,8 @@ return($_[2]); Environment variables:: @@ -1905,8 +1990,8 @@ return($_[2]); @@ -1916,21 +2001,21 @@ return($_[2]); Get
    get <name> <option>

    - Über get lassen sich Informationen aus dem Modul auslesen. - Siehe commandref#get für weitere Informationen zu "get". + Über get lassen sich Informationen aus dem Modul auslesen. + Siehe commandref#get für weitere Informationen zu "get".

    <option> @@ -1941,34 +2026,34 @@ return($_[2]); Readings @@ -1979,37 +2064,37 @@ return($_[2]);