FHEM/fhem-mirror
2
0
Fork 0
mirror of https://github.com/fhem/fhem-mirror.git synced 2025-03-10 09:16:53 +00:00
Code Issues Releases Wiki Activity

98_HTTPMOD: small fixes

Browse Source 
git-svn-id: https://svn.fhem.de/fhem/trunk@23943 2b470e98-0d58-463d-a4d8-8e2adae1ed80
This commit is contained in:
StefanStrobel 2021-03-13 10:14:34 +00:00
parent ff66cb7856
commit 28975d8ce0
2 changed files with 77 additions and 45 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
fhem/FHEM/98_HTTPMOD.pm
View File

@ -141,7 +141,7 @@ BEGIN {
)); ));
}; };
my $Module_Version = '4.1.02 - 4.2.2021'; my $Module_Version = '4.1.05 - 6.3.2021';
my $AttrList = join (' ', my $AttrList = join (' ',
'(reading|get|set)[0-9]+(-[0-9]+)?Name', '(reading|get|set)[0-9]+(-[0-9]+)?Name',
@ -189,7 +189,7 @@ my $AttrList = join (' ',
'preProcessRegex', 'preProcessRegex',
'parseFunction1', 'parseFunction1',
'parseFunction2', 'parseFunction2',
'set[0-9]+Temp', 'set[0-9]+Local', # don't create a request and just set a reading
'[gs]et[0-9]*URL', '[gs]et[0-9]*URL',
'[gs]et[0-9]*Data.*', '[gs]et[0-9]*Data.*',
'[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]*NoData.*', # make sure it is an HTTP GET without data - even if a more generic data is defined
@ -434,7 +434,7 @@ sub AttrFn {
my $cmd = shift; # 'set' or 'del' my $cmd = shift; # 'set' or 'del'
my $name = shift; # the Fhem device name my $name = shift; # the Fhem device name
my $aName = shift; # attribute name my $aName = shift; # attribute name
my $aVal = shift; # attribute value my $aVal = shift // ''; # attribute value
my $hash = $defs{$name}; # reference to the Fhem device hash my $hash = $defs{$name}; # reference to the Fhem device hash
Log3 $name, 5, "$name: attr $name $aName $aVal"; Log3 $name, 5, "$name: attr $name $aName $aVal";
@ -942,8 +942,8 @@ sub PrepareRequest {
} }
#Log3 $name, 5, "$name: PrepareRequest got url $url, header $header and data $data"; #Log3 $name, 5, "$name: PrepareRequest got url $url, header $header and data $data";
$header = EvalExpr($hash, {expr => GetFAttr($name, $context, $num, "HdrExpr"), val => $header, action => 'HdrExpr'}); $header = EvalExpr($hash, {expr => GetFAttr($name, $context, $num, "HdrExpr"), val => $header, action => 'HdrExpr'});
$data = EvalExpr($hash, {expr => GetFAttr($name, $context, $num, "DatExpr"), val => $data, action => 'DatExpr'}); $data = EvalExpr($hash, {expr => GetFAttr($name, $context, $num, "DatExpr"), val => $data, action => 'DatExpr'});
$url = EvalExpr($hash, {expr => GetFAttr($name, $context, $num, "URLExpr"), val => $url, action => 'URLExpr'}); $url = EvalExpr($hash, {expr => GetFAttr($name, $context, $num, "URLExpr"), val => $url, action => 'URLExpr'});
my $type; my $type;
if ($context eq 'reading') { if ($context eq 'reading') {
@ -1254,7 +1254,7 @@ sub SetFn {
$rawVal = 0; $rawVal = 0;
Log3 $name, 4, "$name: set will now set $setName"; Log3 $name, 4, "$name: set will now set $setName";
} }
if (!AttrVal($name, "set${setNum}Temp", undef)) { # soll überhaupt ein Request erzeugt werden? if (!AttrVal($name, "set${setNum}Local", undef)) { # soll überhaupt ein Request erzeugt werden?
my $request = PrepareRequest($hash, "set", $setNum); my $request = PrepareRequest($hash, "set", $setNum);
if ($request->{'url'}) { if ($request->{'url'}) {
DoAuth $hash if (AttrVal($name, "reAuthAlways", 0)); DoAuth $hash if (AttrVal($name, "reAuthAlways", 0));
@ -1479,10 +1479,11 @@ sub FormatReading {
$expr = GetFAttr($name, $context, $num, "Expr", $expr) if ($context ne "set"); # 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 $expr = GetFAttr($name, $context, $num, "OExpr", $expr); # new syntax
# if no encode is specified and bodyDecode did decode, then encode as utf8 by default # encode as utf8 by default if no encode is specified and body was decoded or no charset was seen in the header
#my $fDefault = ($featurelevel > 5.9 ? 'auto' : ''); if (!$encode && (!$hash->{'.bodyCharset'} || $hash->{'.bodyCharset'} eq 'internal' )) { # body was decoded and encode not sepcified
my $bodyDecode = AttrVal($name, 'bodyDecode', ''); $encode = 'utf8';
$encode = 'utf8' if (!$encode && $bodyDecode ne 'none'); Log3 $name, 5, "$name: FormatReading is encoding the reading value as utf-8 because no encoding was specified and the response body charset was unknown or decoded";
}
$val = decode($decode, $val) if ($decode && $decode ne 'none'); $val = decode($decode, $val) if ($decode && $decode ne 'none');
$val = encode($encode, $val) if ($encode && $encode ne 'none'); $val = encode($encode, $val) if ($encode && $encode ne 'none');
@ -2276,7 +2277,7 @@ sub DumpBuffer {
my $fh; my $fh;
$hash->{BufCounter} = 0 if (!$hash->{BufCounter}); $hash->{BufCounter} = 0 if (!$hash->{BufCounter});
$hash->{BufCounter} ++; $hash->{BufCounter} ++;
my $path = AttrVal($name, "dumpBuffers", 0); my $path = AttrVal($name, "dumpBuffers", '.');
Log3 $name, 3, "$name: dump buffer to $path/buffer$hash->{BufCounter}.txt"; Log3 $name, 3, "$name: dump buffer to $path/buffer$hash->{BufCounter}.txt";
open($fh, '>', "$path/buffer$hash->{BufCounter}.txt"); ## no critic open($fh, '>', "$path/buffer$hash->{BufCounter}.txt"); ## no critic
if ($header) { if ($header) {
@ -2737,7 +2738,7 @@ sub AddToSendQueue {
attr PM reading02Name CL<br> attr PM reading02Name CL<br>
attr PM reading02Regex 34.4008.value":[ \t]+"([\d\.]+)"<br> attr PM reading02Regex 34.4008.value":[ \t]+"([\d\.]+)"<br>
<br> <br>
attr PM reading03Name3TEMP<br> attr PM reading03Name TEMP<br>
attr PM reading03Regex 34.4033.value":[ \t]+"([\d\.]+)"<br> attr PM reading03Regex 34.4033.value":[ \t]+"([\d\.]+)"<br>
<br> <br>
attr PM requestData {"get" :["34.4001.value" ,"34.4008.value" ,"34.4033.value", "14.16601.value", "14.16602.value"]}<br> attr PM requestData {"get" :["34.4001.value" ,"34.4008.value" ,"34.4033.value", "14.16601.value", "14.16602.value"]}<br>
@ -3469,6 +3470,8 @@ sub AddToSendQueue {
Defines that this set option doesn't require arguments. It allows sets like "on" or "off" without further values. Defines that this set option doesn't require arguments. It allows sets like "on" or "off" without further values.
<li><b>set[0-9]*ParseResponse</b></li> <li><b>set[0-9]*ParseResponse</b></li>
defines that the HTTP response to the set will be parsed as if it was the response to a get command. defines that the HTTP response to the set will be parsed as if it was the response to a get command.
<li><b>set[0-9]*Local</b></li>
defines that no HTTP request will be sent. Instead the value is directly set as a reading value.
<br> <br>
<li><b>(get|set)[0-9]*HdrExpr</b></li> <li><b>(get|set)[0-9]*HdrExpr</b></li>

95
fhem/lib/FHEM/HTTPMOD/Utils.pm
View File

@ -120,13 +120,13 @@ sub UpdateTimer {
if ($hash->{'.TRIGGERTIME'}) { if ($hash->{'.TRIGGERTIME'}) {
Log3 $name, 4, "$name: UpdateTimer called from " . FhemCaller() . " with cmd $cmd and interval $intvl stops timer"; Log3 $name, 4, "$name: UpdateTimer called from " . FhemCaller() . " with cmd $cmd and interval $intvl stops timer";
delete $hash->{'.TRIGGERTIME'}; delete $hash->{'.TRIGGERTIME'};
#delete $hash->{TRIGGERTIME_FMT};
delete $hash->{'.LastUpdate'}; delete $hash->{'.LastUpdate'};
#delete $hash->{TRIGGERTIME_FMT};
} }
return; return;
} }
if ($cmd eq 'next') { if ($cmd eq 'next') {
$hash->{'.LastUpdate'} = $now; # start timer from now, ignore potential last update time $hash->{'.LastUpdate'} = $now; # start timer from now, ignore potential last update time
} }
my $nextUpdate; my $nextUpdate;
if ($hash->{'.TimeAlign'}) { # TimeAlign: do as if interval started at time w/o drift ... if ($hash->{'.TimeAlign'}) { # TimeAlign: do as if interval started at time w/o drift ...
@ -665,9 +665,12 @@ sub FlattenJSON {
eval { use JSON }; eval { use JSON };
return if($@); return if($@);
my $decoded = eval { decode_json($buffer) }; my $decoded = eval { decode_json($buffer) };
my $cT = $hash->{'.Content-Type'} // '';
my $logLvl = ($cT =~ /json/i ? 3 : 4);
if ($@) { if ($@) {
Log3 $name, 3, "$name: error while parsing JSON data: $@"; Log3 $name, $logLvl, "$name: error while parsing JSON data: $@";
#Log3 $name, 3, "$name: Content-Type was $cT";
} }
else { else {
JsonFlatter($hash, $decoded); JsonFlatter($hash, $decoded);
@ -682,47 +685,73 @@ sub FlattenJSON {
sub MemReading { sub MemReading {
my $hash = shift; my $hash = shift;
my $name = $hash->{NAME}; # Fhem device name my $name = $hash->{NAME}; # Fhem device name
my $v = `awk '/VmSize/{print \$2}' /proc/$$/status`; if (-e "/proc/$$/status") {
$v = sprintf("%.2f",(rtrim($v)/1024)); my $v = `awk '/VmSize/{print \$2}' /proc/$$/status`;
readingsBeginUpdate($hash); $v = sprintf("%.2f",(rtrim($v)/1024));
readingsBulkUpdate ($hash, "Fhem_Mem", $v); readingsBeginUpdate($hash);
readingsBulkUpdate ($hash, "Fhem_BufCounter", $hash->{BufCounter}) if defined($hash->{BufCounter}); readingsBulkUpdate ($hash, "Fhem_Mem", $v);
readingsEndUpdate($hash, 1); readingsBulkUpdate ($hash, "Fhem_BufCounter", $hash->{BufCounter}) if defined($hash->{BufCounter});
Log3 $name, 5, "$name: Read checked virtual Fhem memory: " . $v . "MB" . readingsEndUpdate($hash, 1);
(defined($hash->{BufCounter}) ? ", BufCounter = $hash->{BufCounter}" : ""); Log3 $name, 5, "$name: Read checked virtual Fhem memory: " . $v . "MB" .
(defined($hash->{BufCounter}) ? ", BufCounter = $hash->{BufCounter}" : "");
} else {
Log3 $name, 5, "$name: MemReading only works under Linux";
}
return; return;
} }
########################################## ########################################################
# decode charset in a http response # get content-type and decode charset in a http response
sub BodyDecode { sub BodyDecode {
my $hash = shift; my $hash = shift;
my $body = shift; my $body = shift;
my $header = shift // ''; my $header = shift // '';
my $name = $hash->{NAME}; # Fhem device name my $name = $hash->{NAME}; # Fhem device name
my $fDefault = ($featurelevel > 5.9 ? 'auto' : ''); my $bodyDecode = AttrVal($name, 'bodyDecode', 'default');
my $bodyDecode = AttrVal($name, 'bodyDecode', $fDefault); my $bodyCharset;
my $decoding;
if ($bodyDecode eq 'auto' or $bodyDecode eq 'Auto') { if ($header =~/Content-Type:(.*)/i) {
if ($header =~/Content-Type:.*charset=([\w\-\.]+)/i) { $hash->{'.Content-Type'} = $1;
$bodyDecode = $1;
Log3 $name, 4, "$name: BodyDecode found charset header and set decoding to $bodyDecode (bodyDecode was set to auto)";
}
else {
$bodyDecode = "";
Log3 $name, 4, "$name: BodyDecode found no charset header (bodyDecode was set to auto)";
}
} }
if ($bodyDecode) { if ($header =~/Content-Type:.*charset=([\w\-\.]+)/i) {
if ($bodyDecode =~ m{\A [Nn]one \z}xms) { $bodyCharset = $1;
Log3 $name, 4, "$name: BodyDecode is not decoding the response body (set to none)"; $hash->{'.bodyCharset'} = $bodyCharset;
} }
else { else {
$body = decode($bodyDecode, $body); $bodyCharset = 'not found';
Log3 $name, 4, "$name: BodyDecode is decoding the response body as $bodyDecode "; delete $hash->{'.bodyCharset'};
}
if ($bodyDecode =~ m{\A [Nn]one \z}xms) {
Log3 $name, 4, "$name: BodyDecode is not decoding the response body (charset $bodyCharset, bodyDecode set to none)";
}
elsif ($bodyDecode eq 'default') {
Log3 $name, 4, "$name: BodyDecode is not decoding the response body (charset $bodyCharset, bodyDecode defaults to none)";
}
elsif ($bodyDecode =~ m{\A [Aa]uto \z}xms) {
if ($bodyCharset eq 'not found') {
Log3 $name, 4, "$name: BodyDecode is not decoding the response body (charset header not found, bodyDecode set to auto)";
} }
#Log3 $name, 5, "$name: BodyDecode callback " . ($body ? "new body as utf-8 is: \n" . encode ('utf-8', $body) : "body empty"); else {
Log3 $name, 4, "$name: BodyDecode is decoding the response body as $bodyCharset (charset header $bodyCharset, bodyDecode set to auto)";
$decoding = $bodyCharset;
}
}
elsif (lower($bodyDecode) eq lower($bodyCharset)) {
Log3 $name, 4, "$name: BodyDecode is decoding the response body as $bodyDecode";
$decoding = $bodyCharset;
}
else {
Log3 $name, 4, "$name: BodyDecode is decoding the response body as $bodyDecode but charset header is $bodyCharset";
$decoding = $bodyCharset;
}
if ($decoding) {
$body = decode($decoding, $body);
$hash->{'.bodyCharset'} = 'internal';
#Log3 $name, 5, "$name: BodyDecode " . ($body ? "new body as utf-8 is: \n" . encode ('utf-8', $body) : "body empty");
} }
return $body; return $body;
} }