Commit 1dd38457 authored by Leigh Stoller's avatar Leigh Stoller

Small debugging function dump the object caches and how much memory

being used by the cached objects.
parent 6020eac5
#!/usr/bin/perl -w #!/usr/bin/perl -w
# #
# Copyright (c) 2000-2017 University of Utah and the Flux Group. # Copyright (c) 2000-2018 University of Utah and the Flux Group.
# #
# {{{EMULAB-LICENSE # {{{EMULAB-LICENSE
# #
...@@ -64,6 +64,32 @@ sub FlushCaches() ...@@ -64,6 +64,32 @@ sub FlushCaches()
%$ref = (); %$ref = ();
} }
} }
sub DumpCaches()
{
require Devel::Size;
my $total = 0;
foreach my $cache (@ourcaches) {
my $subtotal = 0;
my @values = values(%{$cache});
next
if (!@values);
print STDERR "Dumping cache:\n";
foreach my $ref (@values) {
my $size = Devel::Size::total_size($ref);
print STDERR " $ref: $size\n";
$subtotal += $size;
$total += $size;
}
my $realsize = Devel::Size::total_size($cache);
print STDERR "Cache total: $subtotal, $realsize\n";
}
if ($total) {
my $realsize = Devel::Size::total_size(\@ourcaches);
print STDERR "All caches total: $total, $realsize\n";
}
}
# #
# Support for checking field values against what is specified. # Support for checking field values against what is specified.
......
#!/usr/bin/perl -wT #!/usr/bin/perl -wT
# #
# Copyright (c) 2008-2017 University of Utah and the Flux Group. # Copyright (c) 2008-2018 University of Utah and the Flux Group.
# #
# {{{GENIPUBLIC-LICENSE # {{{GENIPUBLIC-LICENSE
# #
...@@ -208,6 +208,32 @@ sub FlushCaches() ...@@ -208,6 +208,32 @@ sub FlushCaches()
%$ref = (); %$ref = ();
} }
} }
sub DumpCaches()
{
require Devel::Size;
my $total = 0;
foreach my $cache (@ourcaches) {
my $subtotal = 0;
my @values = values(%{$cache});
next
if (!@values);
print STDERR "Dumping cache:\n";
foreach my $ref (@values) {
my $size = Devel::Size::total_size($ref);
print STDERR " $ref: $size\n";
$subtotal += $size;
$total += $size;
}
my $realsize = Devel::Size::total_size($cache);
print STDERR "Cache total: $subtotal, $realsize\n";
}
if ($total) {
my $realsize = Devel::Size::total_size(\@ourcaches);
print STDERR "All caches total: $total, $realsize\n";
}
}
# #
# Get me a UUID (universally unique identifier). Its really nice that there # Get me a UUID (universally unique identifier). Its really nice that there
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment