view release on metacpan or  search on metacpan

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

}

### procs ###

sub data_procs {
    my $self = shift;

    unless ($Apache::VMonitor::PROC_REGEX) {
        warn "Don't know what processes to display..." .
            'int: set $Apache::VMonitor::PROC_REGEX' .
            'e.g. \$Apache::VMonitor::PROC_REGEX = join "\|", qw(httpd mysql);';
        return {};
    }

    my $gtop = $self->{gtop};

    unless ($gtop) {
        warn "GTop not installed, not displaying process data";
        return {};
    }


    my($proclist, $entries) = $gtop->proclist;

    my %procs = ();
    for my $pid ( @$entries ) {
        my $cmd = $gtop->proc_state($pid)->cmd;
        push @{ $procs{$cmd} }, $pid
            if $cmd =~ /$Apache::VMonitor::PROC_REGEX/o;
    }

    # finding out various max lenthgs for a proper column formatting
    # set the minimum width here
    my %max_len = (
        pid => 3,
        cmd => 3,
        tty => 3,
        uid => 3,
    );
    my @recs = ();

    my $cat_id = 0;
    for my $cat (sort keys %procs) {

        my $cnt = 0;
        $cat_id++;
        for my $pid ( @{ $procs{$cat} } ) {
            $cnt++;
            my $state = $gtop->proc_state($pid);
            my $uid   = $gtop->proc_uid($pid);
            my $mem   = $gtop->proc_mem($pid);
            my $tty   = $uid->tty;
            $tty = ' ' if $tty == -1;

            push @recs, {
                cat_id    => $cat_id,
                count     => $cnt,
                pid       => $pid,
                pid_link  => fixup_url($self->{url}, pid => $pid),
                uid       => scalar(getpwuid($state->uid)),
                fsize     => size_string($mem->size($pid)),
                fshare    => size_string($mem->share($pid)),
                fvsize    => size_string($mem->vsize($pid)),
                frss      => size_string($mem->rss($pid)),
                tty       => $tty,
                state     => $state->state,
                cmd       => $state->cmd,
            };

            my $len       = length $pid;
            $max_len{pid} = $len if $len > $max_len{pid};
            $len          = length $state->cmd;
            $max_len{cmd} = $len if $len > $max_len{cmd};
            $len          = length $uid->tty;
            $max_len{tty} = $len if $len > $max_len{tty};
            $len          = length scalar getpwuid $state->uid;
            $max_len{uid} = $len if $len > $max_len{uid};
        }
    }

    return {
        max_len => \%max_len,
        records => \@recs,
    };
}

sub tmpl_procs {

    return \ <<'EOT';
<hr>
<pre>
[%-

  USE format_procs =
      format("%4s %${max_len.pid}s %-${max_len.uid}s %5s %5s %5s %5s %${max_len.tty}s  %-2s  %-${max_len.cmd}s");
  "<b>";
  format_procs('##', "PID", "UID", "Size", "Share", "VSize", "Rss", "TTY", "St", "Command");
  "</b>\n";

  space = "&nbsp;";
  FOR rec = records;
      times = max_len.pid - rec.pid.length;
      spacing = times > 0 ? space.repeat(times) : "";
      pid_link = "$spacing<a href=\"${rec.pid_link}\">${rec.pid}</a>";

      item_class = rec.cat_id % 2 ? "item_odd" : "item_even";
      "<span class=\"$item_class\">";
      format_procs(rec.count, pid_link, rec.uid, rec.fsize, rec.fshare, rec.fvsize, rec.frss, rec.tty, rec.state, rec.cmd);
      "</span>\n";
  END;

-%]
</pre>
EOT

}

### apache_single ###

sub data_apache_single {
    my $self = shift;

    # XXX:
    # worker == 0, no worker data to display
    # consider showing workers under control of this pid

    if (MP2 && $Apache::Scoreboard::VERSION < 2.0) {
        die "Apache::Scoreboard 2.0 or higher is wanted, " .
            "this is only version $Apache::Scoreboard::VERSION";
    }

    my $pid = $self->{pid};
    my $data;

    ### proc command name/args
    my($proclist, $entries) = $gtop->proclist;

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

    }
    $data->{mem} = {
            size   => $mem->{size},
            share  => $mem->{share},
            vsize  => $mem->{vsize},
            rss    => $mem->{rss},
            fsize  => size_string($mem->{size}),
            fshare => size_string($mem->{share}),
            fvsize => size_string($mem->{vsize}),
            frss   => size_string($mem->{rss}),
    };

    if (my $parent_score = $self->pid2parent_score($pid)) {

        my $worker_score;
        if ($self->{tid}) {
            warn "tid: $self->{tid}\n";
            my $image = $self->scoreboard_image();
            my $parent_idx = $image->parent_idx_by_pid($pid);
            $worker_score = $image->worker_score($parent_idx, $self->{tid});
        }
        else {
            $worker_score = MP2 ? $parent_score->worker_score : $parent_score;
        }

        my $rec = $self->score2record($worker_score);
        my $lastreq = $rec->{lastreq} ? $rec->{lastreq}/1000 : 0;
        $data->{rec} = {
            is_httpd_proc => 1,
            proc_type => ($pid == getppid ? "Parent" : "Child"),
            mode_long => $Apache::VMonitor::longflags{$rec->{mode}},
            elapsed   => $rec->{elapsed},
            felapsed  => format_time($rec->{elapsed}),
            lastreq   => $lastreq,
            flastreq  => format_time($lastreq),
            fserved   => format_counts($rec->{served}),
            client    => $rec->{client},
            vhost     => $rec->{vhost},
            request   => $rec->{request},
            access_count     => $worker_score->access_count,
            my_access_count  => $worker_score->my_access_count,
            bytes_served     => $worker_score->bytes_served,
            fbytes_served    => size_string($worker_score->bytes_served),
            my_bytes_served  => $worker_score->my_bytes_served,
            fmy_bytes_served => size_string($worker_score->my_bytes_served),
        };

        my @cpu_cols  = qw(total utime stime cutime cstime);
        my @cpu_times = $worker_score->times();
        my $cpu_total = eval join "+", @cpu_times;
        for ($cpu_total, @cpu_times) {
            my $key = "cpu_" . shift @cpu_cols;
            $data->{rec}->{$key} = $_/100;
        }
    }

    ### generic process info
    my $proc_info;
    # UID and STATE
    my $state = $gtop->proc_state($pid);
    $proc_info->{uid} = scalar getpwuid $state->uid;
    $proc_info->{gid} = scalar getgrgid $state->gid;
    $proc_info->{state} = $state->state;
    # TTY
    my $proc_uid  = $gtop->proc_uid($pid);
    my $tty = $proc_uid->tty;
    $tty = 'None' if $tty == -1;
    $proc_info->{tty} = $tty;
    # ARGV
    $proc_info->{argv} = join " ", @{($gtop->proc_args($pid))[1]};
    $data->{proc} = $proc_info;

    ### memory segments usage
    my $proc_segment = $gtop->proc_segment($pid);
    no strict 'refs';
    for (qw(text_rss shlib_rss data_rss stack_rss)) {
        my $size = $proc_segment->$_($pid);
        $data->{mem_segm}->{$_} = $size;
        $data->{mem_segm}->{"f$_"} = size_string($size);
    }

    ### memory maps
    my($procmap, $maps) = $gtop->proc_map($pid);
    my $number = $procmap->number;
    my %libpaths = ();

    my @maps = ();
    for (my $i = 0; $i < $number; $i++) {
        my $filename = $maps->filename($i) || "-";
        $libpaths{$filename}++;
        my $device = $maps->device($i);
        push @maps, {
                start        => $maps->start($i),
                end          => $maps->end($i),
                offset       => $maps->offset($i),
                device_major => (($device >> 8) & 255),
                device_minor => ($device & 255),
                inode        => $maps->inode($i),
                perm         => $maps->perm_string($i),
                filename     => $filename,
            };

    }

    $data->{mem_maps} = {
        records  => \@maps,
        ptr_size => (length(pack("p", 0)) == 8 ? 16 : 8),
    };

    ### loaded shared libs sizes
    my %libsizes = map { $_  => -s $_ } 
        grep { -e $_} grep !/^-$/, keys %libpaths;

    my @lib_sizes = ();
    my $total = 0;
    for (sort { $libsizes{$b} <=> $libsizes{$a} } keys %libsizes) {
        $total +=  $libsizes{$_};
        push @lib_sizes, {
            size     => $libsizes{$_},
            fsize    => size_string($libsizes{$_}),
            filename => $_,