diff --git a/fhem/FHEM/98_HTTPMOD.pm b/fhem/FHEM/98_HTTPMOD.pm index 3ab82b858..2878caccd 100755 --- a/fhem/FHEM/98_HTTPMOD.pm +++ b/fhem/FHEM/98_HTTPMOD.pm @@ -21,7 +21,6 @@ # First version: 25.12.2013 # # Todo: -# set..IExpr etc. von AttrVal auf GetFAttr umstellen, damit auch generische Attribute ohne Num funktionieren # setXYHintExpression zum dynamischen Ändern / Erweitern der Hints # extractAllReadings mit Filter / Prefix # definierbarer prefix oder Suffix für Readingsnamen wenn sie von unterschiedlichen gets über readingXY erzeugt werden @@ -30,7 +29,7 @@ # In _Attr bei Prüfungen auf get auch set berücksichtigen wo nötig, ebenso in der Attr Liste (oft fehlt set) # featureAttrs aus hash verarbeiten # -# Implement IMap und IExpr for get +# Implement IMap und IExpr for get (input values to be passed for get requests) # # replacement scope attribute? # make extracting the sid after a get / update an attribute / option? @@ -144,9 +143,10 @@ BEGIN { my $Module_Version = '4.1.10 - 6.7.2021'; my $AttrList = join (' ', - '(reading|get|set)[0-9]+(-[0-9]+)?Name', - '(reading|get|set)[0-9]*(-[0-9]+)?Expr:textField-long', - '(reading|get|set)[0-9]*(-[0-9]+)?Map', + 'reading[0-9]+(-[0-9]+)?Name', + '(get|set)[0-9]+(-[0-9]+)?Name', + '(reading|get|set)[0-9]*(-[0-9]+)?Expr:textField-long', # old + '(reading|get|set)[0-9]*(-[0-9]+)?Map', # old '(reading|get|set)[0-9]*(-[0-9]+)?OExpr:textField-long', '(reading|get|set)[0-9]*(-[0-9]+)?OMap:textField-long', '(get|set)[0-9]*(-[0-9]+)?IExpr:textField-long', @@ -190,16 +190,16 @@ my $AttrList = join (' ', 'parseFunction1', 'parseFunction2', 'set[0-9]+Local', # don't create a request and just set a reading - '[gs]et[0-9]*URL', - '[gs]et[0-9]*Data.*:textField-long', - '[gs]et[0-9]*NoData.*', # make sure it is an HTTP GET without data - even if a more generic data is defined - '[gs]et[0-9]*Header.*:textField-long', - '[gs]et[0-9]*CheckAllReadings:0,1', - '[gs]et[0-9]*ExtractAllJSON:0,1,2', + '(get|set)[0-9]*URL', + '(get|set)[0-9]*Data.*:textField-long', + '(get|set)[0-9]*NoData.*', # make sure it is an HTTP GET without data - even if a more generic data is defined + '(get|set)[0-9]*Header.*:textField-long', + '(get|set)[0-9]*CheckAllReadings:0,1', + '(get|set)[0-9]*ExtractAllJSON:0,1,2', - '[gs]et[0-9]*URLExpr:textField-long', # old - '[gs]et[0-9]*DatExpr:textField-long', # old - '[gs]et[0-9]*HdrExpr:textField-long', # old + '(get|set)[0-9]*URLExpr:textField-long', # old + '(get|set)[0-9]*DatExpr:textField-long', # old + '(get|set)[0-9]*HdrExpr:textField-long', # old 'get[0-9]*Poll:0,1', 'get[0-9]*PollDelay', @@ -208,10 +208,10 @@ my $AttrList = join (' ', 'set[0-9]+Max', 'set[0-9]+Hint', # Direkte Fhem-spezifische Syntax für's GUI, z.B. '6,10,14' bzw. slider etc. 'set[0-9]*NoArg:0,1', # don't expect a value - for set on / off and similar. (default for get) - '[gs]et[0-9]*TextArg:0,1', # just pass on a raw text value without validation / further conversion + '(get|set)[0-9]*TextArg:0,1', # just pass on a raw text value without validation / further conversion 'set[0-9]*ParseResponse:0,1', # parse response to set as if it was a get 'set[0-9]*Method:GET,POST,PUT', # select HTTP method for the set - '[gs]et[0-9]*FollowGet', # do a get after the set/get to update readings / create chains + '(get|set)[0-9]*FollowGet', # do a get after the set/get to update readings / create chains 'maxGetChain', # max length of chains 'reAuthRegex', @@ -219,10 +219,10 @@ my $AttrList = join (' ', 'reAuthJSON', 'reAuthXPath', 'reAuthXPath-Strict', - '[gs]et[0-9]*ReAuthRegex', - '[gs]et[0-9]*ReAuthJSON', - '[gs]et[0-9]*ReAuthXPath', - '[gs]et[0-9]*ReAuthXPath-Strict', + '(get|set)[0-9]*ReAuthRegex', + '(get|set)[0-9]*ReAuthJSON', + '(get|set)[0-9]*ReAuthXPath', + '(get|set)[0-9]*ReAuthXPath-Strict', 'idRegex', 'idJSON', @@ -248,7 +248,7 @@ my $AttrList = join (' ', 'replacement[0-9]+Regex', 'replacement[0-9]+Mode:reading,internal,text,expression,key', # defaults to text 'replacement[0-9]+Value:textField-long', # device:reading, device:internal, text, replacement expression - '[gs]et[0-9]*Replacement[0-9]+Value:textField-long', # can overwrite a global replacement value - todo: auch für auth? + '(get|set)[0-9]*Replacement[0-9]+Value:textField-long', # can overwrite a global replacement value - todo: auch für auth? 'do_not_notify:1,0', 'disable:0,1', @@ -372,20 +372,21 @@ sub NotifyFn { } -######################################################################### +################################################################################# sub LogOldAttr { my $hash = shift; # reference to the HTTPMOD Fhem device hash my $old = shift; # old attr name my $new = shift; # new attr name my $name = $hash->{NAME}; # name of the Fhem device - Log3 $name, 3, "$name: the attribute $old should no longer be used." . ($new ? " Please use $new instead" : ""); - Log3 $name, 3, "$name: For most old attributes you can specify enableControlSet and then set device upgradeAttributes to automatically modify the configuration"; + Log3 $name, 1, "$name: the attribute $old should no longer be used." . ($new ? " Please use $new instead" : ""); + Log3 $name, 1, "$name: For most old attributes you can specify enableControlSet and then set device upgradeAttributes to automatically modify the configuration"; return; } -################################### +######################################################################### # precompile regex attr value +# called from GetRegex if regex is not yet compiled and stored in a hash sub PrecompileRegexAttr { my $hash = shift; # reference to the HTTPMOD Fhem device hash my $aName = shift; # name of the object that contains the regex (e.g. attr name) @@ -450,7 +451,7 @@ sub AttrFn { my $regexErr = CheckRegexp($aVal, "attr $aName"); # check if Regex is valid return "$name: $aName Regex: $regexErr" if ($regexErr); - if ($aName =~ /([gs]et[0-9]*)?[Rr]eplacement[0-9]*Regex$/) { + if ($aName =~ /((get|set)[0-9]*)?[Rr]eplacement[0-9]*Regex$/) { $hash->{'.ReplacementEnabled'} = 1; } if ($aName =~ /(.+)IDRegex$/) { # conversions for legacy things @@ -500,7 +501,7 @@ sub AttrFn { return "$name: illegal mode in attr $name $aName $aVal"; } } - elsif ($aName =~ /([gs]et[0-9]*)?[Rr]eplacement([0-9]*)Value/) { + elsif ($aName =~ /((get|set)[0-9]*)?[Rr]eplacement([0-9]*)Value/) { Log3 $name, 5, "$name: validating attr $name $aName $aVal"; if (AttrVal($name, "replacement${2}Mode", "text") eq "expression") { return "Invalid Expression $aVal" if (!EvalExpr($hash, @@ -618,8 +619,8 @@ sub AttrFn { delete $hash->{'.MaxAgeEnabled'}; } } - elsif ($aName =~ /([gs]et[0-9]*)?[Rr]eplacement[0-9]*Regex/) { - if (!(grep {!/$aName/} grep {/([gs]et[0-9]*)?[Rr]eplacement[0-9]*Regex/} keys %{$attr{$name}})) { + elsif ($aName =~ /((get|set)[0-9]*)?[Rr]eplacement[0-9]*Regex/) { + if (!(grep {!/$aName/} grep {/((get|set)[0-9]*)?[Rr]eplacement[0-9]*Regex/} keys %{$attr{$name}})) { delete $hash->{'.ReplacementEnabled'}; } } @@ -638,7 +639,7 @@ sub AttrFn { #delete $hash->{TimeAlignFmt}; } } - if ($aName =~ /^[gs]et/ || $aName eq "enableControlSet") { + if ($aName =~ /^(get|set)/ || $aName eq "enableControlSet") { $hash->{".updateHintList"} = 1; } if ($aName =~ /^(get|reading)/) { @@ -888,7 +889,7 @@ sub DoReplacement { } } elsif ($mode eq 'expression') { - $value = 'package main; ' . ($value // ''); + $value = 'package main; ' . ($value // ''); # contains the expression local $SIG{__WARN__} = sub { Log3 $name, 3, "$name: Replacement $rNum with expression $value and regex $regex created warning: @_"; }; # if expression calls other fhem functions, creates readings or other, then the warning handler will create misleading messages! $match = eval { $string =~ s/$regex/$value/gee }; @@ -976,7 +977,7 @@ sub DoAuth { foreach my $step (sort {$b cmp $a} keys %steps) { # reverse sort because requests are prepended my $request = PrepareRequest($hash, "sid", $step); if ($request->{'url'}) { - $request->{'ignoreRedirects'} = AttrVal($name, "sid${step}IgnoreRedirects", 0); + $request->{'ignoreRedirects'} = GetFAttr($name, 'sid', $step, 'IgnoreRedirects', 0); $request->{'priority'} = 1; # prepend at front of queue AddToSendQueue($hash, $request); # todo: http method for sid steps? @@ -1015,26 +1016,26 @@ sub UpdateHintList { if ($context eq 'set') { my $map = ''; - $map = AttrVal($name, "${context}${num}Map", "") if ($context ne "get"); # old Map for set is now IMap (Input) - $map = AttrVal($name, "${context}${num}IMap", $map); # new syntax ovverides old one + $map = AttrVal($name, "${context}${num}Map", ''); # old Map for set is now IMap (Input) + $map = GetFAttr($name, $context, $num, 'IMap', $map); # new syntax overrides old one if ($map) { my $hint = MapToHint($map); # create hint from map $opt = $oName . ":$hint"; # opt is Name:Hint (from Map) - } elsif (AttrVal($name, "${context}${num}NoArg", undef)) { # NoArg explicitely specified for a set? + } elsif (GetFAttr($name, $context, $num, 'NoArg')) { # NoArg explicitely specified for a set? $opt = $oName . ':noArg'; } else { $opt = $oName; # nur den Namen für opt verwenden. } } elsif ($context eq 'get') { - if (AttrVal($name, "${context}${num}TextArg", undef)) { # TextArg explicitely specified for a get? + if (GetFAttr($name, $context, $num, 'TextArg')) { # TextArg explicitely specified for a get? $opt = $oName; # nur den Namen für opt verwenden. } else { $opt = $oName . ':noArg'; # sonst noArg bei get } } - if (AttrVal($name, "${context}${num}Hint", undef)) { # gibt es einen expliziten Hint? - $opt = $oName . ":" . AttrVal($name, "${context}${num}Hint", undef); + if (GetFAttr($name, $context, $num, 'Hint')) { # gibt es einen expliziten Hint? + $opt = $oName . ":" . GetFAttr($name, $context, $num, 'Hint'); } $hash->{".${context}List"} .= $opt . ' '; # save new hint list } @@ -1204,7 +1205,6 @@ sub SetFn { if(!defined ($setNum)) { # gültiger set Aufruf? ($setNum oben schon gesetzt?) UpdateHintList($hash) if ($hash->{".updateHintList"}); if (AttrVal($name, "useSetExtensions", 1)) { - #Log3 $name, 5, "$name: set is passing to setExtensions"; return SetExtensions($hash, $hash->{".setList"}, $name, $setName, @setValArr); } else { return "Unknown argument $setName, choose one of " . $hash->{".setList"}; @@ -1217,7 +1217,7 @@ sub SetFn { return; } - if (!AttrVal($name, "set${setNum}NoArg", undef)) { # soll überhaupt ein Wert übergeben werden? + if (!GetFAttr($name, 'set', $setNum, 'NoArg')) { # soll überhaupt ein Wert übergeben werden? if (!defined($setVal)) { # Ist ein Wert übergeben? Log3 $name, 3, "$name: set without value given for $setName"; return "no value given to set $setName"; @@ -1226,27 +1226,27 @@ sub SetFn { # Eingabevalidierung von Sets mit Definition per Attributen # 1. Schritt, falls definiert, per Umkehrung der Map umwandeln (z.B. Text in numerische Codes) - my $map = AttrVal($name, "set${setNum}Map", ""); # old Map for set is now IMap (Input) - $map = AttrVal($name, "set${setNum}IMap", $map); # new syntax ovverides old one + my $map = AttrVal($name, "set${setNum}Map", ''); # old Map for set is now IMap (Input) + $map = GetFAttr($name, 'set', $setNum, 'IMap', $map); # new syntax ovverides old one $rawVal = MapConvert ($hash, {map => $map, val => $rawVal, reverse => 1, undefIfNoMatch => 1}); return "set value $setVal did not match defined map" if (!defined($rawVal)); # make sure $rawVal is numeric unless textArg is specified - if (!$map && !AttrVal($name, "set${setNum}TextArg", undef) && $rawVal !~ /^-?\d+\.?\d*$/) { + if (!$map && !GetFAttr($name, 'set', $setNum, 'TextArg') && $rawVal !~ /^-?\d+\.?\d*$/) { Log3 $name, 3, "$name: set - value $rawVal is not numeric"; return "set value $rawVal is not numeric"; } - if (!AttrVal($name, "set${setNum}TextArg", undef) + if (!GetFAttr($name, 'set', $setNum, 'TextArg') && !CheckRange($hash, {val => $rawVal, - min => AttrVal($name, "set${setNum}Min", undef), - max => AttrVal($name, "set${setNum}Max", undef)} ) ) { + min => GetFAttr($name, 'set', $setNum. 'Min'), + max => GetFAttr($name, 'set', $setNum, 'Max')} ) ) { return "set value $rawVal is not within defined range"; } # Konvertiere input mit IExpr falls definiert my $exp = AttrVal($name, "set${setNum}Expr", ""); # old syntax for input in set - $exp = AttrVal($name, "set${setNum}IExpr", $exp); # new syntax overrides old one + $exp = GetFAttr($name, 'set', $setNum, 'IExpr', $exp); # new syntax overrides old one #Log3 $name, 5, "$name: set calls EvalExpr with exp $exp"; $rawVal = EvalExpr($hash, {expr => $exp, val => $rawVal, '@setValArr' => \@setValArr, action => "set${setNum}IExpr"}); Log3 $name, 4, "$name: set will now set $setName -> $rawVal"; @@ -1255,12 +1255,12 @@ sub SetFn { $rawVal = 0; Log3 $name, 4, "$name: set will now set $setName"; } - if (!AttrVal($name, "set${setNum}Local", undef)) { # soll überhaupt ein Request erzeugt werden? + if (!GetFAttr($name, 'set', $setNum, 'Local')) { # soll überhaupt ein Request erzeugt werden? my $request = PrepareRequest($hash, "set", $setNum); if ($request->{'url'}) { DoAuth $hash if (AttrVal($name, "reAuthAlways", 0)); $request->{'value'} = $rawVal; - $request->{'method'} = AttrVal($name, "set${setNum}Method", ''); + $request->{'method'} = GetFAttr($name, 'set', $setNum, 'Method', ''); AddToSendQueue($hash, $request ); } else { Log3 $name, 3, "$name: no URL for set $setNum"; @@ -1331,7 +1331,7 @@ sub ChainGet { my $type = shift; my $num = shift; my $name = $hash->{NAME}; - my $get = AttrVal($name, "${type}${num}FollowGet", ''); + my $get = GetFAttr($name, $type, $num, 'FollowGet'); if (!$get) { delete $hash->{GetChainLength}; return; @@ -1407,12 +1407,12 @@ sub GetUpdate { sub EvalFunctionCall { my ($hash, $buffer, $fName, $type) = @_; my $name = $hash->{NAME}; - if (AttrVal($name, $fName, undef)) { - Log3 $name, 5, "$name: Read is calling $fName for HTTP Response to $type"; - my $func = AttrVal($name, 'parseFunction1', undef); + my $callName = AttrVal($name, $fName, undef); + if ($callName) { + Log3 $name, 5, "$name: Read is calling $fName as $callName for HTTP Response to $type"; no strict "refs"; ## no critic - function name needs to be string becase it comes from an attribute - eval { &{$func}($hash, $buffer) }; - Log3 $name, 3, "$name: error calling $func: $@" if($@); + eval { &{$callName}($hash, $buffer) }; + Log3 $name, 3, "$name: error calling $callName: $@" if($@); use strict "refs"; } return; @@ -1421,6 +1421,8 @@ sub EvalFunctionCall { ################################################ # get a regex from attr and compile if not done +# called from DoReplacement, ExtractReading, ExtractSid, +# CheckAuth and ReadCallback sub GetRegex { my ($name, $context, $num, $type, $default) = @_; my $hash = $defs{$name}; @@ -1432,7 +1434,7 @@ sub GetRegex { # first look for attribute with the full num in it if ($num && defined ($attr{$name}{$context . $num . $type})) { # specific regex attr exists return $attr{$name}{$context . $num . $type} if (!$regCompile); # regex string from attr if no compilation wanted - if ($hash->{CompiledRegexes}{$context . $num . $type}) { # compiled specific regex esists + if ($hash->{CompiledRegexes}{$context . $num . $type}) { # compiled specific regex exists $val = $hash->{CompiledRegexes}{$context . $num . $type}; #Log3 $name, 5, "$name: GetRegex found precompiled $type for $context$num as $val"; } else { # not compiled (yet) @@ -1469,16 +1471,15 @@ sub FormatReading { my $expr = ""; my $map = ""; - if ($context eq "reading") { - $expr = AttrVal($name, 'readingsExpr' . $num, "") if ($context ne "set"); # very old syntax, not for set! - } - $decode = GetFAttr($name, $context, $num, "Decode"); - $encode = GetFAttr($name, $context, $num, "Encode"); - $map = GetFAttr($name, $context, $num, "Map") if ($context ne "set"); # not for set! - $map = GetFAttr($name, $context, $num, "OMap", $map); # new syntax - $format = GetFAttr($name, $context, $num, "Format"); - $expr = GetFAttr($name, $context, $num, "Expr", $expr) if ($context ne "set"); # not for set! - $expr = GetFAttr($name, $context, $num, "OExpr", $expr); # new syntax + $decode = GetFAttr($name, $context, $num, 'Decode'); + $encode = GetFAttr($name, $context, $num, 'Encode'); + $map = GetFAttr($name, $context, $num, 'Map') if ($context ne 'set'); # not for set! + $map = GetFAttr($name, $context, $num, 'OMap', $map); # new syntax + $format = GetFAttr($name, $context, $num, 'Format'); + + $expr = AttrVal($name, 'readingsExpr' . $num, '') if ($context eq 'reading'); # very old syntax, not for set + $expr = GetFAttr($name, $context, $num, 'Expr', $expr) if ($context ne 'set'); # not for set! + $expr = GetFAttr($name, $context, $num, 'OExpr', $expr); # new syntax # encode as utf8 by default if no encode is specified and body was decoded or no charset was seen in the header if (!$encode && (!$hash->{'.bodyCharset'} || $hash->{'.bodyCharset'} eq 'internal' )) { # body was decoded and encode not sepcified @@ -2158,7 +2159,7 @@ sub CheckRedirects { my $code = $header0[1]; Log3 $name, 4, "$name: checking for redirects, code=$code, ignore=$request->{ignoreredirects}"; - if ($code !~ m{ \A 301 | 302 | 303 \z }xms) { + if ($code !~ m{ \A 301 | 302 | 303 | 308 \z }xms) { Log3 $name, 4, "$name: no redirects to handle"; return; } @@ -2280,8 +2281,13 @@ sub DumpBuffer { $hash->{BufCounter} = 0 if (!$hash->{BufCounter}); $hash->{BufCounter} ++; my $path = AttrVal($name, "dumpBuffers", '.'); - Log3 $name, 3, "$name: dump buffer to $path/buffer$hash->{BufCounter}.txt"; + Log3 $name, 4, "$name: dump buffer to $path/buffer$hash->{BufCounter}.txt"; open($fh, '>', "$path/buffer$hash->{BufCounter}.txt"); ## no critic + if ($!) { + Log3 $name, 3, "$name: error opening: $!"; + return; + } + Log3 $name, 5, "$name: Filehandle is $fh"; if ($header) { print $fh $header; print $fh "\r\n\r\n"; @@ -2678,7 +2684,7 @@ sub AddToSendQueue { =item summary_DE fragt Readings von Geräten mit HTTP-Interface ab =begin html - +

HTTPMOD


- + Define
- + Simple configuration of HTTP Devices


- + formating and manipulating values / readings


- + Configuration to define a set command and send data to a device


- + Configuration to define a get command


- + Handling sessions and logging in


reAuthJSON or reAuthXPath typically only extract one piece of data from a response. @@ -3005,7 +3011,7 @@ sub AddToSendQueue {
- + Parsing JSON


- + Parsing http / XML using xpath


- + Parsing with named regex groups


- + Further replacements of URL, header or post data


A replacement always replaces a match of a regular expression. @@ -3221,7 +3227,7 @@ sub AddToSendQueue {
- + replacing reading values when they have not been updated / the device did not respond


- + Set-Commands

- + Get-Commands