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:
parent
a8d66741ed
commit
38ad6cdb1c
@ -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
|
||||||
|
|
||||||
|
@ -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;
|
||||||
|
Loading…
x
Reference in New Issue
Block a user