Re: Server status through HTTP using CGI::Push (HTML version)

in reply to Server status through HTTP using CGI::Push

I took the liberty of expanding on this and came up with a useful top-like script (including filter links and formatted fields):

#!/usr/bin/perl -w

use strict;
use CGI        'param';
use CGI::Push    qw(:standard);
use CGI::Carp    qw(fatalsToBrowser warningsToBrowser);

do_push(
    -nph        => 0,
    -delay        => 2,
    -next_page    => sub {
        my($q, $count) = @_;
        my @return;

        my $command = "ps -auxwr";
        $command .= " -U ".getpwuid(param("uid"))
            if param("uid") =~ /^[0-9]+$/;

        my @lines = split /\n/, `$command`;
        my @header = split /\s+/, shift @lines;
        my %format = (
            "USER" => sub { 
                my($value) = @_;
                my $uid = getpwnam($value);
                return $value if ($uid == param("uid") &&
                    defined param("uid"));
                return "<a href=\"$ENV{SCRIPT_NAME}?uid=$uid\">$value<
+/a>";
            },
            "\%CPU" => sub {
                my($value) = @_;
                return ($value > 0.0) ? 
                    "<b>$value%</b>" : "$value%";
            },
            "\%MEM" => sub {
                my($value) = @_;
                return "$value%";
            },
            "VSZ" => sub {
                my($value) = @_;
                $value =~ s/(?<=\d)(?=(\d\d\d)+$)/,/g;
                return "$value&nbsp;kb";
            },
            "RSS" => sub {
                my($value) = @_;
                $value =~ s/(?<=\d)(?=(\d\d\d)+$)/,/g;
                return "$value&nbsp;kb";
            }
        );

        push @return, <<EOF;
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
<html lang="en">
 <head>
  <title>$ENV{SERVER_NAME}: $command</title>
 </head>
 <body>
  <table border="1">
   <tr>
EOF

        foreach(@header) {
            push @return, "    <th>$_</th>\n";
        }
        push @return, "   </tr>\n";

        foreach(@lines) {
            my @field = split(/\s+/, $_, $#header+1);
            push @return, "   <tr>\n";
            my $f=0;
            foreach(@field) {
                $_ = &{$format{$header[$f]}}($_)
                    if(defined $format{$header[$f]});
                push @return, "    <td>$_</td>\n";
                $f++;
            }
            push @return, "   </tr>\n";
        }

        push @return, <<EOF;
  </table>
 </body>
</html>
EOF

        return @return;
    },
);
[download]

In Section Cool Uses for Perl