2
0
mirror of https://github.com/fhem/fhem-mirror.git synced 2025-02-25 03:44:52 +00:00

98_HTTPMOD: small bugfixes, updated utils

git-svn-id: https://svn.fhem.de/fhem/trunk@27714 2b470e98-0d58-463d-a4d8-8e2adae1ed80
This commit is contained in:
StefanStrobel 2023-06-29 15:30:07 +00:00
parent a8d66741ed
commit 38ad6cdb1c
2 changed files with 59 additions and 45 deletions

View File

@ -143,7 +143,7 @@ BEGIN {
)); ));
}; };
my $Module_Version = '4.1.15 - 17.12.2022'; my $Module_Version = '4.1.16 - 4.4.2023';
my $AttrList = join (' ', my $AttrList = join (' ',
'reading[0-9]+(-[0-9]+)?Name', 'reading[0-9]+(-[0-9]+)?Name',
@ -801,6 +801,7 @@ sub UpgradeAttributes {
# if num is like 1-1 then check for 1 if 1-1 not found # if num is like 1-1 then check for 1 if 1-1 not found
sub GetFAttr { sub GetFAttr {
my ($name, $prefix, $num, $type, $val) = @_; my ($name, $prefix, $num, $type, $val) = @_;
#Log3 $name, 5, "$name: GetFAttr prefix $prefix, num $num, type $type, val $val";
# first look for attribute with the full num in it # first look for attribute with the full num in it
if (defined ($attr{$name}{$prefix . $num . $type})) { if (defined ($attr{$name}{$prefix . $num . $type})) {
$val = $attr{$name}{$prefix . $num . $type}; $val = $attr{$name}{$prefix . $num . $type};
@ -1248,7 +1249,7 @@ sub SetFn {
if (!GetFAttr($name, 'set', $setNum, 'TextArg') if (!GetFAttr($name, 'set', $setNum, 'TextArg')
&& !CheckRange($hash, {val => $rawVal, && !CheckRange($hash, {val => $rawVal,
min => GetFAttr($name, 'set', $setNum. 'Min'), min => GetFAttr($name, 'set', $setNum, 'Min'),
max => GetFAttr($name, 'set', $setNum, 'Max')} ) ) { max => GetFAttr($name, 'set', $setNum, 'Max')} ) ) {
return "set value $rawVal is not within defined range"; return "set value $rawVal is not within defined range";
} }
@ -1483,11 +1484,13 @@ sub FormatReading {
my $decode = GetFAttr($name, $context, $num, 'Decode'); my $decode = GetFAttr($name, $context, $num, 'Decode');
my $encode = GetFAttr($name, $context, $num, 'Encode'); my $encode = GetFAttr($name, $context, $num, 'Encode');
my $map = GetFAttr($name, $context, $num, 'Map') if ($context ne 'set'); # not for set!
$map = GetFAttr($name, $context, $num, 'OMap', $map); # new syntax
my $format = GetFAttr($name, $context, $num, 'Format'); my $format = GetFAttr($name, $context, $num, 'Format');
my $expr = AttrVal($name, 'readingsExpr' . $num, '') if ($context eq 'reading'); # old syntax, not set my $map;
$map = GetFAttr($name, $context, $num, 'Map') if ($context ne 'set'); # not for set!
$map = GetFAttr($name, $context, $num, 'OMap', $map); # new syntax
my $expr;
$expr = AttrVal($name, 'readingsExpr' . $num, '') if ($context eq 'reading'); # old syntax, not set
$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

View File

@ -52,12 +52,9 @@ our @EXPORT_OK = qw(UpdateTimer FhemCaller
FlattenJSON FlattenJSON
BodyDecode BodyDecode
IsOpen IsOpen
FmtTimeMs FmtTimeMs FmtDate FmtDateTimeNice
FmtDate DateDiff date_str2num
FmtDateTimeNice ReadableArray HexIfNeeded
DateDiff
date_str2num
ReadableArray
Statistics Profiler Statistics Profiler
); );
@ -141,7 +138,7 @@ sub UpdateTimer {
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 ...
my $count = int(($now - $hash->{'.TimeAlign'}) / $intvl); # $intvl <> 0,has been checked above my $count = int(($now - $hash->{'.TimeAlign'}) / $intvl); # $intvl <> 0,has been checked above
$nextUpdate = $count * $intvl + $hash->{'.TimeAlign'}; # next aligned time >= now, lastUpdate doesn't matter with alignment $nextUpdate = $count * $intvl + $hash->{'.TimeAlign'}; # next aligned time >= now, lastUpdate doesn't matter with alignment
$nextUpdate += $intvl if ($nextUpdate <= $now); # works for initial alignment as welas for next round $nextUpdate += $intvl if ($nextUpdate <= $now); # works for initial alignment as well as for next round
} }
else { # no align time -> just add the interval to now else { # no align time -> just add the interval to now
if ($hash->{'.LastUpdate'}) { if ($hash->{'.LastUpdate'}) {
@ -278,37 +275,40 @@ sub EvalExpr {
my $rawVal = $val; my $rawVal = $val;
my $text = $val; my $text = $val;
return 0 if ($NlIfNoExp && !$exp); return 0 if ($NlIfNoExp && !$exp);
#Log3 $name, 3, "$name: $action with expression $exp on $val called from " . FhemCaller();
return $val if (!$exp); return $val if (!$exp);
my $inCheckEval = ($checkOnly ? 0 : 1); my $inCheckEval = ($checkOnly ? 0 : 1);
my $assign = 'package main; '; my $assign = 'package main; ';
KEYLOOP: KEYLOOP:
foreach my $key (keys %{$oRef}) { foreach my $key (keys %{$oRef}) {
next KEYLOOP if($key =~ /(checkOnly|nullIfNoExp|expr|action)/); next KEYLOOP if($key =~ /^(val|checkOnly|nullIfNoExp|expr|action)$/);
my $type = ref $oRef->{$key}; my $type = ref $oRef->{$key}; # type of the value
my $vName = substr($key,1); my $vName = substr($key,1);
my $vType = substr($key,0,1); my $vType = substr($key,0,1); # first character of key
#Log3 $name, 3, "$name: EvalExpr: $action check key $key type $type and vType $vType"; #Log3 $name, 3, "$name: EvalExpr: $action check key $key type $type and vType $vType";
if ($type eq 'SCALAR') { if ($type eq 'SCALAR') { # value is a reference to a scalar:
$assign .= "my \$$vName = \${\$oRef->{'$key'}};"; # assign ref to scalar as scalar $assign .= "my \$$vName = \${\$oRef->{'$key'}};"; # assign ref to scalar as scalar
} }
elsif ($type eq 'ARRAY' && $vType eq '$') { elsif ($type eq 'ARRAY' && $vType eq '$') { # value is a reference to an array and key is name of a scalar:
$assign .= "my \$$vName = \$oRef->{'$key'};"; # assign array ref as array ref $assign .= "my \$$vName = \$oRef->{'$key'};"; # assign array ref as array ref
} }
elsif ($type eq 'ARRAY') { elsif ($type eq 'ARRAY') { # value is a reference to an array:
$assign .= "my \@$vName = \@{\$oRef->{'$key'}};"; # assign array ref as array $assign .= "my \@$vName = \@{\$oRef->{'$key'}};"; # assign array ref as array
} }
elsif ($type eq 'HASH' && $vType eq '$') { elsif ($type eq 'HASH' && $vType eq '$') { # value is a reference to a hash and key is name of a scalar:
$assign .= "my \$$vName = \$oRef->{'$key'};"; # assign hash ref as hash ref $assign .= "my \$$vName = \$oRef->{'$key'};"; # assign hash ref as hash ref
} }
elsif ($type eq 'HASH') { elsif ($type eq 'HASH') { # value is a reference to an array:
$assign .= "my \%$vName = \%{\$oRef->{'$key'}};"; # assign hash ref as hash $assign .= "my \%$vName = \%{\$oRef->{'$key'}};"; # assign hash ref as hash
} }
elsif ($type eq '' && $vType eq '$') { elsif ($type eq '' && $vType eq '$') { # value is not a reference but a scalar and key starts with $:
$assign .= "my \$$vName = \$oRef->{'$key'};"; # assign scalar as scalar $assign .= "my \$$vName = \$oRef->{'$key'};"; # assign scalar as scalar
} }
else {
Log3 $name, 3, "$name: $action ignores strange key $key pointing to type $type";
}
} }
$exp = $assign . ($checkOnly ? 'return undef;' : '') . $exp; $exp = $assign . ($checkOnly ? 'return undef;' : '') . $exp;
@ -319,7 +319,7 @@ sub EvalExpr {
return 0 if ($checkOnly); return 0 if ($checkOnly);
} else { } else {
return 1 if ($checkOnly); return 1 if ($checkOnly);
Log3 $name, 5, "$name: $action evaluated $exp to $result"; Log3 $name, 5, "$name: $action evaluated $exp to " . HexIfNeeded($result);
} }
return $result; return $result;
} }
@ -342,10 +342,6 @@ sub FhemCaller {
# called from Set and FormatReading # called from Set and FormatReading
# map example: 0:mittig, 1:über, 2:unterhalb # map example: 0:mittig, 1:über, 2:unterhalb
# todo: potential extension: 0:mittig, 1:über, 2:unterhalb, *:undefined ??
# or for slave mode and the reverse map: 0:*??
# or better pass new named parameters mapDefault / rmapDefault from new attrs?
sub MapConvert { sub MapConvert {
my $hash = shift; my $hash = shift;
my $oRef = shift; # hash ref for passing options and variables for use in expressions my $oRef = shift; # hash ref for passing options and variables for use in expressions
@ -355,6 +351,7 @@ sub MapConvert {
my $action = $oRef->{'action'} // 'apply map'; # context for logging my $action = $oRef->{'action'} // 'apply map'; # context for logging
my $UndefIfNoMatch = $oRef->{'undefIfNoMatch'} // 0; # return undef if map is not matching, my $UndefIfNoMatch = $oRef->{'undefIfNoMatch'} // 0; # return undef if map is not matching,
my $inVal = $oRef->{'val'}; # input value my $inVal = $oRef->{'val'}; # input value
my $default = $oRef->{'default'}; # undef if not passed
my $name = $hash->{NAME}; my $name = $hash->{NAME};
return $inVal if (!$map); # don't change anything if map is empty return $inVal if (!$map); # don't change anything if map is empty
@ -378,9 +375,9 @@ sub MapConvert {
else { else {
Log3 $name, 3, "$name: MapConvert called from " . FhemCaller() . " did not find $val ($inVal) in" . Log3 $name, 3, "$name: MapConvert called from " . FhemCaller() . " did not find $val ($inVal) in" .
($reverse ? " reversed" : "") . " map $map"; ($reverse ? " reversed" : "") . " map $map";
if (defined($oRef->{'default'})) { if (defined($default)) {
Log3 $name, 3, "$name: MapConvert returns defined default value $oRef->{'default'}"; Log3 $name, 3, "$name: MapConvert returns defined default value $default";
return $oRef->{'default'}; return $default;
} }
return if ($UndefIfNoMatch); # no match -> return undef because of $UndefIfNoMatch return if ($UndefIfNoMatch); # no match -> return undef because of $UndefIfNoMatch
return $inVal; # no match -> return original value return $inVal; # no match -> return original value
@ -644,7 +641,7 @@ sub JsonFlatter {
my $prefix = shift // ''; # prefix string for resulting key my $prefix = shift // ''; # prefix string for resulting key
my $name = $hash->{NAME}; # Fhem device name my $name = $hash->{NAME}; # Fhem device name
#Log3 $name, 5, "$name: JSON Flatter called : prefix $prefix, ref is $ref"; Log3 $name, 5, "$name: JSON Flatter called : prefix $prefix, ref is $ref";
if (ref($ref) eq "ARRAY" ) { if (ref($ref) eq "ARRAY" ) {
my $key = 0; my $key = 0;
foreach my $value (@{$ref}) { foreach my $value (@{$ref}) {
@ -654,9 +651,10 @@ sub JsonFlatter {
JsonFlatter($hash, $value, $prefix.sprintf("%02i",$key+1)."_"); JsonFlatter($hash, $value, $prefix.sprintf("%02i",$key+1)."_");
} }
else { else {
if (defined ($value)) { if (defined ($value) or 1) {
#Log3 $name, 5, "$name: JSON Flatter sets $prefix$key to $value"; Log3 $name, 5, "$name: JSON Flatter sets $prefix$key to "
$hash->{ParserData}{JSON}{$prefix.$key} = $value; . ($value // 'empty string');
$hash->{ParserData}{JSON}{$prefix.$key} = ($value // '');
} }
} }
$key++; $key++;
@ -664,15 +662,16 @@ sub JsonFlatter {
} }
elsif (ref($ref) eq "HASH" ) { elsif (ref($ref) eq "HASH" ) {
while( my ($key,$value) = each %{$ref}) { while( my ($key,$value) = each %{$ref}) {
#Log3 $name, 5, "$name: JSON Flatter in hash while, key = $key, value = $value"; Log3 $name, 5, "$name: JSON Flatter in hash while, key = $key, value = " . ($value // 'undef');
if(ref($value) eq "HASH" or ref($value) eq "ARRAY") { if(ref($value) eq "HASH" or ref($value) eq "ARRAY") {
#Log3 $name, 5, "$name: JSON Flatter doing recursion because value is a " . ref($value); Log3 $name, 5, "$name: JSON Flatter doing recursion because value is a " . ref($value);
JsonFlatter($hash, $value, $prefix.$key."_"); JsonFlatter($hash, $value, $prefix.$key."_");
} }
else { else {
if (defined ($value)) { if (defined ($value) or 1) {
#Log3 $name, 5, "$name: JSON Flatter sets $prefix$key to $value"; Log3 $name, 5, "$name: JSON Flatter sets $prefix$key to "
$hash->{ParserData}{JSON}{$prefix.$key} = $value; . ($value // 'empty string');
$hash->{ParserData}{JSON}{$prefix.$key} = ($value // '');
} }
} }
} }
@ -697,7 +696,7 @@ sub FlattenJSON {
my $logLvl = ($cT =~ /json/i ? 3 : 4); my $logLvl = ($cT =~ /json/i ? 3 : 4);
if ($@) { if ($@) {
Log3 $name, $logLvl, "$name: error while parsing JSON data: $@"; Log3 $name, $logLvl, "$name: error while parsing JSON data: $@";
#Log3 $name, 3, "$name: Content-Type was $cT"; Log3 $name, 3, "$name: Content-Type was $cT";
} }
else { else {
JsonFlatter($hash, $decoded); JsonFlatter($hash, $decoded);
@ -851,7 +850,8 @@ sub DateDiff {
my $d1d = (split (/ /, $d1))[0]; # split time and date part of string my $d1d = (split (/ /, $d1))[0]; # split time and date part of string
my $d2d = (split (/ /, $d2))[0]; # split time and date part of string my $d2d = (split (/ /, $d2))[0]; # split time and date part of string
# subtract lastdate as number from todays date as number and divide # subtract lastdate as number from todays date as number and divide
my $days = (date_str2num($d2d) - date_str2num($d1d)) / 86400; #my $days = (date_str2num($d2d) - date_str2num($d1d)) / 86400; # problem when summer time comes during the interval
my $days = sprintf('%0.f', (date_str2num($d2d) - date_str2num($d1d)) / 86400);
return $days; return $days;
} }
@ -866,6 +866,17 @@ sub date_str2num($) {
} }
####################################################
# convert text to hex encoded string if it contains
# characters that are not printable
sub HexIfNeeded {
my $text = shift;
return 'undef' if (!defined($text));
return "hex " . unpack ('H*', $text) if ($text =~ /\p{XPosixCntrl}/);
return $text;
}
######################################################### #########################################################
sub ReadableArray { sub ReadableArray {
my $val = shift; my $val = shift;