Public/fhem-mirror
1
0
Fork 0
mirror of https://github.com/fhem/fhem-mirror.git synced 2025-05-04 22:19:38 +00:00
Code Issues Packages Projects Releases Wiki Activity

apptime:update

Browse Source 
git-svn-id: https://svn.fhem.de/fhem/trunk/fhem@15720 2b470e98-0d58-463d-a4d8-8e2adae1ed80
This commit is contained in:
martinp876 2017-12-29 19:29:36 +00:00
parent 88e957f2ef
commit 35fa6a9eff
1 changed files with 180 additions and 58 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

238
FHEM/98_apptime.pm
View File

@ -1,61 +1,152 @@
################################################################ ################################################################
# 98_apptime:application timing # 98_apptime:application timing
# $Id$ # $Id$
# based on $Id$
################################################################ ################################################################
##################################################### #####################################################
# #
package main; package main;
use strict; use strict;
use warnings; use warnings;
use B qw(svref_2object);
use vars qw(%defs); # FHEM device/button definitions use vars qw(%defs); # FHEM device/button definitions
use vars qw(%intAt); use vars qw(%intAt);
use vars qw($nextat); use vars qw($nextat);
sub apptime_getTiming($$$@);
sub apptime_Initialize($); sub apptime_Initialize($);
my $apptimeStatus; my $apptimeStatus;
sub apptime_Initialize($){ sub apptime_Initialize($){
$apptimeStatus = 1;#set active by default $apptimeStatus = 1;#set active by default
$cmds{"apptime"}{Fn} = "apptime_CommandDispTiming"; $cmds{"apptime"}{Fn} = "apptime_CommandDispTiming";
$cmds{"apptime"}{Hlp} = "[clear|<field>] [top|all] [<filter>],application function calls and duration"; $cmds{"apptime"}{Hlp} = "[clear|<field>|timer|nice] [top|all] [<filter>],application function calls and duration";
} }
my $intatlen = 0;
my $maxintatlen = 0;
my $maxintatdone = 0;
my $minTmrHandleTm = 1000000;
my $maxTmrHandleTm = 0;
my $minintatsorttm = 1000000;
my $maxintatsorttm = 0;
my $totDly = 0;
my $totCnt = 0;
sub HandleTimeout() { sub HandleTimeout() {
return undef if(!$nextat); return undef if(!$nextat);
my $minCoverWait = 0.00; # 0.01 by Rudi, but it should be set only on systems that need it!?!
my $minCoverExec = 2; # look ahead due to execution time of firing timers
my $now = gettimeofday(); my $now = gettimeofday();
return ($nextat-$now) if($now < $nextat); my $dtnext = $nextat-$now;
if($dtnext > $minCoverWait) { # need to cover min delay at least
$now += 0.01;# need to cover min delay at least $selectTimestamp = $now;
$nextat = 0; return $dtnext;
#############
# Check the internal list.
foreach my $i (sort { $intAt{$a}{TRIGGERTIME} <=>
$intAt{$b}{TRIGGERTIME} } keys %intAt) {
my $tim = $intAt{$i}{TRIGGERTIME};
my $fn = $intAt{$i}{FN};
if(!defined($tim) || !defined($fn)) {
delete($intAt{$i});
next;
} elsif($tim <= $now) {
my $arg = $intAt{$i}{ARG};
$arg = "" if (!$arg);
apptime_getTiming("global","tmr-".$fn.";".$arg,$fn,$tim,$arg);
delete($intAt{$i});
} else {
$nextat = $tim if(!$nextat || $nextat > $tim);
}
} }
return undef if(!$nextat); my $handleStart = $now;
$now = gettimeofday(); # possibly some tasks did timeout in the meantime
# we will cover them #############
return ($now+ 0.01 < $nextat) ? ($nextat-$now) : 0.01; # Check the internal list.
my @intAtKeys = keys(%intAt);
my @intAtSort = (sort {$intAt{$a}{TRIGGERTIME} <=>
$intAt{$b}{TRIGGERTIME} }
(grep {($intAt{$_}->{TRIGGERTIME}-$now) <= $minCoverExec}
@intAtKeys)); # get the timers to execute due to timeout and sort ascending by time
my $intatsorttm = gettimeofday()-$now;
$intatlen = int(@intAtKeys);
$maxintatlen = $intatlen if ($maxintatlen < $intatlen);
my $nd = 0;
my ($tim,$fn,$arg,$fnname,$shortarg,$cv);
$nextat = 0;
foreach my $i (@intAtSort) {
$i = "" if(!defined($i)); # Forum #40598
next if(!$intAt{$i}); # deleted in the loop
$tim = $intAt{$i}{TRIGGERTIME};
$fn = $intAt{$i}{FN};
if(!defined($fn) || !defined($tim)) { # clean up bad entries
delete($intAt{$i});
next;
}
if ($tim - gettimeofday() > $minCoverWait) {
$nextat = $tim; # execution time not reached yet
last;
}
$arg = $intAt{$i}{ARG};
$fnname = $fn;
if (ref($fn) ne "") {
$cv = svref_2object($fn);
$fnname = $cv->GV->NAME;
}
$shortarg = (defined($arg)?$arg:"");
$shortarg = "HASH_unnamed" if ( (ref($shortarg) eq "HASH")
&& !defined($shortarg->{NAME}) );
($shortarg,undef) = split(/:|;/,$shortarg,2); # for special long args with delim ;
apptime_getTiming("global","tmr-".$fnname.";".$shortarg, $fn, $tim, $arg); # this can delete a timer and can add a timer not covered by the current loops TRIGGERTIME sorted list
$nd++;
delete($intAt{$i});
}
$maxintatdone = $nd if ($maxintatdone < $nd);
$now = gettimeofday();
foreach my $i (keys(%intAt)) { #(keys(%intAt)) (@intAtKeys)
$i = "" if(!defined($i)); # Forum #40598
next if(!$intAt{$i}); # deleted in the loop
$tim = $intAt{$i}{TRIGGERTIME};
$nextat = $tim if ( defined($tim)
&& ( !$nextat # find the next time to trigger
|| ($nextat > $tim) ) );
}
$intatsorttm += gettimeofday() - $now;
$minintatsorttm = $intatsorttm if ($minintatsorttm > $intatsorttm);
$maxintatsorttm = $intatsorttm if ($maxintatsorttm < $intatsorttm);
$now = gettimeofday();
if(%prioQueues) {
my $nice = minNum(keys %prioQueues);
my $entry = shift(@{$prioQueues{$nice}});
delete $prioQueues{$nice} if(!@{$prioQueues{$nice}});
$cv = svref_2object($entry->{fn});
$fnname = $cv->GV->NAME;
$shortarg = (defined($entry->{arg})?$entry->{arg}:"");
$shortarg = "HASH_unnamed" if ( (ref($shortarg) eq "HASH")
&& !defined($shortarg->{NAME}) );
($shortarg,undef) = split(/:|;/,$shortarg,2);
apptime_getTiming("global","nice-".$fnname.";".$shortarg, $entry->{fn}, $now, $entry->{arg});
$nextat = 1 if(%prioQueues);
}
$now = gettimeofday(); # if some callbacks took longer
$selectTimestamp = $now;
$handleStart = $now - $handleStart;
$minTmrHandleTm = $handleStart if ($minTmrHandleTm > $handleStart);
$maxTmrHandleTm = $handleStart if ($maxTmrHandleTm < $handleStart);
return undef if !$nextat;
$dtnext = $nextat-$now;
return ($dtnext > $minCoverWait) ? $dtnext : $minCoverWait; # need to cover min delay at least
} }
sub CallFn(@) { sub CallFn(@) {
my $d = shift; my $d = shift;
@ -72,7 +163,7 @@ sub CallFn(@) {
} }
my $fn = $modules{$defs{$d}{TYPE}}{$n}; my $fn = $modules{$defs{$d}{TYPE}}{$n};
return "" if(!$fn); return "" if(!$fn);
my @ret = apptime_getTiming($d,$fn,$fn,0,@_); my @ret = apptime_getTiming($d,$fn,$fn,0,@_);
if(wantarray){return @ret;} if(wantarray){return @ret;}
@ -84,14 +175,15 @@ sub apptime_getTiming($$$@) {
my $h; my $h;
my $ts1; my $ts1;
if ($apptimeStatus){ if ($apptimeStatus){
if (!$defs{$e}{helper} || if (!$defs{$e}{helper} ||
!$defs{$e}{helper}{bm} || !$defs{$e}{helper}{bm} ||
!$defs{$e}{helper}{bm}{$fnName} ){ !$defs{$e}{helper}{bm}{$fnName} ){
%{$defs{$e}{helper}{bm}{$fnName}} =(max => 0, mAr => "", %{$defs{$e}{helper}{bm}{$fnName}} =(max => 0, mAr => "",
cnt => 1, tot => 0, cnt => 1, tot => 0,
dmx => 0, mTS => ""); dmx => -1000, dtotcnt => 0, dtot => 0,
mTS => "");
$h = $defs{$e}{helper}{bm}{$fnName}; $h = $defs{$e}{helper}{bm}{$fnName};
} }
else{ else{
@ -99,9 +191,15 @@ sub apptime_getTiming($$$@) {
$h->{cnt}++; $h->{cnt}++;
} }
$ts1 = gettimeofday(); $ts1 = gettimeofday();
if ($tim){ if ($tim > 1){
my $td = int(($ts1-$tim)*1000); my $td = $ts1-$tim;
$h->{dmx} = $td if ($h->{dmx} < $td); $totCnt++;
$totDly += $td;
$totDly = 0 if(!$totCnt);
$h->{dtotcnt}++;
$h->{dtot} += $td;
$h->{dtot} = 0 if(!$h->{dtotcnt});
$h->{dmx} = $td if ($h->{dmx} < $td);
} }
} }
@ -110,14 +208,15 @@ sub apptime_getTiming($$$@) {
use strict "refs"; use strict "refs";
if ($apptimeStatus){ if ($apptimeStatus){
$ts1 = int((gettimeofday()-$ts1)*1000); $ts1 = gettimeofday()-$ts1;
if ($ts1 && $h->{max} < $ts1){ if ($ts1 && $h->{max} < $ts1){
$h->{max} = $ts1; $h->{max} = $ts1;
$h->{mAr} = \@arg; $h->{mAr} = @arg?\@arg:undef;
$h->{mTS}= strftime("%d.%m. %H:%M:%S", localtime()); $h->{mTS}= strftime("%d.%m. %H:%M:%S", localtime());
} }
$h->{tot} += $ts1; $h->{tot} += $ts1;
$h->{tot} = 0 if(!$h->{cnt});
} }
return @ret; return @ret;
} }
@ -128,68 +227,91 @@ sub apptime_CommandDispTiming($$@) {
my ($sFld,$top,$filter) = split" ",$param; my ($sFld,$top,$filter) = split" ",$param;
$sFld = "max" if (!$sFld); $sFld = "max" if (!$sFld);
$top = "top" if (!$top); $top = "top" if (!$top);
my %fld = (name=>0,funktion=>1,max=>2,count=>3,total=>4,average=>5,maxDly=>6,cont=>98,pause=>98,clear=>99); my %fld = (name=>0,function=>1,max=>2,count=>3,total=>4,average=>5,maxDly=>6,avgDly=>7,cont=>98,pause=>98,clear=>99,timer=>2,nice=>2);
return "$sFld undefined field, use one of ".join(",",keys %fld) return "$sFld undefined field, use one of ".join(",",keys %fld)
if(!defined $fld{$sFld}); if(!defined $fld{$sFld});
my @bmArr; my @bmArr;
my @a = map{"$defs{$_}:$_"} keys (%defs); # prepare mapping hash 2 name my @a = map{"$defs{$_}:$_"} keys (%defs); # prepare mapping hash 2 name
$_ =~ s/[HASH\(\)]//g foreach(@a); $_ =~ s/[HASH\(\)]//g foreach(@a);
if ($sFld eq "pause"){# no further collection of data, clear also if ($sFld eq "pause"){# no further collection of data, clear also
$apptimeStatus = 0;#stop collecting data $apptimeStatus = 0;#stop collecting data
} }
elsif ($sFld eq "cont"){# no further collection of data, clear also elsif ($sFld eq "cont"){# no further collection of data, clear also
$apptimeStatus = 1;#continue collecting data $apptimeStatus = 1;#continue collecting data
} }
elsif ($sFld eq "timer"){
$sFld = "max";
$filter = defined($filter)?$filter:"";
$filter = "\^tmr-.*".$filter if ($filter !~ /^\^tmr-/);
}
elsif ($sFld eq "nice"){
$sFld = "max";
$filter = defined($filter)?$filter:"";
$filter = "\^nice-.*".$filter if ($filter !~ /^\^nice-/);
}
foreach my $d (sort keys %defs) { foreach my $d (sort keys %defs) {
next if(!$defs{$d}{helper}||!$defs{$d}{helper}{bm}); next if(!$defs{$d}{helper}||!$defs{$d}{helper}{bm});
if ($sFld eq "clear"){ if ($sFld eq "clear"){
delete $defs{$d}{helper}{bm}; delete $defs{$d}{helper}{bm};
$totDly = 0;
$totCnt = 0;
$maxintatlen = 0;
$maxintatdone = 0;
$minintatsorttm = 1000000;
$maxintatsorttm = 0;
} }
elsif ($sFld =~ m/(pause|cont)/){ elsif ($sFld =~ m/(pause|cont)/){
} }
else{ else{
foreach my $f (sort keys %{$defs{$d}{helper}{bm}}) { foreach my $f (sort keys %{$defs{$d}{helper}{bm}}) {
next if(!defined $defs{$d}{helper}{bm}{$f}{cnt}); next if(!defined $defs{$d}{helper}{bm}{$f}{cnt} || !$defs{$d}{helper}{bm}{$f}{cnt});
next if($filter && $d !~ m/$filter/ && $f !~ m/$filter/); next if($filter && $d !~ m/$filter/ && $f !~ m/$filter/);
my ($n,$t) = ($d,$f); my ($n,$t) = ($d,$f);
($n,$t) = split(";",$f,2) if ($d eq "global"); ($n,$t) = split(";",$f,2) if ($d eq "global");
$t = "" if (!defined $t); $t = "" if (!defined $t);
my $h = $defs{$d}{helper}{bm}{$f}; my $h = $defs{$d}{helper}{bm}{$f};
my $arg = ""; my $arg = "";
if ($h->{mAr} && scalar(@{$h->{mAr}})){ if ($h->{mAr} && scalar(@{$h->{mAr}})){
foreach my $i (0..scalar(@{$h->{mAr}})){ foreach my $i (0..scalar(@{$h->{mAr}})){
if(ref(${$h->{mAr}}[$i]) eq 'HASH' and exists(${$h->{mAr}}[$i]->{NAME})){ if(ref(${$h->{mAr}}[$i]) eq 'HASH' and exists(${$h->{mAr}}[$i]->{NAME})){
${$h->{mAr}}[$i] = "HASH(".${$h->{mAr}}[$i]->{NAME}.")"; ${$h->{mAr}}[$i] = "HASH(".${$h->{mAr}}[$i]->{NAME}.")";
} }
} }
$arg = join ("; ", map { $_ // "(undef)" } @{$h->{mAr}}); $arg = join ("; ", map { $_ // "(undef)" } @{$h->{mAr}});
} }
push @bmArr,[($n,$t push @bmArr,[($n,$t
,$h->{max} ,$h->{max}*1000
,$h->{cnt} ,$h->{cnt}
,$h->{tot} ,$h->{tot}*1000
,$h->{tot} /$h->{cnt} ,($h->{cnt}?($h->{tot}/$h->{cnt})*1000:0)
,$h->{dmx} ,(($h->{dmx}>-1000)?$h->{dmx}*1000:0)
,($h->{dtotcnt}?($h->{dtot}/$h->{dtotcnt})*1000:0)
,$h->{mTS} ,$h->{mTS}
,$arg ,$arg
)]; )];
} }
} }
} }
return "apptime initialized\n\nUse apptime ".$cmds{"apptime"}{Hlp} if ($maxTmrHandleTm < $minTmrHandleTm);
my $field = $fld{$sFld}; my $field = $fld{$sFld};
if ($field>1){@bmArr = sort { $b->[$field] <=> $a->[$field] } @bmArr;} if ($field>1){@bmArr = sort { $b->[$field] <=> $a->[$field] } @bmArr;}
else {@bmArr = sort { $b->[$field] cmp $a->[$field] } @bmArr;} else {@bmArr = sort { $b->[$field] cmp $a->[$field] } @bmArr;}
my $ret = ($apptimeStatus ? "" : "------ apptime PAUSED data collection ----------\n") my $ret = sprintf("active-timers: %d; max-active timers: %d; max-timer-load: %d ",$intatlen,$maxintatlen,$maxintatdone);
.sprintf("\n %-40s %-35s %6s %6s %8s %8s %6s %-15s %s", $ret .= sprintf("min-tmrHandlingTm: %0.1fms; max-tmrHandlingTm: %0.1fms; totAvgDly: %0.1fms\n",$minTmrHandleTm*1000,$maxTmrHandleTm*1000,($totCnt?$totDly/$totCnt*1000:0));
"name","function","max","count","total","average","maxDly","TS Max call","param Max call"); $ret .= sprintf("min-timersortTm: %0.1fms; max-timersortTm: %0.1fms\n",$minintatsorttm*1000,$maxintatsorttm*1000);
my $end = ($top && $top eq "top")?20:@bmArr-1; $ret .= ($apptimeStatus ? "" : "------ apptime PAUSED data collection ----------\n")
.sprintf("\n %-40s %-35s %6s %8s %10s %8s %8s %8s %-15s %s",
"name","function","max","count","total","average","maxDly","avgDly","TS Max call","param Max call");
my $end = ($top && $top eq "top")?40:@bmArr-1;
$end = @bmArr-1 if ($end>@bmArr-1); $end = @bmArr-1 if ($end>@bmArr-1);
$ret .= sprintf("\n %-40s %-35s %6d %6d %8d %8.2f %6d %-15s %s",@{$bmArr[$_]})for (0..$end); $ret .= sprintf("\n %-40s %-35s %6d %8d %10.2f %8.2f %8.2f %8.2f %-15s %s",@{$bmArr[$_]})for (0..$end);
return $ret; return $ret;
} }
@ -272,7 +394,7 @@ sub apptime_CommandDispTiming($$@) {
By then it gives the name of the function to be called. By then it gives the name of the function to be called.
</p> </p>
</dd> </dd>
<dt><strong>funktion</strong><dt> <dt><strong>function</strong><dt>
<dd> <dd>
<p> <p>
Procedure name which was executed. Procedure name which was executed.