view release on metacpan or  search on metacpan

lib/NetServer/Portal/Top.pm  view on Meta::CPAN

    Event::Stats::collect(1);
    $c->{io}->timeout(4);
}

sub leave {
    # there's probably a better way to do this...? XXX
    Event->timer(desc => 'NetServer::Portal::Top->leave',
		 after => 15 * 60, cb => sub {
		     my $e = shift;
		     $e->w->cancel;
		     if (!Event::Stats::collect(-1)) {
			 %ID2W = ();
		     }
		 });
}

sub reset_idmap {
    %OldW2ID = %W2ID;
    if ($NextID > 2*keys %OldW2ID) {
	%OldW2ID=();  # too much fragmentation, start over
    }
    $NextID = 1;
    %W2ID=();
}
sub assign_id {  # assign unique ids without reassignments
    my ($w) = @_;
    my $id;
    if (exists $OldW2ID{ 0+$w } and !exists $ID2W{ $OldW2ID{ 0+$w } }) {
	$id = $OldW2ID{ 0+$w };
	$NextID = $id + 1
	    if $NextID < $id + 1;
    } else {
	$id = $NextID++;
    }
    $W2ID{ 0+$w } = $id;
    $ID2W{ $id } = $w;
    $id;
}

sub update {
    my ($o, $c) = @_;

    reset_idmap();

    my $uconf = $c->conf;
    my $s = term->Tgoto('cm', 0, 0, $c->{io}->fd);
    # my $s = term->Tputs('cl',1,$c->{io}->fd);
    my $ln = $c->format_line;
    my $name = $0;
    $name =~ s,^.*/,,;
    $s .= $ln->("$name PID=$$ \@ $Host");

    my ($sec,$min,$hr) = localtime(time);
    my $tm = sprintf("| %02d:%02d:%02d [%4ds]", $hr,$min,$sec,$o->{seconds});
    $s .= term->Tgoto('cm', $uconf->{cols} - (1+length $tm), 0, $c->{io}->fd);
    $s .= $tm."\n";

    my @load;
    my @events = all_watchers();
    for my $sec (15,60,60*15) {
	my $busy = 0;
	for (@events) { $busy += ($_->stats($sec))[2] }
	my $idle = (idle_time($sec))[2];
	my $tm = $idle + $busy;
	push @load, $tm? $busy / $tm : 0;
    }

    my @all = map {
	[{ obj  => $_,
	   id   => assign_id($_),
	   desc => $_->desc,
	   prio => $_->prio },
	 $_->stats($o->{seconds})] } @events;
    push @all, [{ id => 0, desc => 'idle', prio => QUEUES },
		idle_time($o->{seconds})];
    my $total = 0;
    for (@all) { $total += $_->[3] }
    my $other_tm = total_time($o->{seconds}) - $total;
    $other_tm = 0 if $other_tm < 0;
    push @all, [{ id => 0, desc => 'other processes', prio => -1 },
		0, 0, $other_tm];

    # $lag should not be affected by other processes
    my $lag = $total - $o->{seconds};
    $lag = 0 if $lag < 0;

    $s .= $ln->("%d events; load averages: %.2f, %.2f, %.2f; lag %2d%%",
		scalar @events, @load, $total? 100*$lag/$total : 0);
    $s .= "\n";

    $total += $other_tm; # add in other processes for %time [XXX optional?]

    my $filter = $o->{filter};
    @all = grep { $_->[0]{desc} =~ /$filter/ } @all
	if length $filter;

    $o->{page} = 1 if $o->{page} < 1;
    my $rows_per_page = $uconf->{rows} - 8;
    my $maxpage = int((@all + $rows_per_page - 1)/$rows_per_page);
    $o->{page} = $maxpage if $o->{page} > $maxpage;

    my $page = " P$o->{page}";
    $s .= $ln->("  EID PRI STATE   RAN  TIME   CPU TYPE DESCRIPTION");
    my $start_row = 4;
    $s .= term->Tgoto('cm', $uconf->{cols} - (1+length $page), $start_row-1,
		       $c->{io}->fd);
    $s .= $page."\n";

    if ($o->{by} eq 't') {
	@all = sort { $b->[3] <=> $a->[3] } @all;
    } elsif ($o->{by} eq 'i') {
	@all = sort { $a->[0]{id} <=> $b->[0]{id} } @all;
    } elsif ($o->{by} eq 'r') {
	@all = sort { $b->[1] <=> $a->[1] } @all;
    } elsif ($o->{by} eq 'd') {
	@all = sort { $a->[0]{desc} cmp $b->[0]{desc} } @all;
    } elsif ($o->{by} eq 'p') {
	@all = sort { $a->[0]{prio} cmp $b->[0]{prio} } @all;
    } else {
	warn "unknown sort by '$o->{by}'";
    }
    splice @all, 0, $rows_per_page * ($o->{page} - 1)
	if $o->{page} > 1;

    for (my $r = 0; $r < $rows_per_page; $r++) {