2
0
mirror of https://github.com/fhem/fhem-mirror.git synced 2025-03-10 03:06:37 +00:00

fhemdebug: add listTimer and addTimerStacktrace (Forum #87980)

git-svn-id: https://svn.fhem.de/fhem/trunk@16769 2b470e98-0d58-463d-a4d8-8e2adae1ed80
This commit is contained in:
rudolfkoenig 2018-05-24 09:45:32 +00:00
parent ef4168a1b8
commit b434ceea29
2 changed files with 77 additions and 17 deletions

View File

@ -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($)
<a name="fhemdebug"></a>
<h3>fhemdebug</h3>
<ul>
<code>fhemdebug {enable|disable|status|}</code><br>
<code>fhemdebug &lt;command&gt;</code><br>
<br>
where &lt;command&gt; is one of
<ul>
<li>enable/disable/status<br>
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.<br>
</li>
<li>memusage [regexp] [nr]<br>
Dump the name of the first nr datastructures with the largest memory
footprint. Filter the names by regexp, if specified.<br>
<b>Notes</b>:
<ul>
<li>this function depends on the Devel::Size module, so this must be
installed first.</li>
<li>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.</li>
<li>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.
</li>
<li>this function depends on the Devel::Size module, so this must be
installed first.</li>
<li>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.</li>
<li>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. </li>
</ul>
</li>
</li>
<li>timerList<br>
show the list of InternalTimer calls.
</li>
<li>addTimerStacktrace {1|0}<br>
enable or disable the registering the stacktrace of each InternalTimer
call. This stacktrace will be shown in the timerList command.
</li>
</ul>
</ul>

View File

@ -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