diff --git a/FHEM/98_fhemdebug.pm b/FHEM/98_fhemdebug.pm
index f1df7ebd7..f8ab9e2ff 100644
--- a/FHEM/98_fhemdebug.pm
+++ b/FHEM/98_fhemdebug.pm
@@ -40,8 +40,17 @@ fhemdebug_Fn($$)
} elsif($param =~ m/^memusage/) {
return fhemdebug_memusage($param);
+ } elsif($param =~ m/^timerList/) {
+ return fhemdebug_timerList($param);
+
+ } elsif($param =~ m/^addTimerStacktrace/) {
+ $param =~ s/addTimerStacktrace\s*//;
+ $addTimerStacktrace = $param;
+ return;
+
} else {
- return "Usage: fhemdebug {enable|disable|status|memusage}";
+ return "Usage: fhemdebug {enable | disable | status | memusage | ".
+ "timerList | addTimerStacktrace {0|1} }";
}
}
@@ -162,6 +171,21 @@ fhemdebug_memusage($)
return join("\n", @ret);
}
+sub
+fhemdebug_timerList($)
+{
+ my ($param) = @_;
+ my @res;
+
+ for my $h (@intAtA) {
+ my $tt = $h->{TRIGGERTIME};
+ push(@res, sprintf("%s.%05d %s%s",
+ FmtDateTime($tt), int(($tt-int($tt))*100000), $h->{FN},
+ $h->{STACKTRACE} ? $h->{STACKTRACE} : ""));
+ }
+ return join("\n", @res);
+}
+
1;
=pod
@@ -173,8 +197,9 @@ fhemdebug_memusage($)
fhemdebug
- fhemdebug {enable|disable|status|}
+ fhemdebug <command>
+ where <command> is one of
- enable/disable/status
fhemdebug produces debug information in the FHEM Log to help localize
@@ -186,23 +211,34 @@ fhemdebug_memusage($)
it is not recommended to enable it all the time. A FHEM restart after
disabling it is not necessary.
+
- memusage [regexp] [nr]
Dump the name of the first nr datastructures with the largest memory
footprint. Filter the names by regexp, if specified.
Notes:
- - this function depends on the Devel::Size module, so this must be
- installed first.
- - The used function Devel::Size::size may crash perl (and FHEM) for
- functions and some other data structures. memusage tries to avoid to
- call it for such data structures, but as the problem is not identified,
- it may crash your currently running instance. It works for me, but make
- sure you saved your fhem.cfg before calling it.
- - To avoid the crash, the size of same data is not computed, so the
- size reported is probably inaccurate, it should only be used as a hint.
-
+ - this function depends on the Devel::Size module, so this must be
+ installed first.
+ - The used function Devel::Size::size may crash perl (and FHEM) for
+ functions and some other data structures. memusage tries to avoid to
+ call it for such data structures, but as the problem is not
+ identified, it may crash your currently running instance. It works
+ for me, but make sure you saved your fhem.cfg before calling it.
+ - To avoid the crash, the size of same data is not computed, so the
+ size reported is probably inaccurate, it should only be used as a
+ hint.
-
+
+
+ - timerList
+ show the list of InternalTimer calls.
+
+
+ - addTimerStacktrace {1|0}
+ enable or disable the registering the stacktrace of each InternalTimer
+ call. This stacktrace will be shown in the timerList command.
+
+
diff --git a/fhem.pl b/fhem.pl
index e7ff6cd22..52cfdd561 100755
--- a/fhem.pl
+++ b/fhem.pl
@@ -259,6 +259,7 @@ use vars qw(@structChangeHist); # Contains the last 10 structural changes
use vars qw($haveInet6); # Using INET6
use vars qw(%prioQueues); #
use vars qw($fhemForked); # 1 in a fhemFork()'ed process, else undef
+use vars qw($addTimerStacktrace);# set to 1 by fhemdebug
$selectTimestamp = gettimeofday();
$cvsid = '$Id$';
@@ -351,10 +352,18 @@ $modules{Global}{AttrList} = join(" ", @globalAttrList);
$modules{Global}{AttrFn} = "GlobalAttr";
use vars qw($readingFnAttributes);
-$readingFnAttributes = "event-on-change-reading event-on-update-reading ".
- "event-aggregator event-min-interval ".
- "stateFormat:textField-long timestamp-on-change-reading ".
- "oldreadings";
+no warnings 'qw';
+my @attrList = qw(
+ event-aggregator
+ event-min-interval
+ event-on-change-reading
+ event-on-update-reading
+ oldreadings
+ stateFormat:textField-long
+ timestamp-on-change-reading
+);
+$readingFnAttributes = join(" ", @attrList);
+
my %ra = (
"suppressReading" => { s=>"\n" },
"event-aggregator" => { s=>",", c=>".attraggr" },
@@ -3151,6 +3160,7 @@ InternalTimer($$$;$)
$nextat = $tim if(!$nextat || $nextat > $tim);
my %h = (TRIGGERTIME=>$tim, FN=>$fn, ARG=>$arg, atNr=>++$intAtCnt);
+ $h{STACKTRACE} = stacktraceAsString(1) if($addTimerStacktrace);
$intAt{$h{atNr}} = \%h;
if(!@intAtA) {
@@ -3206,6 +3216,20 @@ stacktrace()
}
}
+sub
+stacktraceAsString($)
+{
+ my ($offset) = @_;
+ $offset = 1 if (!$offset);
+ my ($max_depth,$ret) = (50,"");
+
+ while( (my @call_details = (caller($offset++))) && ($offset<$max_depth) ) {
+ $call_details[3] =~ s/main:://;
+ $ret .= sprintf(" %s:%s", $call_details[3], $call_details[2]);
+ }
+ return $ret;
+}
+
my $inWarnSub;
sub