diff --git a/FHEM/98_apptime.pm b/FHEM/98_apptime.pm index d1d528c07..97296afc6 100644 --- a/FHEM/98_apptime.pm +++ b/FHEM/98_apptime.pm @@ -1,61 +1,152 @@ ################################################################ -# 98_apptime:application timing +# 98_apptime:application timing # $Id$ +# based on $Id$ ################################################################ ##################################################### -# +# package main; use strict; use warnings; +use B qw(svref_2object); use vars qw(%defs); # FHEM device/button definitions use vars qw(%intAt); use vars qw($nextat); +sub apptime_getTiming($$$@); sub apptime_Initialize($); + my $apptimeStatus; + sub apptime_Initialize($){ $apptimeStatus = 1;#set active by default $cmds{"apptime"}{Fn} = "apptime_CommandDispTiming"; - $cmds{"apptime"}{Hlp} = "[clear|] [top|all] [],application function calls and duration"; + $cmds{"apptime"}{Hlp} = "[clear||timer|nice] [top|all] [],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() { 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(); - return ($nextat-$now) if($now < $nextat); - - $now += 0.01;# need to cover min delay at least - $nextat = 0; - ############# - # 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); - } + my $dtnext = $nextat-$now; + if($dtnext > $minCoverWait) { # need to cover min delay at least + $selectTimestamp = $now; + return $dtnext; } - return undef if(!$nextat); - $now = gettimeofday(); # possibly some tasks did timeout in the meantime - # we will cover them - return ($now+ 0.01 < $nextat) ? ($nextat-$now) : 0.01; + my $handleStart = $now; + + ############# + # 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(@) { my $d = shift; @@ -72,7 +163,7 @@ sub CallFn(@) { } my $fn = $modules{$defs{$d}{TYPE}}{$n}; return "" if(!$fn); - + my @ret = apptime_getTiming($d,$fn,$fn,0,@_); if(wantarray){return @ret;} @@ -84,14 +175,15 @@ sub apptime_getTiming($$$@) { my $h; my $ts1; if ($apptimeStatus){ - if (!$defs{$e}{helper} || + if (!$defs{$e}{helper} || !$defs{$e}{helper}{bm} || !$defs{$e}{helper}{bm}{$fnName} ){ - + %{$defs{$e}{helper}{bm}{$fnName}} =(max => 0, mAr => "", cnt => 1, tot => 0, - dmx => 0, mTS => ""); - + dmx => -1000, dtotcnt => 0, dtot => 0, + mTS => ""); + $h = $defs{$e}{helper}{bm}{$fnName}; } else{ @@ -99,9 +191,15 @@ sub apptime_getTiming($$$@) { $h->{cnt}++; } $ts1 = gettimeofday(); - if ($tim){ - my $td = int(($ts1-$tim)*1000); - $h->{dmx} = $td if ($h->{dmx} < $td); + if ($tim > 1){ + my $td = $ts1-$tim; + $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"; if ($apptimeStatus){ - $ts1 = int((gettimeofday()-$ts1)*1000); + $ts1 = gettimeofday()-$ts1; if ($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->{tot} += $ts1; + $h->{tot} = 0 if(!$h->{cnt}); } return @ret; } @@ -128,68 +227,91 @@ sub apptime_CommandDispTiming($$@) { my ($sFld,$top,$filter) = split" ",$param; $sFld = "max" if (!$sFld); $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); - return "$sFld undefined field, use one of ".join(",",keys %fld) + 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) if(!defined $fld{$sFld}); my @bmArr; my @a = map{"$defs{$_}:$_"} keys (%defs); # prepare mapping hash 2 name $_ =~ s/[HASH\(\)]//g foreach(@a); - + if ($sFld eq "pause"){# no further collection of data, clear also $apptimeStatus = 0;#stop collecting data } elsif ($sFld eq "cont"){# no further collection of data, clear also $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) { next if(!$defs{$d}{helper}||!$defs{$d}{helper}{bm}); if ($sFld eq "clear"){ delete $defs{$d}{helper}{bm}; + $totDly = 0; + $totCnt = 0; + $maxintatlen = 0; + $maxintatdone = 0; + $minintatsorttm = 1000000; + $maxintatsorttm = 0; } elsif ($sFld =~ m/(pause|cont)/){ } else{ 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/); my ($n,$t) = ($d,$f); ($n,$t) = split(";",$f,2) if ($d eq "global"); $t = "" if (!defined $t); my $h = $defs{$d}{helper}{bm}{$f}; - + my $arg = ""; 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})){ ${$h->{mAr}}[$i] = "HASH(".${$h->{mAr}}[$i]->{NAME}.")"; } } $arg = join ("; ", map { $_ // "(undef)" } @{$h->{mAr}}); } - + push @bmArr,[($n,$t - ,$h->{max} + ,$h->{max}*1000 ,$h->{cnt} - ,$h->{tot} - ,$h->{tot} /$h->{cnt} - ,$h->{dmx} + ,$h->{tot}*1000 + ,($h->{cnt}?($h->{tot}/$h->{cnt})*1000:0) + ,(($h->{dmx}>-1000)?$h->{dmx}*1000:0) + ,($h->{dtotcnt}?($h->{dtot}/$h->{dtotcnt})*1000:0) ,$h->{mTS} ,$arg )]; } } } + + return "apptime initialized\n\nUse apptime ".$cmds{"apptime"}{Hlp} if ($maxTmrHandleTm < $minTmrHandleTm); + my $field = $fld{$sFld}; if ($field>1){@bmArr = sort { $b->[$field] <=> $a->[$field] } @bmArr;} else {@bmArr = sort { $b->[$field] cmp $a->[$field] } @bmArr;} - my $ret = ($apptimeStatus ? "" : "------ apptime PAUSED data collection ----------\n") - .sprintf("\n %-40s %-35s %6s %6s %8s %8s %6s %-15s %s", - "name","function","max","count","total","average","maxDly","TS Max call","param Max call"); - my $end = ($top && $top eq "top")?20:@bmArr-1; + my $ret = sprintf("active-timers: %d; max-active timers: %d; max-timer-load: %d ",$intatlen,$maxintatlen,$maxintatdone); + $ret .= sprintf("min-tmrHandlingTm: %0.1fms; max-tmrHandlingTm: %0.1fms; totAvgDly: %0.1fms\n",$minTmrHandleTm*1000,$maxTmrHandleTm*1000,($totCnt?$totDly/$totCnt*1000:0)); + $ret .= sprintf("min-timersortTm: %0.1fms; max-timersortTm: %0.1fms\n",$minintatsorttm*1000,$maxintatsorttm*1000); + $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); - $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; } @@ -272,7 +394,7 @@ sub apptime_CommandDispTiming($$@) { By then it gives the name of the function to be called.

-
funktion
+
function

Procedure name which was executed.