FHEM/fhem-mirror
2
0
Fork 0
mirror of https://github.com/fhem/fhem-mirror.git synced 2025-03-03 23:06:37 +00:00
Code Issues Releases Wiki Activity

98_HTTPMOD: bugfixes in Utils.pm

Browse Source 
git-svn-id: https://svn.fhem.de/fhem/trunk@23331 2b470e98-0d58-463d-a4d8-8e2adae1ed80
This commit is contained in:
StefanStrobel 2020-12-12 11:00:22 +00:00
parent bdaff98615
commit 29b0758fd2
1 changed files with 159 additions and 35 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -49,6 +49,7 @@ our @EXPORT_OK = qw(UpdateTimer FhemCaller
IsOpen
FmtTimeMs
ReadableArray
Statistics Profiler
);
our %EXPORT_TAGS = (all => [@EXPORT_OK]);
@ -181,12 +182,12 @@ sub StartQueueTimer {
my $now = gettimeofday();
my $delay = (defined($pDelay) ? $pDelay : AttrVal($name, 'queueDelay', 1));
return if ($ioHash->{nextQueueRun} && $ioHash->{nextQueueRun} < $now+$delay);
RemoveInternalTimer ("queue:$name");
InternalTimer($now+$delay, $pFunc, "queue:$name", 0);
$ioHash->{nextQueueRun} = $now+$delay;
Log3 $name, 5, "$name: StartQueueTimer called from " . FhemCaller() .
' sets internal timer to process queue in ' .
sprintf ('%.3f', $delay) . ' seconds' . ($msg ? ", $msg" : '') if (!$silent);
RemoveInternalTimer ("queue:$name");
InternalTimer($now+$delay, $pFunc, "queue:$name");
$ioHash->{nextQueueRun} = $now+$delay;
}
else {
Log3 $name, 5, "$name: StartQueueTimer called from " . FhemCaller() .
@ -210,10 +211,10 @@ sub StopQueueTimer {
my $silent = $oRef->{'silent'} // 0;
my $name = $ioHash->{NAME};
if ($ioHash->{nextQueueRun}) {
RemoveInternalTimer ("queue:$name");
delete $ioHash->{nextQueueRun};
Log3 $name, 5, "$name: StopQueueTimer called from " . FhemCaller() .
' removes internal timer for queue processing' if (!$silent);
RemoveInternalTimer ("queue:$name");
delete $ioHash->{nextQueueRun};
}
return;
}
@ -317,9 +318,10 @@ sub EvalExpr {
# return the name of the caling function for debug output
sub FhemCaller {
my ($package, $filename, $line, $subroutine, $hasargs, $wantarray, $evaltext, $is_require, $hints, $bitmask, $hinthash) = caller 2;
return $1 if ($subroutine =~ /main::HTTPMOD_(.*)/);
return $1 if ($subroutine =~ /main::(.*)/);
return 'Fhem internal timer' if ($subroutine =~ /main::HandleTimeout/);
return $1 if ($subroutine =~ /main::HTTPMOD_(.*)/);
return $1 if ($subroutine =~ /main::Modbus_(.*)/);
return $1 if ($subroutine =~ /::(.*)/);
return "$subroutine";
}
@ -336,7 +338,7 @@ sub MapConvert {
my $reverse = $oRef->{'reverse'} // 0; # use reverse map
my $action = $oRef->{'action'} // 'apply map'; # context for logging
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 $name = $hash->{NAME};
return $inVal if (!$map); # don't change anyting if map is empty
@ -346,19 +348,19 @@ sub MapConvert {
$map =~ s/([^, ][^,\$]*):([^,][^,\$]*),? */$2:$1, /g; # reverse map
}
# spaces in words allowed, separator is ',' or ':'
my $val = decode ('UTF-8', $inVal); # convert nbsp from fhemweb
$val =~ s/\s|&nbsp;/ /g; # back to normal spaces in case it came from FhemWeb with coded Blank
my $val = $inVal // '';
#my $val = decode ('UTF-8', $inVal);
$val =~ s/\s|&nbsp;|(\xc2\xa0)/ /g; # back to normal spaces in case it came from FhemWeb with coded Blank
my %mapHash = split (/, *|:/, $map); # reverse hash aus dem reverse string
if (defined($mapHash{$val})) { # Eintrag für den übergebenen Wert in der Map?
my $newVal = $mapHash{$val}; # entsprechender Raw-Wert für das Gerät
Log3 $name, 5, "$name: MapConvert called from " . FhemCaller() . " converted $val to $newVal with" .
Log3 $name, 5, "$name: MapConvert called from " . FhemCaller() . " converted $val ($inVal) to $newVal with" .
($reverse ? " reversed" : "") . " map $map";
return $newVal;
}
else {
Log3 $name, 3, "$name: MapConvert called from " . FhemCaller() . " did not find $val in" .
Log3 $name, 3, "$name: MapConvert called from " . FhemCaller() . " did not find $val ($inVal) in" .
($reverse ? " reversed" : "") . " map $map";
return if ($UndefIfNoMatch);
return $inVal;
@ -409,12 +411,12 @@ sub CheckRange {
sub FormatVal {
my $hash = shift;
my $oRef = shift; # optional hash ref for passing options and variables for use in expressions
my $val = $oRef->{'val'} // ''; # input value
my $val = $oRef->{'val'}; # input value
my $format = $oRef->{'format'} // ''; # format string
my $name = $hash->{NAME};
return $val if (!$format);
my $newVal = sprintf($format, $val);
my $newVal = sprintf($format, $val // '');
Log3 $name, 5, "$name: FormatVal for " . FhemCaller() . " formats $val with $format, result is $newVal";
return $newVal;
}
@ -492,27 +494,45 @@ sub ManageUserAttr {
}
return $retVal;
}
# go through all possible attrs and check if the passed attr matches one of the regex attrs
foreach my $listAttr (split " ", $modHash->{AttrList}) {
my ($listAttrName, $listAttrHint)
= $listAttr =~ m{ \A ([^:]+) (:?.*) }xms; # split list entry in name and optional hint
if ($aName =~ m{\A$listAttrName\z}xms) { # yes - the passed attribute name now matches the entry in the list as regex
addToDevAttrList($name, $aName . $listAttrHint); # create userattr with hint to allow change in fhemweb
#Log3 $name, 5, "$name: ManageUserAttr added attr $aName to userattr list";
#Log3 $name, 5, "$name: ManageUserAttr for $aName called from " . FhemCaller(). ", userattr = " . ($attr{$name}{userattr} // '');
if ($listAttrHint) { # in case an earlier version added the attribute without the hint, remove old entry
my $uaList = $attr{$name}{userattr} // '';
my %uaHash;
foreach my $userAttr (split(" ", $uaList)) {
if ($userAttr !~ m{\A $aName \z}xms) { # no match -> existing entry in userattr list is attribute without hint
$uaHash{$userAttr} = 1; # put $userAttr as key into the hash so it is kept in userattr
}
else { # match -> in list without attr -> remove
#Log3 $name, 5, "$name: ManageUserAttr removes attr $userAttr without hint $listAttrHint from userattr list";
MODATTRLOOP: # find the corresponding attr in the modules attrlist
foreach my $listAttr (split " ", $modHash->{AttrList}) { # go through all possible attrs in the module's list and check if the passed attr matches one of the regex attrs
my ($listAttrName, $listAttrHint)
= $listAttr =~ m{ \A ([^:]+) (:?.*) }xms; # split module attr list entry in name and optional hint
if ($aName =~ m{\A$listAttrName\z}xms) { # yes - the passed attribute name now matches the entry in the list as regex
# found regex attr in modules list that belongs to $aName, saved in $listAttrName and $listAttrHint
my $uaList = $attr{$name}{userattr} // ''; # get the userAttr list
my %uaHash;
my $found = 0;
UALOOP:
foreach my $userAttr (split(" ", $uaList)) { # for every userAttr
my ($userAttrName, $userAttrHint)
= $userAttr =~ m{ \A ([^:]+) (:?.*) }xms; # split module attr list entry in name and optional hint
#Log3 $name, 5, "$name: ManageUserAttr compares userattr name $userAttrName with passed attr name $aName";
if ($userAttrName eq $aName) {
#Log3 $name, 5, "$name: ManageUserAttr compares hints from userattr $userAttrHint with hint from list $listAttrHint";
next UALOOP if (!$userAttrHint && !$listAttrHint); # no hints -> no need for userattr to sepcify a regex attr (new)
if ($userAttrHint && !$listAttrHint) {
$uaHash{$userAttr} = 1; # keep $userAttr with hint if module attr has no hint
#Log3 $name, 5, "$name: ManageUserAttr keeps userattr $userAttr with different hint";
} else {
$uaHash{$aName . $listAttrHint} = 1; # replace userAttr with attr from module list
#Log3 $name, 5, "$name: ManageUserAttr uses $aName$listAttrHint with hint from module attr list";
}
$found = 1;
} else {
$uaHash{$userAttr} = 1; # keep userattr with different names
#Log3 $name, 5, "$name: ManageUserAttr keeps other existing userattr $userAttr";
}
$attr{$name}{userattr} = join(" ", sort keys %uaHash);
}
if (!$found && $listAttrHint) { # add userAttr with attr from module list
$uaHash{$aName . $listAttrHint} = 1;
#Log3 $name, 5, "$name: ManageUserAttr adds $aName$listAttrHint";
}
$attr{$name}{userattr} = join(" ", sort keys %uaHash); # reconstruct userAttr list string
Log3 $name, 5, "$name: ManageUserAttr updated userattr list to $attr{$name}{userattr}";
}
}
return;
@ -723,9 +743,9 @@ sub FmtTimeMs {
my $time = shift // 0;
my $seconds;
my $mseconds;
if ($time =~ /([^\.]+)(\.(.*))?/) {
if ($time =~ /([^\.]+)(\.(.{0,3}))?/) {
$seconds = $1;
$mseconds = $3;
$mseconds = $2 // 0;
}
else {
$seconds = $time;
@ -737,7 +757,7 @@ sub FmtTimeMs {
my @t = localtime($seconds);
my $tim = sprintf("%02d:%02d:%02d", $t[2],$t[1],$t[0]);
$tim .= sprintf(".%03d", $mseconds);
$tim .= sprintf(".%03d", $mseconds * 1000);
return $tim;
}
@ -753,4 +773,108 @@ sub ReadableArray {
}
#####################################################
# collect statistics like number of requests / errors
# in a defined interval
sub Statistics {
my $hash = shift; # our device hash
my $key = shift; # the name / key of this statistic (e.g. requests or timeouts)
my $value = shift // 1; # if no value is passed, assume 1
my $name = $hash->{NAME};
my $pInterval = AttrVal($name, 'profileInterval', 0);
return if (!$pInterval);
my $now = gettimeofday();
my $pPeriod = int($now / $pInterval);
if (!defined ($hash->{statistics}{lastPeriod}) || ($pPeriod != $hash->{statistics}{lastPeriod})) {
readingsBeginUpdate($hash);
foreach my $k (keys %{$hash->{statistics}{sums}}) {
readingsBulkUpdate($hash, 'Statistics_' . $k, $hash->{statistics}{sums}{$k});
$hash->{statistics}{sums}{$k} = 0;
}
readingsEndUpdate($hash, 1);
$hash->{statistics}{sums}{$key} = $value;
$hash->{statistics}{lastPeriod} = $pPeriod;
}
else {
if ($hash->{statistics}{sums}{$key}) {
$hash->{statistics}{sums}{$key} += $value;
} else {
$hash->{statistics}{sums}{$key} = $value;
}
}
return;
}
##############################################################
# add up time used during certain activities
# like sending, waiting for a response or reading
sub Profiler {
my $hash = shift; # device hash
my $key = shift; # key / class name to use for profiling the following time period
return if (!$hash);
my $name = $hash->{NAME};
my $pInterval = AttrVal($name, 'profileInterval', 0);
return if (!$pInterval);
my $now = gettimeofday();
my $pPeriod = int($now / $pInterval);
if (!defined ($hash->{profiler}{lastKey})) { # initialize values at first call
$hash->{profiler}{lastKey} = $key;
$hash->{profiler}{lastPeriod} = $pPeriod;
$hash->{profiler}{start}{$key} = $now;
$hash->{profiler}{sums}{$key} = 0 ;
Log3 $name, 5, "$name: Profiling $key initialized, start $now";
return;
}
my $lKey = $hash->{profiler}{lastKey}; # save last key
my $lDiff = ($now - $hash->{profiler}{start}{$lKey}); # time diff for last key
$lDiff = 0 if (!$hash->{profiler}{start}{$lKey});
if (!$hash->{profiler}{start}{$key}) {
$hash->{profiler}{start}{$key} = $now; # save start time for new key
}
Log3 $name, 5, "$name: Profiling $key, before $lKey, now is $now, $key started at "
. $hash->{profiler}{start}{$key} . ", $lKey started at " . $hash->{profiler}{start}{$lKey};
if ($pPeriod != $hash->{profiler}{lastPeriod}) { # new period
my $overP = $now - ($pPeriod * $pInterval); # time over the pPeriod start
$overP = 0 if ($overP > $lDiff); # if interval was modified things get inconsistant ...
Log3 $name, 5, "$name: Profiling pPeriod changed, last pPeriod was " . $hash->{profiler}{lastPeriod} .
" now $pPeriod, total diff for $lKey is $lDiff, over $overP over the pPeriod";
Log3 $name, 5, "$name: Profiling add " . ($lDiff - $overP) . " to sum for $key";
$hash->{profiler}{sums}{$lKey} += ($lDiff - $overP);
readingsBeginUpdate($hash);
foreach my $k (keys %{$hash->{profiler}{sums}}) {
my $val = sprintf('%.2f', $hash->{profiler}{sums}{$k});
Log3 $name, 5, "$name: Profiling set reading for $k to $val";
readingsBulkUpdate($hash, 'Profiler_' . $k . '_sum', $val);
$hash->{profiler}{sums}{$k} = 0;
$hash->{profiler}{start}{$k} = 0;
}
readingsEndUpdate($hash, 1);
$hash->{profiler}{start}{$key} = $now;
$hash->{profiler}{sums}{$lKey} = $overP;
$hash->{profiler}{lastPeriod} = $pPeriod;
$hash->{profiler}{lastKey} = $key;
Log3 $name, 5, "$name: Profiling set new sum for $lKey to $overP";
}
else {
return if ($key eq $hash->{profiler}{lastKey}); # nothing new - take time when key or pPeriod changes
Log3 $name, 5, "$name: Profiling add $lDiff to sum for $lKey " .
"(now is $now, start for $lKey was $hash->{profiler}{start}{$lKey})";
$hash->{profiler}{sums}{$lKey} += $lDiff;
$hash->{profiler}{start}{$key} = $now;
$hash->{profiler}{lastKey} = $key;
}
return;
}
1;