Optimierungsvorschlag "HandleTimeout()" in fhem.pl

[herrmannj]

ich bin da skeptisch. Der callback ist von der Summe der Latenzen _aller_  module, notify, callbacks usw abhängig (gern genommen: > 1000 msec). Der war noch nie, niemals, auf die Millisekunde genau. Wieso sollen jetzt die 10 oder 2ms einen Unterschied machen ?

[StefanStrobel]

Hallo,

Bei Modbus gibt es keine harten Timing-Anforderungen, die eine schnelle Reaktion erfordern. Es geht mehr um die Performance oder darum dass Mindest-Wartezeiten nicht unterschritten werden. Bei einigen Geräten wollen die Benutzer viele (mehrere hundert) Werte alle 10 Sekunden abfragen. Wenn das dann nicht optimiert abläuft, dann reicht das im vorgegebenen Intervall nicht und die Send-Queue läuft über bzw. der Anwender muss das Intervall vergrößern. Deshalb sollten die Wartezeiten auch nicht unnötig lang sein.

Spannend wird das Thema Timeouts aber bei gleichzeitiger Nutzung vom Modbus-Modul-internen Intervall-Timer (Abfrage der Werte alle X Sekunden) und zusätzlichem Abfragen von Werten mit get. Die get-Abfragen sind synchron und blockieren Fhem, da Anwender einen Rückgabewert brauchen.

Wenn nun eine get-Abfrage reinkommt, aber das Modul bereits eine reguläre zyklische Abfrage an den Slave gesendet hat, dann soll der Kontrollfluss nicht unterbrochen werden, sonst gibt es keinen Rückgabewert für den get-Befehl.
Deshalb übernimmt in diesem Fall ReadAnswer das Warten / Lesen der ausstehenden Antwort und danach wird der Request für den get-Befehl gesendet und ebenfalls auf die Antwort gewartet.
Diese Übernahme eines ausstehenden ursprünglich asynchronen Requests ist der Punkt, an dem ich die restliche Wartezeit bis zum Timeout lese.

Code Auswählen Erweitern


    if ($ioHash->{BUSY}) {                              # Answer for last function code has not yet arrived
        Log3 $name, 5, "$name: Get: Queue is stil busy - taking over the read with ReadAnswer";
        ModbusLD_ReadAnswer($hash);                     # finish last read and wait for the result before next request
        Modbus_EndBUSY ($ioHash);                      # set BUSY to 0, delete REQUEST, clear Buffer, do Profilig
    }

    ModbusLD_Send($hash, $objCombi, "read", 0, 1);      # add at beginning of queue and force send / sleep if necessary
    ($err, $result) = ModbusLD_ReadAnswer($hash, $getName);
    Modbus_EndBUSY ($ioHash);                           # set BUSY to 0, delete REQUEST, clear Buffer, do Profilig


Ansgars Vorschlag, die Timer-Werte für einen Timeout redundant im Modul in einem Hash zu führen, ist vermutlich eine gute alternative Möglichkeit.
Da die Werte aber ohnehin von fhem.pl gespeichert werden, wäre ein Schnittstelle zum Abfragen der tatsächlichen Werte auf Dauer (meiner Meinung nach) schöner.
Ein internalTimer_TimeLeft($id) wäre dafür genau das Richtige. Eine solche Schnittstelle würde auch für künftige Modulautoren die Versuchung reduzieren, auf interne Daten zuzugreifen.
Alternativ muss sich das Modul eben die TRIGGERTIME selbst merken.

Gruss
   Stefan

[rudolfkoenig]

Die get-Abfragen sind synchron und blockieren Fhem, da Anwender einen Rückgabewert brauchen.

Ich implementiere in den neueren Modulen wie ZWave get asynchron, der Benutzer wird mit asyncOutput benachrichtigt. Benutzer-Scripte muessen notify verwenden.

[Prof. Dr. Peter Henning]

Zur gewünschten Änderung:

Bei 95_YAAHM.pm und 95_PostMe.pm ist das nur eine obsolete Zeile gewesen (irgendwie per Copy &  Paste übernommen), kein Problem.

Bei 95_Alarm.pm aber bedeutet das eine größere Änderung. Ich werde mir deswegen weder die Feiertage verderben, noch habe ich bis zum Abschluss meiner LEARNTEC Zeit dazu.
Also wird das nichts vor Mitte Februar.

Da das Modul von ca. 300 Leuten genutzt wird, muss die gewünschte Optimierung auf Wunsch Einzelner eben bis dahin warten.

LG

pah

[herrmannj]

eilt auch nicht. Du bist Ausrichter der LEARNTEC sehe ich. Spannend!

[StefanStrobel]

Hallo,

ich habe den Zugriff auf intAt im Modbus-Modul erst mal entfernt und statt dessen den Ablauf des Timeouts im Modul selbst gespeichert.
Die neue Version habe ich zum Testen gepostet: https://forum.fhem.de/index.php/topic,75638.45.html
Damit sollte das Modbus-Modul einer Optimierung nicht mehr im Weg stehen.
Wenn Roger es kurz testen kann und bestätigt, dass es keine neuen Probleme gibt, checke ich es ein.

Gruss
   Stefan

[noansi]

Hallo Stefan, hallo Rudolf,

vielen Dank für die schnelle Umsetzung.

Ich habe derweil im erste Beitrag apptime noch etwas viariiert, so dass apptime auch spezielle und totale  Durchschnittliche Timerverzögerung ausspuckt.
Auch meine letzter Anpassungsvorschlag zu HandleTimeout() ist da drin.
Ich denke das ist so eine gute Basis, um am Timer weiter zu kommen.

Bei mir sehe eine mittlere Timerverzögerung von etwas mehr als 10ms nach einem clear im "eingeschwungenen" Zustand.

Daran ändert auch $minCoverWait mit 0.01 nichts so dramatisches, außer dass ich auch mal negative Delays zu sehen bekomme.

EDIT: Natürlich sind die Delays mit Vorsicht zu betrachten, da auch gerne "InternalTime(gettimeofday()..."oder  "InternalTime(gettimeofday()+1..." darin einfließt was schon von der nachfolgenden Ausführungszeit beeinflusst wird.

Gruß, Ansgar.

[Prof. Dr. Peter Henning]

@herrmannj: Ausrichter nicht, aber seit 8 Jahren sozusagen Cheforganisator.

LG

pah

[herrmannj]

ich habe im Zuge meiner Beschäftigung mit bigbluebutton (das ist ja eigentlich ein e-learning system) gelernt das andere Länder da viel weiter sind (Kanada, in Teilen wohl auch US). Wird aber off-topic... trotzdem spannend.

[Prof. Dr. Peter Henning]

Kann ich so pauschal nicht bestätigen.

LG

pah

[noansi]

Hallo Rudolf,

Zitat

    immi benötigt das wohl bei THZ, um alle Timer seines Moduls auf einmal schnell los zu werden.

Ist noch nicht wirklich eine Erklaerung, ich habe mein Vorschlag mit RemoveInternalTimer aber eingebaut.

immi will die neue Remove Funktionalität morgen in THZ einbauen.

Gruß, Ansgar.

[noansi]

Hallo Rudolf,

ich habe mal in 95_Alarm etwas genauer hin geschaut.

Hier die Codestelle, die %intAt nutzt:

Code Auswählen Erweitern

         #-- deleting all running ats
         $dly = sprintf("alarm%1ddly",$level);
         foreach my $d (sort keys %intAt ) {
            next if( $intAt{$d}{FN} ne "at_Exec" );
            $mga = $intAt{$d}{ARG}{NAME};
            next if( $mga !~ /$dly\d/);
            #Log3 $hash,1,"[Alarm] Killing delayed action $name";
            CommandDelete(undef,"$mga");
         }


Peter will da bestimmte ats loswerden. Und die starten ihren Timer mit ihrem hash als Argument.

Diese spezielle Suche wird von RemoveInternalTimer nicht abgedeckt.

Macht es Sinn RemoveInternalTimer auf so was zu erweitern? Dann kommt der Nächste, der eine andere spezielle Suche benötigt!?!
Er bräuchte eher so was, wie "GetTimerSnapshot" mit einer aktuellen Kopie von %intAt als Rückgabewert um die durchsuchen zu können. So eine Funktion könnte man auch etwas vorfilternd gestalten.

Wenn es immer nur einen at_Exec Timer gleichtzeitig laufend gibt, könntest Du es auch in at mit einem ExecTimerRunning Flag unterstützen, so dass er alle ats durchsuchen könnte, statt %intAt.

Gruß, Ansgar.

[noansi]

Hallo Zusammen,

hier mal eine erste Implementierung nach herrmannjs Vorschlag. Mit der Konstanten UseIntAtA kann man zwischen beiden Varianten wechseln. Allerdings darf man nicht das falsche apptime verwenden, sonst werden alte 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


Damit vergesse ich es zumindestens nicht bis mitte Februar.

Gruß und frohes Fest,

Ansgar.

[rudolfkoenig]

Wg. dem %intAt Zugriff in Alarm.pm: ich verstehe noch nicht, warum man nicht eine Schleife ueber alle Geraete mit devspec2array macht.

[noansi]

Hallo Rudolf,

Wg. dem %intAt Zugriff in Alarm.pm: ich verstehe noch nicht, warum man nicht eine Schleife ueber alle Geraete mit devspec2array macht.

Und woher weiß die Schleife dann sicher, ob der jeweilige Timer aktiv ist (falls das relevant ist, so weit habe ich nicht geschaut, gehe aber davon aus, dass Peter sich was dabei gedacht hat)? Der Timer kann noch verspätet in der Timer-Warteschlange hängen. Ohne ein Flag, dass mit Timerstart gesetzt und in der Timerroutine zurück gesetzt wird, ist das unklar.

Gruß, Ansgar.