view release on metacpan or  search on metacpan

lib/Apache/VMonitor.pm  view on Meta::CPAN

  "R" => "Reading Request",
  "W" => "Sending Reply",
  "K" => "Keepalive (read)",
  "D" => "DNS Lookup",
  "C" => "Closing connection",
  "L" => "Logging",
  "G" => "Gracefully finishing",
  "I" => "Idle cleanup of worker",
  "." => "Open slot with no current process",
);

########################
# default config values
########################
%Apache::VMonitor::Config = (
   # behavior
   refresh  => 0,
   verbose  => 0,

   # sections to show
   system   => 1,
   apache   => 1,
   procs    => 0,
   mount    => 0,
   fs_usage => 1,

   # sorting
   apache_sort_by        => 'size',
   apache_sort_by_ascend => 0,
);

my @sects = qw(system apache procs mount fs_usage verbose);

my %cfg = ();

sub handler_mp1 ($$)     { &run }
sub handler_mp2 : method { &run }
*handler = MP2 ? \&handler_mp2 : \&handler_mp1;
my $counter = 0;

sub run {
    my ($class, $r) = @_;
    $class = ref($class)||$class;
    #$tt = Template->new({});

    my %params = MP2 
        ? map({ split('=', $_, 2) } split /[&]/, $r->args)
        : $r->args;
    # modify the default args if requested
    for (keys %Apache::VMonitor::Config) {
        $cfg{$_} = exists $params{$_}
            ? $params{$_}
            : $Apache::VMonitor::Config{$_};
    }

    my $pid = $params{pid} || 0;

    # really just a worker index (in threaded mpm)
    my $tid = $params{thread_num} || '';

    # build the updated URL (append the pid k/v pair)
    my $url = $r->uri . "?pid=$pid&" . join "&", map {"$_=$cfg{$_}"} keys %cfg;

    # if refresh is non-null, set the refresh header
    $r->headers_out->set(Refresh => "$cfg{refresh}; URL=$url") 
        if $cfg{refresh};

    MP2 ? $r->content_type('text/html') : $r->send_http_header('text/html');

    my $self = $class->new(
        r     => $r,
        tt    => $tt,
        gtop  => $gtop,
        cfg   => \%cfg,
        url   => $url,
        pid   => $pid,
        tid   => $tid,
    );

    $self->{tt} ||= Template->new({
        BLOCKS => {
            tmpl_start_html    => $self->tmpl_start_html(),
            tmpl_end_html      => $self->tmpl_end_html(),
            tmpl_procs         => $self->tmpl_procs(),
            tmpl_nav_bar       => $self->tmpl_nav_bar(),
            tmpl_fs_usage      => $self->tmpl_fs_usage(),
            tmpl_mount         => $self->tmpl_mount(),
            tmpl_apache        => $self->tmpl_apache(),
            tmpl_apache_single => $self->tmpl_apache_single(),
            tmpl_system        => $self->tmpl_system(),
            tmpl_verbose       => $self->tmpl_verbose(),
        },
    });

    $self->generate;

    return OK;
}

sub new {
    my $class = shift;
    my $self = bless {@_}, ref($class)||$class;
    return $self;
}

sub generate {
    my $self = shift;
    my $cfg = $self->{cfg};
    my $tt = $self->{tt};

    my @items = 'start_html';

    if ($self->{pid}) {
        push @items, qw(apache_single);
    }
    else {
        my @sects = qw(system apache procs fs_usage mount);
        $cfg->{$_} && push @items, $_ for @sects;
        push @items, qw(nav_bar);
        $cfg->{$_} && push @items, $_ for qw(verbose);