Optimierungsvorschlag "HandleTimeout()" in fhem.pl

[noansi]

Hallo Zusammen,

auf meinem Testsystem (RasPi2) hat sich mit der Erstimplementation immerhin schon mal die durchschnittliche Timerausführungsverzögerung von etwa mehr als 10ms auf 7,6 ms verringert. Nach wie vor ca. 140 Timer aktiv, aber das sollte in der Variante nicht so relevant sein.

Die Zeit für das Hinzufügen eines Timers, die ich mal statt der Sortierzeit messe, liegt zwischen 0,2 und  27,4ms (wobei ich davon ausgehe, dass das auch noch vom Speichermanagement beeinflusst ist).
Das log(n) Einfügen statt der linearen Suche werde ich wohl bei Gelegenheit mal einbauen.

Gruß, Ansgar.

[immi]

00_THZ.pm             RemoveInternalTimer nutzen -> kurzfristige Änderung zugesagt, nutzt Remove Erweiterung

00_THZ.pm fixed
frohe weihnachten
immi

[noansi]

Hallo Zusammen,

hier nun nochmal ein Update mit schnellem InternalTimer.
Mit der Konstanten UseIntAtA kann man zwischen altem Code und dem neuen wechseln. Allerdings darf man nicht das falsche apptime verwenden, sonst werden zuvor bestehende Timer mit der apptime Initialisierung nicht mehr abgearbeitet.
für fhem.pl:

Code Auswählen Erweitern


use vars qw($intAtA);           # Internal at timer hash, global for benchmark, new Version

#####################################
# Return the time to the next event (or undef if there is none)
# and call each function which was scheduled for this time

use constant UseIntAtA    => 1;   #do the code with @{$intAtA} instead of %intAt
use constant MinCoverWait => 0.0002474; # 0.01 by Rudolf, but it should be set only on systems that need it!?! Any way to discover?
                                        # it depends on execution times if timers run a little bit too early
use constant MinCoverExec => 0; #2; # look ahead to cope execution time of firing timers

sub
HandleTimeout()
{
if (UseIntAtA) {
  return undef if(!$nextat);
 
  my $now = gettimeofday();
  my $dtnext = $nextat-$now;
  if($dtnext > 0) { # Timer to handle?
    $selectTimestamp = $now;
    return $dtnext;
  }

  my ($t,$tim,$fn,$arg);
  $nextat = 0;
  while (defined($intAtA) and @{$intAtA}) {
    $tim = $intAtA->[0]->{TRIGGERTIME};
    $fn = $intAtA->[0]->{FN};
    if(!defined($fn) || !defined($tim)) { # clean up bad entries
      shift @{$intAtA};
      next;
    }
    if ($tim - $now > MinCoverWait) { # time to handle Timer for time of e.g. one character at 38400 at least
      $nextat = $tim; # execution time not reached yet
      last;
    }
    $t = shift @{$intAtA};
    $arg = $t->{ARG};

    no strict "refs";
    &{$fn}($arg); # this can delete a timer and can add a timer not covered by the current loops TRIGGERTIME sorted list
    use strict "refs";
  }

  if(%prioQueues) {
    my $nice = minNum(keys %prioQueues);
    my $entry = shift(@{$prioQueues{$nice}});
    delete $prioQueues{$nice} if(!@{$prioQueues{$nice}});

    &{$entry->{fn}}($entry->{arg});

    $nextat = 1 if(%prioQueues);
  }

  $now = gettimeofday(); # if some callbacks took longer
  $selectTimestamp = $now;

  return undef if !$nextat;
 
  $dtnext = $nextat-$now;
  return ($dtnext > 0) ? $dtnext : 0; # wait until next Timer needs to be handled
}
else {
  return undef if(!$nextat);

  my $now = gettimeofday();
  my $dtnext = $nextat-$now;
  if($dtnext > MinCoverWait) { # need to cover min delay at least
    $selectTimestamp = $now;
    return $dtnext;
  }

  my ($tim,$fn,$arg); # just for reuse in the loops
  $nextat = 0;
  #############
  # Check the internal list.
  foreach my $i ( sort {$intAt{$a}{TRIGGERTIME} <=> # O(n*log(n)) or worse, but only for the currently "firering" timers
                         $intAt{$b}{TRIGGERTIME} }
                    (grep {($intAt{$_}->{TRIGGERTIME}-$now) <= MinCoverExec} # just O(N)
                       keys(%intAt)) ) { # get the timers to execute due to timeout and sort just them ascending by time -> faster as normally about 1 to 5 timers may be timing out and xx-times more are waiting
    $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, but maybe they are a strange signal/flag?
      delete($intAt{$i});
      next;
    }
    if  (MinCoverExec > MinCoverWait) {
      if ($tim - gettimeofday() > MinCoverWait) {
        $nextat = $tim; # execution time not reached yet
        last;
      }
    }
    $arg = $intAt{$i}{ARG};
    no strict "refs";
    &{$fn}($arg); # this can delete a timer and can add a timer not covered by the current loops TRIGGERTIME sorted list
    use strict "refs";
    delete($intAt{$i});
  }

  foreach my $i (keys(%intAt)) { # find next timer to trigger, O(N-done) as we need to search all the unsorted rest
    $i = "" if(!defined($i)); # Forum #40598
    next if(!$intAt{$i}); # let the line above still work
    $tim = $intAt{$i}{TRIGGERTIME};
    $nextat = $tim if (   defined($tim)
                       && (   !$nextat # find the next time to trigger
                           || ($nextat > $tim) ) );
  }

  if(%prioQueues) {
    my $nice = minNum(keys %prioQueues);
    my $entry = shift(@{$prioQueues{$nice}});
    delete $prioQueues{$nice} if(!@{$prioQueues{$nice}});
    &{$entry->{fn}}($entry->{arg});
    $nextat = 1 if(%prioQueues);
  }

  $now = gettimeofday(); # if some callbacks took longer
  $selectTimestamp = $now;

  return undef if !$nextat;
 
  $dtnext = $nextat-$now;
  return ($dtnext > MinCoverWait) ? $dtnext : MinCoverWait; # need to cover min delay at least
}
}


#####################################
sub
addInternalTimer { # O(n) add, obsolet
  my ($tim, $fn, $arg) = @_;

  if (defined($intAtA) and @{$intAtA}) {
    my $i = 0;
    foreach (@{$intAtA}) {
      if ($tim < $intAtA->[$i]->{TRIGGERTIME}) {
        splice @{$intAtA}, $i, 0, {
                                   TRIGGERTIME => $tim,
                                   FN => $fn,
                                   ARG => $arg
                                  };
        return;
      };
      $i++;
    };
    $intAtA->[$i] = {
                     TRIGGERTIME => $tim,
                     FN => $fn,
                     ARG => $arg
                    };
    return;   
  } else {
    $intAtA->[0] = {
                    TRIGGERTIME => $tim,
                    FN => $fn,
                    ARG => $arg
                   };
    return;
  }
}
#####################################
sub
InternalTimer($$$;$)
{
if (UseIntAtA) {
  my ($tim, $fn, $arg, $waitIfInitNotDone) = @_;

  $tim = 1 if(!$tim);
  if(!$init_done && $waitIfInitNotDone) {
    select(undef, undef, undef, $tim-gettimeofday());
    no strict "refs";
    &{$fn}($arg);
    use strict "refs";
    return;
  }

  ### O(log(n)) add ###################
  my $i = defined($intAtA)?int(@{$intAtA}):0;

  if ($i) {
    my $t;
    my $ui = $i - 1;
    my $li = 0;
    while ($li <= $ui) {
      $i = int(($ui-$li)/2)+$li;
      $t = $intAtA->[$i]->{TRIGGERTIME};
      if ($tim >= $t) { # in upper half
        $li = ++$i;
      }
      else {            # in lower half
        $ui = $i-1;
      }
    }
    splice @{$intAtA}, $i, 0, { #insert or append new entry
                               TRIGGERTIME => $tim,
                               FN => $fn,
                               ARG => $arg
                              };
  } else { # array creation on first add
    $intAtA->[0] = {
                    TRIGGERTIME => $tim,
                    FN => $fn,
                    ARG => $arg
                   };
  }
  #####################################

  $nextat = $tim if(   !$nextat
                    || ($nextat > $tim) );
  return;
}
else {
  my ($tim, $fn, $arg, $waitIfInitNotDone) = @_;

  return if (!defined($fn));

  $tim = 1 if(!$tim);
  if(!$init_done && $waitIfInitNotDone) {
    select(undef, undef, undef, $tim-gettimeofday());
    no strict "refs";
    &{$fn}($arg);
    use strict "refs";
    return;
  }
  $intAt{$intAtCnt}{TRIGGERTIME} = $tim;
  $intAt{$intAtCnt}{FN} = $fn;
  $intAt{$intAtCnt}{ARG} = $arg;
  $intAtCnt++;
  $nextat = $tim if(   !$nextat
                    || ($nextat > $tim) );
}
}

sub
RemoveInternalTimer($;$)
{
if (UseIntAtA) {
  return if !defined($intAtA);
  my ($arg, $fn) = @_;
  my $i = 0;
  if ($fn) {
    if (defined($arg)) {
      my ($ia, $if);
      foreach my $a (@{$intAtA}) {
        ($ia, $if) = ($a->{ARG}, $a->{FN});
        splice @{$intAtA}, $i, 1 if(   defined($ia) && ($ia eq $arg)
                                    && defined($if) && ($if eq $fn) );
        $i++;
      }
    }
    else {
      my $if;
      foreach my $a (@{$intAtA}) {
        $if = $a->{FN};
        splice @{$intAtA}, $i, 1 if(defined($if) && ($if eq $fn)); #remove any timer with $fn function call
        $i++;
      }
    }
  }
  else {
    return if (!defined($arg));
    my $ia;
    foreach my $a (@{$intAtA}) {
      $ia = $a->{ARG};
      splice @{$intAtA}, $i, 1 if(defined($ia) && ($ia eq $arg)); #remove any timer with $arg argument
      $i++;
    }
  }
}
else {
  my ($arg, $fn) = @_;
  if ($fn) {
    if (defined($arg)) {
      foreach my $a (keys %intAt) {
        my ($ia, $if) = ($intAt{$a}{ARG}, $intAt{$a}{FN});
        delete($intAt{$a}) if(   defined($ia) && ($ia eq $arg)
                              && defined($if) && ($if eq $fn) );
      }
    }
    else {
      foreach my $a (keys %intAt) {
        my $if = $intAt{$a}{FN};
        delete($intAt{$a}) if(defined($if) && ($if eq $fn)); #remove any timer with $fn function call
      }
    }
  }
  else {
    return if (!defined($arg));
    foreach my $a (keys %intAt) {
      my $ia = $intAt{$a}{ARG};
      delete($intAt{$a}) if(defined($ia) && ($ia eq $arg)); #remove any timer with $arg argument
    }
  }
}
}


Und hier ein apptime dazu zum Testen und Zeit messen:

Code Auswählen Erweitern

################################################################
# 98_apptime:application timing
# $Id: 98_apptime.pm 14087f 2018-01-14 17:01:38Z noansi $
# based on $Id: 98_apptime.pm 14087 2017-04-23 13:45:38Z martinp876 $
################################################################

#####################################################
#
package main;

use strict;
use warnings;
use B qw(svref_2object);

use vars qw(%defs); # FHEM device/button definitions
use vars qw($intAtA);           # Internal at timer hash, global for benchmark, new Version
#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|<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;

use constant DEBUG_OUTPUT_INTATA => 0;

use constant MinCoverWait => 0.0002474; # 0.01 by Rudolf, but it should be set only on systems that need it!?! Any way to discover?
                                        # it depends on execution times if timers run a little bit too early


# @{$intAtA}
sub
HandleTimeout()
{
  return undef if(!$nextat);
 
  my $now = gettimeofday();
  my $dtnext = $nextat-$now;
  if($dtnext > 0) { # Timer to handle?
    $selectTimestamp = $now;
    return $dtnext;
  }

  my $handleStart = $now;

  $intatlen = defined($intAtA)?int(@{$intAtA}):0;
  $maxintatlen = $intatlen if ($maxintatlen < $intatlen);

  my $nd = 0;

  my ($t,$tim,$fn,$arg,$fnname,$shortarg,$cv);
  $nextat = 0;
  while (defined($intAtA) and @{$intAtA}) {
    $tim = $intAtA->[0]->{TRIGGERTIME};
    $fn = $intAtA->[0]->{FN};
    if(!defined($fn) || !defined($tim)) { # clean up bad entries
      shift @{$intAtA};
      next;
    }
    if ($tim - $now > MinCoverWait) { # time to handle Timer for time of e.g. one character at 38400 at least
      $nextat = $tim; # execution time not reached yet
      last;
    }
    $t = shift @{$intAtA};
    $arg = $t->{ARG};

    if (ref($fn) ne "") {
      $cv = svref_2object($fn);
      $fnname = $cv->GV->NAME;
    }
    else {
      $fnname = $fn;
    }
    $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++;
  }
 
  $maxintatdone = $nd if ($maxintatdone < $nd);
  $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 > 0) ? $dtnext : 0; # wait until next Timer needs to be handled
}

#####################################
sub
InternalTimer($$$;$)
{
  my ($tim, $fn, $arg, $waitIfInitNotDone) = @_;

  $tim = 1 if(!$tim);
  if(!$init_done && $waitIfInitNotDone) {
    select(undef, undef, undef, $tim-gettimeofday());
    no strict "refs";
    &{$fn}($arg);
    use strict "refs";
    return;
  }

  my $now = gettimeofday();

  ### O(log(n)) add ###################
  my $i = defined($intAtA)?int(@{$intAtA}):0;

  if ($i) {
    my $t;
    my $ui = $i - 1;
    my $li = 0;
    while ($li <= $ui) {
      $i = int(($ui-$li)/2)+$li;
      $t = $intAtA->[$i]->{TRIGGERTIME};
      if ($tim >= $t) { # in upper half
        $li = ++$i;
      }
      else {            # in lower half
        $ui = $i-1;
      }
    }
    splice @{$intAtA}, $i, 0, { #insert or append new entry
                               TRIGGERTIME => $tim,
                               FN => $fn,
                               ARG => $arg
                              };
  } else { # array creation on first add
    $intAtA->[0] = {
                    TRIGGERTIME => $tim,
                    FN => $fn,
                    ARG => $arg
                   };
  }

  if (DEBUG_OUTPUT_INTATA) {
    for ($i=0; $i < (int(@{$intAtA})-1); $i++) {
      next if ($intAtA->[$i]->{TRIGGERTIME} <= $intAtA->[$i+1]->{TRIGGERTIME});
      print "Error in $intAtA inserting $tim $fn\n";
      use Data::Dumper;
      print Data::Dumper->new([$intAtA],[qw($intAtA)])->Indent(1)->Quotekeys(1)->Dump;
      my $h = $intAtA->[$i]->{TRIGGERTIME};
      $intAtA->[$i]->{TRIGGERTIME} = $intAtA->[$i+1]->{TRIGGERTIME};
      $intAtA->[$i+1]->{TRIGGERTIME} = $h;
    }
  }
  #####################################

  my $intatsorttm += gettimeofday() - $now;
  $minintatsorttm = $intatsorttm if ($minintatsorttm > $intatsorttm);
  $maxintatsorttm = $intatsorttm if ($maxintatsorttm < $intatsorttm);

  $nextat = $tim if(   !$nextat
                    || ($nextat > $tim) );
  return;
};
#####################################
sub
RemoveInternalTimer($;$)
{
  return if !defined($intAtA);
  my ($arg, $fn) = @_;
  my $i = 0;
  if ($fn) {
    if (defined($arg)) {
      my ($ia, $if);
      foreach my $a (@{$intAtA}) {
        ($ia, $if) = ($a->{ARG}, $a->{FN});
        splice @{$intAtA}, $i, 1 if(   defined($ia) && ($ia eq $arg)
                                    && defined($if) && ($if eq $fn) );
        $i++;
      }
    }
    else {
      my $if;
      foreach my $a (@{$intAtA}) {
        $if = $a->{FN};
        splice @{$intAtA}, $i, 1 if(defined($if) && ($if eq $fn)); #remove any timer with $fn function call
        $i++;
      }
    }
  }
  else {
    return if (!defined($arg));
    my $ia;
    foreach my $a (@{$intAtA}) {
      $ia = $a->{ARG};
      splice @{$intAtA}, $i, 1 if(defined($ia) && ($ia eq $arg)); #remove any timer with $arg argument
      $i++;
    }
  }
}

#####################################
sub
CallFn(@) {
  my $d = shift;
  my $n = shift;

  if(!$d || !$defs{$d}) {
    $d = "<undefined>" if(!defined($d));
    Log 0, "Strange call for nonexistent $d: $n";
    return undef;
  }
  if(!$defs{$d}{TYPE}) {
    Log 0, "Strange call for typeless $d: $n";
    return undef;
  }
  my $fn = $modules{$defs{$d}{TYPE}}{$n};
  return "" if(!$fn);
 
  my $fnname;
  if (ref($fn) ne "") {
    my $cv = svref_2object($fn);
    $fnname = $cv->GV->NAME;
  }
  else {
    $fnname = $fn;
  }
  my @ret = apptime_getTiming($d,$fnname,$fn,0,@_);

  if(wantarray){return @ret;}
  else         {return $ret[0];}
}

sub apptime_getTiming($$$@) {
  my ($e,$fnName,$fn,$tim,@arg) = @_;
  my $h;
  my $tstart;
  if ($apptimeStatus){
    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 => -1000, dtotcnt => 0, dtot => 0,
                                          mTS => "");
   
      $h = $defs{$e}{helper}{bm}{$fnName};
    }
    else{
      $h = $defs{$e}{helper}{bm}{$fnName};
      $h->{cnt}++;
    }
    $tstart = gettimeofday();
  }

  no strict "refs";
  my @ret = &{$fn}(@arg);
  use strict "refs";

  if ($apptimeStatus){
    my $dtcalc = gettimeofday()-$tstart;
    if ($dtcalc && $h->{max} < $dtcalc){
      $h->{max} = $dtcalc;
      $h->{mAr} = @arg?\@arg:undef;
      $h->{mTS}= strftime("%d.%m. %H:%M:%S", localtime());
    }
    if ($tim > 1){
      $totCnt++;
      my $td = $tstart-$tim;
      $totDly    += $td;
      $totDly    = 0 if(!$totCnt);
      $h->{dtotcnt}++;
      $h->{dtot} += $td;
      $h->{dtot} = 0 if(!$h->{dtotcnt});
      $h->{dmx}  = $td if ($h->{dmx} < $td);
    }

    $h->{tot} += $dtcalc;
    $h->{tot} = 0 if(!$h->{cnt});
  }
  return @ret;
}

#####################################
sub apptime_CommandDispTiming($$@) {
  my ($cl,$param) = @_;
  my ($sFld,$top,$filter) = split" ",$param;
  $sFld = "max" if (!$sFld);
  $top = "top" if (!$top);
  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;
      $minTmrHandleTm = 1000000;
      $maxTmrHandleTm = 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} || !$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}})){
            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}*1000
                     ,$h->{cnt}
                     ,$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 = 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-timerinsertTm: %0.1fms; max-timerinsertTm: %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 %8d %10.2f %8.2f %8.2f %8.2f %-15s %s",@{$bmArr[$_]})for (0..$end);
  return $ret;
}

1;
=pod
=item command
=item summary    support to analyse function performance
=item summary_DE Unterst&uuml;tzung bei der Performanceanalyse von Funktionen
=begin html

<a name="apptime"></a>
<h3>apptime</h3>
<div style="padding-left: 2ex;">
  <h4><code>apptime</code></h4>
    <p>
        apptime provides information about application procedure execution time.
        It is designed to identify long running jobs causing latency as well as
        general high <abbr>CPU</abbr> usage jobs.
    </p>
    <p>
        No information about <abbr>FHEM</abbr> kernel times and delays will be provided.
    </p>
    <p>
        Once started, apptime  monitors tasks. User may reset counter during operation.
        apptime adds about 1% <abbr>CPU</abbr> load in average to <abbr>FHEM</abbr>.
    </p>
    <p>
        In order to remove apptime, <kbd>shutdown restart</kbd> is necessary.
    </p>
    <p>
        <strong>Features</strong>
    </P>
    <dl>
      <dt><code><kbd>apptime</kbd></code></dt>
        <dd>
            <p>
              <kbd>apptime</kbd> is started with the its first call and continously monitor operations.<br>
              To unload apptime, <kbd>shutdown restart</kbd> is necessary.<br> </li>
            </p>
        </dd>
      <dt><code><kbd>apptime clear</code></dt>
          <dd>
            <p>
                Reset all counter and start from zero.
            </p>
          </dd>
      <dt><code><kbd>apptime pause</code></dt>
          <dd>
            <p>
                Suspend accumulation of data. Data is not cleared.
            </p>
          </dd>
      <dt><code><kbd>apptime cont</code></dt>
          <dd>
            <p>
                Continue data collection after pause.
            </p>
          </dd>
      <dt><code><kbd>apptime [count|funktion|average|clear|max|name|total] [all]</kbd></code></dt>
        <dd>
            <p>
                Display a table sorted by the field selected.
            </p>
            <p>
                <strong><kbd>all</kbd></strong> will display the complete table while by default only the top lines are printed.<
            </p>
        </dd>
    </dl>
    <p>
        <strong>Columns:</strong>
    </p>
    <dl>
      <dt><strong>name</strong></dt>
        <dd>
            <p>
                Name of the entity executing the procedure.
            </p>
            <p>
                If it is a function called by InternalTimer the name starts with <var>tmr-</var>.
                By then it gives the name of the function to be called.
            </p>
        </dd>
      <dt><strong>function</strong><dt>
          <dd>
            <p>
                Procedure name which was executed.
            </p>
            <p>
                If it is an <var>InternalTimer</var> call it gives its calling parameter.
            </p>
          </dd>
      <dt><strong>max</strong></dt>
        <dd>
            <p>
                Longest duration measured for this procedure in <abbr>ms</abbr>.
            </p>
        </dd>
      <dt><strong>count</strong></dt>
        <dd>
            <p>
                Number of calls for this procedure.
            </p>
        </dt>
      <dt><strong>total</strong></dt>
        <dd>
            <p>
                Accumulated duration of this procedure over all calls monitored.
            </p>
        </dd>
      <dt><strong>average</strong></dt>
        <dd>
            <p>
                Average time a call of this procedure takes.
            </p>
        </dd>
      <dt><strong>maxDly</strong></dt>
        <dd>
            <p>
                Maximum delay of a timer call to its schedules time.
                This column is not relevant for non-timer calls.
            </p>
        </dd>
      <dt><strong>param Max call</strong></dt>
        <dd>
            <p>
                Gives the parameter of the call with the longest duration.
            </p>
        </dd>
    </dl>
</div>

=end html
=cut


@immi: Many thanks for your fast change of code! Merry Christmas!

Viele Grüße und frohe Weihnachten,

Ansgar.

EDIT: @Rudolf: Ich habe dem MinCoverWait zumindest mal einen Sinn im Bezug auf die Nutzung mit serieller Schnittstelle gegeben. Also der Versuch, nur so lange Timer abzuarbeiten, bis ein weiteres Zeichen über die Schnittstelle reingetrudelt sein könnte. Praktisch macht diese kurze Zeit wohl nur bei sehr wenigen Timern Sinn.
EDIT: Hier noch ein Testergebnis

Code Auswählen Erweitern

active-timers: 139; max-active timers: 174; max-timer-load: 3  min-tmrHandlingTm: 0.1ms; max-tmrHandlingTm: 151.4ms; totAvgDly: 6.7ms
min-timerinsertTm: 0.3ms; max-timerinsertTm: 11.9ms
Wegen des etwas größeren Aufwands beim Anlegen eines Timers ist die min Zeit etwas angestiegen, dafür die max-Zeit erwartungsgemäß nochmal deutlich zurück gegangen.
Außerdem ist auch die mittlere Verzögerung bei der Ausführung nochmal etwas zurück gegangen.
Wenn noch jemand magische perl Tricks kennt, mit denen das ganze noch etwas schneller geht, von mir aus gerne.
Und harren wir der Anpassung der verblieben Module. Ich habe aus der Liste betroffener Module eine Streichliste gemacht https://forum.fhem.de/index.php/topic,81365.msg734828.html#msg734828.
Und ich würde vorschlagen, erst mal diesen Stand umzusetzen, getreu Rudolfs Motto, nicht zu viel auf einmal, damit die Nebenwirkungen gezielter darauf zurück zu führen sind.

[immi]

Code Auswählen Erweitern

sub
RemoveInternalTimer($;$)
{
  my ($arg, $fn) = @_;
  return if(!$arg && !$fn);
  foreach my $a (keys %intAt) {
    delete($intAt{$a}) if((!$arg || $intAt{$a}{ARG} eq $arg) &&
                          (!$fn || $intAt{$a}{FN} eq $fn));
  }
}


Hi Rudolf
I am not sure how to use the new implementation above.

I want to delete all timers connected to function THZ_GetRefresh.

RemoveInternalTimer(undef, "THZ_GetRefresh");
or
RemoveInternalTimer(0, "THZ_GetRefresh");
or
RemoveInternalTimer($hash, "THZ_GetRefresh");


in the past I used directly following code in my module (no problems in the last 55 weeks)
THZ_RemoveInternalTimer("THZ_GetRefresh");

Code Auswählen Erweitern


...
sub THZ_RemoveInternalTimer($){
  my ($callingfun) = @_;
  foreach my $a (keys %intAt) {
    delete($intAt{$a}) if($intAt{$a}{FN} eq $callingfun);
  }
}


p.s.
I generate about 20 recurrent timers with
InternalTimer(gettimeofday() + ($timedelay) , "THZ_GetRefresh", \%par, 0);
For each timer \%par is different.

thanks
immi

[rudolfkoenig]

Your first two proposals should be equivalent with THZ_RemoveInternalTimer.

[immi]

danke rudolf
auguri e buon anno
immi

[noansi]

Hallo Zusammen,

ich habe oben https://forum.fhem.de/index.php/topic,81365.msg736160.html#msg736160 noch Rudolfs letzte Änderungen in RemoveInternalTimer sinngemäß eingearbeitet.

Die Streichliste https://forum.fhem.de/index.php/topic,81365.msg734828.html#msg734828 verharrt leider im Stillstand.
EDIT: Doch nicht. 98_Modbus.pm ist nun auch angepasst. Danke Stefan!

Gruß, Ansgar.

[Prof. Dr. Peter Henning]

Ich habe die Änderung in 95_Alarm.pm gemacht, das muss aber wegen der größerem Zahl an Nutzern noch ein paar Tage getestet werden.

LG

pah

[noansi]

Hallo Peter,

super! Danke, dass Du noch Zeit dafür gefunden hast!

Gruß, Ansgar.

[Prof. Dr. Peter Henning]

Ging nur, weil ich seit gestern mit einem üblen Virus mattgesetzt bin ...

LG

pah

[noansi]

Hallo Peter,

Ging nur, weil ich seit gestern mit einem üblen Virus mattgesetzt bin ...

Das ist allerdings kein schöner Anlass dazu.

Gute Besserung!

Gruß, Ansgar.

[rudolfkoenig]

@Ansgar: koenntest du bitte deine Zeitmessung (fuer InsertTimer/RemoveTimer/HandleTimer) fuer alt(hash)/neu(array) mit etwa den gleichen Anzahl von Elementen ausfuehren? Es waere interessant auch die Summe der Ausfuehrungszeiten und Dauer des Tests zu wissen. Ich habe Schwierigkeiten ein so langsames Testsystem mit so vielen Timern aufzustellen, wuesste aber gerne im Voraus, was die Aenderung bringt.

Ich zoegere noch die Array Variante einzubauen:
- InsertTimer wird langsamer. Beim normalen Ablauf ist #InsertTimer >= #HandleTimer, jedenfalls in den Faellen, wo HandleTimer rechnen muss.
- der Kode wird aufwendiger
- apptime + MilightBridge muss nachgezogen werden. THZ koennte man mit einem parallel gepflegten %intAt "begluecken", andere Problemfaelle habe ich nicht gesehen.

Ich kann dir schonmal gratulieren zum bisherigen Aufraeumergebnis

[Prof. Dr. Peter Henning]

Sieh mal an, Du gratulierst jemand anderem, wenn wir die Aufräumarbeiten erledigen   

LG

pah

[CoolTux]

Naja pah, eigentlich hast Du ja nur Deinen eigenen Code aufgeräumt 
Ansgar dagegen hat einen fremden Stall ausgemistet 



Grüße

[rudolfkoenig]

Sieh mal an, Du gratulierst jemand anderem, wenn wir die Aufräumarbeiten erledigen

Klar, er hat ja die Sache ins Rollen gebracht, und die Leute zum Arbeiten bewegt.
Man gratuliert ja auch anderswo dem Manager, auch wenn die Arbeit von anderen erledigt wird