From: Eric Wong <e@80x24.org>
To: mwrap-perl@80x24.org
Subject: [PATCH] psgi: show live bytes, fix bold in sort column
Date: Sun, 3 Oct 2021 08:33:43 +0000 [thread overview]
Message-ID: <20211003083343.14623-1-e@80x24.org> (raw)
---
lib/Devel/Mwrap/PSGI.pm | 28 ++++++++++++++++------------
1 file changed, 16 insertions(+), 12 deletions(-)
diff --git a/lib/Devel/Mwrap/PSGI.pm b/lib/Devel/Mwrap/PSGI.pm
index b6e660c..c94d136 100644
--- a/lib/Devel/Mwrap/PSGI.pm
+++ b/lib/Devel/Mwrap/PSGI.pm
@@ -39,13 +39,14 @@ sub uri_unescape {
$str;
}
-my @COLS = qw(total allocations frees mean_life max_life location);
-my $HDR = '<tr><th>' . join('</th><th>', @COLS) . '</th></tr>';
-my @FIELDS = qw(total allocations frees mean_life max_life location);
+my @FIELDS = qw(total allocations frees live mean_life max_life location);
+my $HDR = '<tr><th>' . join('</th><th>', @FIELDS) . '</th></tr>';
sub accumulate_i { # callback for Devel::Mwrap::each
my ($all, $src_loc) = @_;
- push @$all, [ $src_loc->total, $src_loc->allocations, $src_loc->frees,
+ my $alloc = $src_loc->allocations;
+ my $frees = $src_loc->frees;
+ push @$all, [ $src_loc->total, $alloc, $frees, $alloc - $frees,
$src_loc->mean_lifespan, $src_loc->max_lifespan,
$src_loc->name ];
}
@@ -73,13 +74,14 @@ sub each_gt {
my @f = @FIELDS;
my $sc = 0;
for (my $i = 0; $i <= $#FIELDS; $i++) {
- next if $FIELDS[$i] ne $sort;
- $sc = $i;
- last;
+ if ($FIELDS[$i] eq $sort) {
+ $sc = $i;
+ last;
+ }
}
$f[$sc] = "<b>$f[$sc]</b>";
@f = (join('</th><th>', map {;
- if (/\A<b>/) {
+ if (substr($_, 0, 1) eq '<') {
$_;
} else {
qq(<a\nhref="$sn/each/$min?sort=$_">$_</a>);
@@ -89,16 +91,17 @@ sub each_gt {
Devel::Mwrap::each($min, \&accumulate_i, \@all);
@all = sort { $b->[$sc] <=> $a->[$sc] } @all;
my $age = Devel::Mwrap::current_age();
+ my $live = $age - Devel::Mwrap::total_bytes_freed();
print $fh <<EOM;
<html><head><title>$t</title></head><body><h1>$t</h1>
-<h2>Current age: $age</h2>
+<h2>Current age: $age (live: $live)</h2>
<table><tr><th>@f</th></tr>
EOM
while (my $cols = shift @all) {
# cols: [ total, allocations, frees, mean_lifespan,
# max_lifespan, name ]
my $loc_name = pop @$cols;
- $cols->[3] = sprintf('%0.3f', $cols->[3]); # mean_life
+ $cols->[4] = sprintf('%0.3f', $cols->[4]); # mean_life
my $href = "$sn/at/".uri_escape($loc_name);
print $fh '<tr><td>', join('</td><td>', @$cols),
qq(<td><a\nhref="),
@@ -120,9 +123,10 @@ sub each_at {
my $t = encode_html($src_loc->name);
open my $fh, '+>', undef or die "open: $!";
my $age = Devel::Mwrap::current_age();
+ my $live = $age - Devel::Mwrap::total_bytes_freed();
print $fh <<EOM;
<html><head><title>$t</title></head><body><h1>live allocations at $t</h1>
-<h2>Current age: $age</h2>\n<table>
+<h2>Current age: $age (live: $live)</h2>\n<table>
<tr><th>size</th><th>generation</th></tr>
EOM
$src_loc->each(0, \&each_at_i, $fh);
@@ -151,7 +155,7 @@ sub call { # PSGI entry point
my $ret;
if ($path_info =~ m!\A/each/([0-9]+)\z!) {
my $min = $1 + 0;
- my ($sort) = ($env->{QUERY_STRING} =~ /\bsort=([a-z+])\b/);
+ my ($sort) = ($env->{QUERY_STRING} =~ /\bsort=([a-z]+)\b/);
$ret = each_gt($env, $min, $sort);
} elsif ($path_info =~ m!\A/at/(.*)\z!) {
my $src_loc = Devel::Mwrap::get(uri_unescape($1));
reply other threads:[~2021-10-03 8:33 UTC|newest]
Thread overview: [no followups] expand[flat|nested] mbox.gz Atom feed
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=20211003083343.14623-1-e@80x24.org \
--to=e@80x24.org \
--cc=mwrap-perl@80x24.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public inbox
https://80x24.org/mwrap-perl.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).