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 (' ',
'(reading|get|set)[0-9]+(-[0-9]+)?Name',
@ -189,7 +189,7 @@ my $AttrList = join (' ',
'preProcessRegex',
'parseFunction1',
'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]*Data.*',
'[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 $name = shift; # the Fhem device 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
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";
$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'});
$url = EvalExpr($hash, {expr => GetFAttr($name, $context, $num, "URLExpr"), val => $url, action => 'URLExpr'});
$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'});
my $type;
if ($context eq 'reading') {
@ -1254,7 +1254,7 @@ sub SetFn {
$rawVal = 0;
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);
if ($request->{'url'}) {
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, "OExpr", $expr); # new syntax
# if no encode is specified and bodyDecode did decode, then encode as utf8 by default
#my $fDefault = ($featurelevel > 5.9 ? 'auto' : '');
my $bodyDecode = AttrVal($name, 'bodyDecode', '');
$encode = 'utf8' if (!$encode && $bodyDecode ne 'none');
# 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
$encode = 'utf8';
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 = encode($encode, $val) if ($encode && $encode ne 'none');
@ -2276,7 +2277,7 @@ sub DumpBuffer {
my $fh;
$hash->{BufCounter} = 0 if (!$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";
open($fh, '>', "$path/buffer$hash->{BufCounter}.txt"); ## no critic
if ($header) {
@ -2737,7 +2738,7 @@ sub AddToSendQueue {
attr PM reading02Name CL<br>
attr PM reading02Regex 34.4008.value":[ \t]+"([\d\.]+)"<br>
<br>
attr PM reading03Name3TEMP<br>
attr PM reading03Name TEMP<br>
attr PM reading03Regex 34.4033.value":[ \t]+"([\d\.]+)"<br>
<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.
<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.
<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>
<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'}) {
Log3 $name, 4, "$name: UpdateTimer called from " . FhemCaller() . " with cmd $cmd and interval $intvl stops timer";
delete $hash->{'.TRIGGERTIME'};
#delete $hash->{TRIGGERTIME_FMT};
delete $hash->{'.LastUpdate'};
#delete $hash->{TRIGGERTIME_FMT};
}
return;
}
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;
if ($hash->{'.TimeAlign'}) { # TimeAlign: do as if interval started at time w/o drift ...
@ -665,9 +665,12 @@ sub FlattenJSON {
eval { use JSON };
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 ($@) {
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 {
JsonFlatter($hash, $decoded);
@ -682,47 +685,73 @@ sub FlattenJSON {
sub MemReading {
my $hash = shift;
my $name = $hash->{NAME}; # Fhem device name
my $v = `awk '/VmSize/{print \$2}' /proc/$$/status`;
$v = sprintf("%.2f",(rtrim($v)/1024));
readingsBeginUpdate($hash);
readingsBulkUpdate ($hash, "Fhem_Mem", $v);
readingsBulkUpdate ($hash, "Fhem_BufCounter", $hash->{BufCounter}) if defined($hash->{BufCounter});
readingsEndUpdate($hash, 1);
Log3 $name, 5, "$name: Read checked virtual Fhem memory: " . $v . "MB" .
(defined($hash->{BufCounter}) ? ", BufCounter = $hash->{BufCounter}" : "");
if (-e "/proc/$$/status") {
my $v = `awk '/VmSize/{print \$2}' /proc/$$/status`;
$v = sprintf("%.2f",(rtrim($v)/1024));
readingsBeginUpdate($hash);
readingsBulkUpdate ($hash, "Fhem_Mem", $v);
readingsBulkUpdate ($hash, "Fhem_BufCounter", $hash->{BufCounter}) if defined($hash->{BufCounter});
readingsEndUpdate($hash, 1);
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;
}
##########################################
# decode charset in a http response
########################################################
# get content-type and decode charset in a http response
sub BodyDecode {
my $hash = shift;
my $body = shift;
my $header = shift // '';
my $name = $hash->{NAME}; # Fhem device name
my $fDefault = ($featurelevel > 5.9 ? 'auto' : '');
my $bodyDecode = AttrVal($name, 'bodyDecode', $fDefault);
my $bodyDecode = AttrVal($name, 'bodyDecode', 'default');
my $bodyCharset;
my $decoding;
if ($bodyDecode eq 'auto' or $bodyDecode eq 'Auto') {
if ($header =~/Content-Type:.*charset=([\w\-\.]+)/i) {
$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 ($header =~/Content-Type:(.*)/i) {
$hash->{'.Content-Type'} = $1;
}
if ($bodyDecode) {
if ($bodyDecode =~ m{\A [Nn]one \z}xms) {
Log3 $name, 4, "$name: BodyDecode is not decoding the response body (set to none)";
}
else {
$body = decode($bodyDecode, $body);
Log3 $name, 4, "$name: BodyDecode is decoding the response body as $bodyDecode ";
if ($header =~/Content-Type:.*charset=([\w\-\.]+)/i) {
$bodyCharset = $1;
$hash->{'.bodyCharset'} = $bodyCharset;
}
else {
$bodyCharset = 'not found';
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;
}