Public/fhem-mirror
1
0
Fork 0
mirror of https://github.com/fhem/fhem-mirror.git synced 2025-05-04 22:19:38 +00:00
Code Issues Packages Projects Releases Wiki Activity

fhemdebug.pm: rewrote memusage to use size instead of total_size (Forum #73490)

Browse Source 
git-svn-id: https://svn.fhem.de/fhem/trunk/fhem@16014 2b470e98-0d58-463d-a4d8-8e2adae1ed80
This commit is contained in:
rudolfkoenig 2018-01-27 21:01:12 +00:00
parent 233a97a100
commit b0faa9e84e
1 changed files with 35 additions and 48 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

83
FHEM/98_fhemdebug.pm
View File

@ -107,67 +107,53 @@ fhemdebug_memusage($)
eval "use Devel::Size"; eval "use Devel::Size";
return $@ if($@); return $@ if($@);
my %bl = ("main::modules::MAX"=>1, HTTPMOD=>1, DbRep=>1);
$Devel::Size::warn = 0; $Devel::Size::warn = 0;
my @param = split(" ", $param); my @param = split(" ", $param);
my $max = 50; my $max = 50;
my $re; my $re;
$max = pop(@param) if(@param > 1 && $param[$#param] =~ m/^\d+$/); $max = pop(@param) if(@param > 1 && $param[$#param] =~ m/^\d+$/);
$re = pop(@param) if(@param > 1); $re = pop(@param) if(@param > 1);
my %ts; my %ts;
my $collectSize = sub($$$) my %mh = (defs=>1, modules=>1, selectlist=>1, attr=>1, readyfnlist=>1);
my $collectSize = sub($$$$)
{ {
my ($fn, $h, $mname) = @_; my ($fn, $h, $mname,$cleanUp) = @_;
return if($h->{__IN__CS__}); # save us from endless recursion return 0 if($h->{__IN__CS__}); # save us from endless recursion
return 0 if($h->{__IN__CSS__} && !$cleanUp);
$h->{__IN__CSS__} = 1 if(!$cleanUp);
$h->{__IN__CS__} = 1; $h->{__IN__CS__} = 1;
eval { my $sum = 0;
foreach my $n (keys %$h) { foreach my $n (sort keys %$h) {
next if(!$n || $n =~ m/^[^A-Za-z]$/); next if(!$n || $n =~ m/^[^A-Za-z]$/ || $n eq "__IN__CS__");
if($n =~ m/::$/) {
$fn->($fn, $h->{$n}, "$mname$n");
next;
}
next if(main->can("$mname$n")); # functions
if($mname eq "main::" && my $ref = ref $h->{$n};
($n eq "modules" || $n eq "defs" || $n eq "readyfnlist" || my $name = ($mname eq "main::" ? "$mname$n" : "${mname}::$n");
$n eq "selectlist" || $n eq "intAt" || $n eq "attr" || $ref = "HASH" if(!$ref && $mname eq "main::" && $mh{$n});
$n eq "ntfyHash")) { next if($n eq "main::" || $n eq "IODev" ||
for my $mn (keys %{$main::{$n}}) { $ref eq "CODE" || main->can("$mname$n"));
my $name = "$mname${n}::$mn"; Log 5, " CHECK $name / $mname / $n / $ref"; # Crash-debugging
if($mname eq "main::" && $n eq "defs" && $bl{$defs{$mn}{TYPE}}) { if($ref eq "HASH") {
Log 5, "$name TYPE on the blackList, skipping it"; $sum += $fn->($fn, $h->{$n}, $name, $cleanUp);
next;
}
if($bl{$name}) {
Log 5, "$name on the blackList, skipping it";
next;
}
Log 5, $name; # Crash-debugging
$ts{$name} = Devel::Size::total_size($main::{$n}{$mn});
}
} else { } else {
my $name = "$mname$n"; my $sz = Devel::Size::size($h->{$n});
if($bl{$name}) { $ts{$name} = $sz if(!$cleanUp);
Log 5, "$name (on the blackList, skipping it)"; $sum += $sz;
next;
}
Log 5, $name; # Crash-debugging
$ts{$name} = Devel::Size::total_size($h->{$n});
}
} }
}; }
delete $h->{__IN__CS__}; delete($h->{__IN__CS__});
Log 1, "collectSize $mname: $@" if($@); delete($h->{__IN__CSS__}) if($cleanUp);
$sum += Devel::Size::size($h);
$ts{$mname} = $sum if($mname ne "main::" && !$cleanUp);
return $sum;
}; };
$collectSize->($collectSize, \%main::, "main::"); $collectSize->($collectSize, \%main::, "main::", 0);
$collectSize->($collectSize, \%main::, "main::", 1);
my @sts = sort { $ts{$b} <=> $ts{$a} } keys %ts; my @sts = sort { $ts{$b} <=> $ts{$a} } keys %ts;
my @ret; my @ret;
for(my $i=0; $i < int(@sts); $i++) { for(my $i=0; $i < @sts; $i++) {
next if($re && $sts[$i] !~ m/$re/); next if($re && $sts[$i] !~ m/$re/);
push @ret, sprintf("%4d. %-30s %8d", $i+1,substr($sts[$i],6),$ts{$sts[$i]}); push @ret, sprintf("%4d. %-30s %8d", $i+1,substr($sts[$i],6),$ts{$sts[$i]});
last if(@ret >= $max); last if(@ret >= $max);
@ -206,13 +192,14 @@ fhemdebug_memusage($)
<ul> <ul>
<li>this function depends on the Devel::Size module, so this must be <li>this function depends on the Devel::Size module, so this must be
installed first.</li> installed first.</li>
<li>The used function Devel::Size::total_size crashes perl (and FHEM) for <li>The used function Devel::Size::size may crash perl (and FHEM) for
functions and some other data structures. memusage tries to avoid to functions and some other data structures. memusage tries to avoid to
call it for such data structures, but as the problem is not identified, 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 it may crash your currently running instance. It works for me, but make
sure you saved your fhem.cfg before calling it.</li> sure you saved your fhem.cfg before calling it.</li>
<li>The known data structures modules and defs are reported in more <li>To avoid the crash, the size of same data is not computed, so the
detail.</li> size reported is probably inaccurate, it should only be used as a hint.
</li>
</ul> </ul>
</li> </li>
</ul> </ul>