----- Forwarded message from [EMAIL PROTECTED] -----
From: [EMAIL PROTECTED]
To: [EMAIL PROTECTED],
[EMAIL PROTECTED]
The uploaded file
NetServer-ProcessTop-1.02.tar.gz
has entered CPAN as
file: $CPAN/authors/id/JPRIT/NetServer-ProcessTop-1.02.tar.gz
size: 7829 bytes
md5: 7a7459c044d3bfbaff3e6d271fe1aebe
No action is required on your part
Request entered by: JPRIT (Joshua N. Pritikin)
Request entered on: Fri, 28 Jan 2000 20:44:08 GMT
Request completed: Fri, 28 Jan 2000 20:44:47 GMT
Virtually Yours,
Id: paused,v 1.68 1999/10/22 14:39:12 k Exp k
----- End forwarded message -----
# This is a patch for NetServer-ProcessTop-1.01 to update it to
NetServer-ProcessTop-1.02
#
# To apply this patch:
# STEP 1: Chdir to the source directory.
# STEP 2: Run the 'applypatch' program with this patch file as input.
#
# If you do not have 'applypatch', it is part of the 'makepatch' package
# that you can fetch from the Comprehensive Perl Archive Network:
# http://www.perl.com/CPAN/authors/Johan_Vromans/makepatch-x.y.tar.gz
# In the above URL, 'x' should be 2 or higher.
#
# To apply this patch without the use of 'applypatch':
# STEP 1: Chdir to the source directory.
# STEP 2: Run the 'patch' program with this file as input.
#
#### End of Preamble ####
#### Patch data follows ####
gdiff -up '/usr/tmp/mp10291.d/old/NetServer-ProcessTop-1.01/ChangeLog'
'/usr/tmp/mp10291.d/new/NetServer-ProcessTop-1.02/ChangeLog'
Index: ./ChangeLog
--- ./ChangeLog Sat Jun 19 14:46:01 1999
+++ ./ChangeLog Fri Jan 28 15:42:46 2000
@@ -1,3 +1,23 @@
+2000-01-28 Joshua Pritikin <[EMAIL PROTECTED]>
+
+ * Release 1.02.
+
+ * Manually change the height & width of screen with the 'z'
+ command.
+
+2000-01-26 Joshua Pritikin <[EMAIL PROTECTED]>
+
+ * Sort by priority; unrestrict filter REx; update
+ docs (suggested by [EMAIL PROTECTED]).
+
+1999-08-13 Joshua Pritikin <[EMAIL PROTECTED]>
+
+ * Make minor changes for Time::Warp.
+
+1999-07-22 Joshua Pritikin <[EMAIL PROTECTED]>
+
+ * Optionally support eval $arbitrary_perl_code from the user.
+
1999-06-19 Joshua Pritikin <[EMAIL PROTECTED]>
* Update for Event 0.42.
gdiff -up '/usr/tmp/mp10291.d/old/NetServer-ProcessTop-1.01/ProcessTop.pm'
'/usr/tmp/mp10291.d/new/NetServer-ProcessTop-1.02/ProcessTop.pm'
Index: ./ProcessTop.pm
--- ./ProcessTop.pm Sat Jun 19 14:45:35 1999
+++ ./ProcessTop.pm Fri Jan 28 15:42:37 2000
@@ -1,16 +1,17 @@
use strict;
package NetServer::ProcessTop;
-use Event 0.38;
+use Event 0.38 qw(time);
use Carp;
use Symbol;
use Socket;
+use Sys::Hostname;
use Event::Stats 0.5;
use constant NICE => -1;
use vars qw($VERSION @ISA $BasePort $Host $OurInstance);
-$VERSION = '1.01';
+$VERSION = '1.02';
$BasePort = 7000;
-chop($Host = `hostname`);
+$Host = eval { hostname } || 'somewhere';
sub import {
eval {
@@ -48,7 +49,6 @@ sub new_client {
my ($port,$iaddr) = sockaddr_in($paddr);
(bless {
stats => $o,
- mod => time,
from => gethostbyaddr($iaddr, AF_INET) || inet_ntoa($iaddr),
sock => $sock,
}, ref($o).'::Client')->init;
@@ -65,7 +65,7 @@ sub DESTROY {
package NetServer::ProcessTop::Client;
use Carp;
use vars qw(@Argv $Terminal $NextID);
-use Event qw(all_watchers QUEUES);
+use Event qw(all_watchers QUEUES time);
use Event::Watcher qw(ACTIVE SUSPEND QUEUED RUNNING);
use Event::Stats qw(round_seconds idle_time total_time);
use constant NICE => -1;
@@ -94,6 +94,7 @@ sub init {
cb => [$o, 'cmd'],
desc => ref($o)." $o->{from}");
$o->{io}{topserver} = 1;
+ @$o{'col', 'row'} = (80,24);
$o->refresh();
}
@@ -110,7 +111,6 @@ sub ln {
sub refresh {
my ($o) = @_;
- @$o{'col', 'row'} = (80,24); #XXX can get dynamically? how?!
$o->{rows_per_page} = $o->{row} - $o->{start_row} - 4;
my $b = $Term->Tputs('cl',1,$o->{sock});
@@ -150,15 +150,17 @@ sub help {
CMD DESCRIPTION
-------- -----------------------------------------------------------
+ ! <code> eval arbitrary perl code
d # set Event::DebugLevel [$Event::DebugLevel]
e #id edit event
h this screen
- o #how order by t=time, i=id, r=ran, d=desc [$o->{by}]
+ o #how order by t=time, i=id, r=ran, d=desc, p=prio [$o->{by}]
p #page switch to page #page [$o->{page}]
r #id resume event
s #id suspend event
t #sec show stats for the last #sec seconds [$o->{seconds}]
x exit
+ z r,c size screen to (rows, columns) [$o->{row}, $o->{col}]
/regexp show events with matching descriptions [$o->{filter}]
@@ -166,8 +168,6 @@ sub help {
-
-
(Press return to continue.)";
return $o->cancel if !defined syswrite $o->{sock}, $s, length $s;
@@ -232,7 +232,7 @@ sub update {
my $filter = $o->{filter};
@all = grep { $_->[0]{desc} =~ /$filter/ } @all
- if $filter;
+ if length $filter;
$o->{page} = 1 if $o->{page} < 1;
my $maxpage = int((@all + $o->{rows_per_page} - 1)/$o->{rows_per_page});
@@ -251,6 +251,8 @@ sub update {
@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}'";
}
@@ -354,13 +356,13 @@ sub cmd {
return;
} elsif ($in =~ m/^o\s*(\w+)$/) {
my $by = $1;
- if ($by =~ m/^(t|i|r|d)$/) {
+ if ($by =~ m/^(t|i|r|d|p)$/) {
$o->{by} = $by;
} else {
$o->{msg} = "Sort by '$by'? Type 'h' for help!";
}
} elsif ($in =~ m/^p\s*(\d+)$/) {
- $o->{page} = $1;
+ $o->{page} = $1 || 1;
} elsif ($in =~ m/^e\s*(\d+)$/) {
my @got = grep { $_->{id} == $1 } all_watchers();
if (@got) {
@@ -373,8 +375,14 @@ sub cmd {
} else {
$o->{msg} = "Can't find event id '$1'";
}
- } elsif ($in =~ m{ ^/ (\w*) $ }x) {
+ } elsif ($in =~ m{ ^/ (.*) $ }x) {
$o->{filter} = $1;
+ } elsif ($in =~ m/^z\s*(\d+)(\s*,\s*|\s+)(\d+)$/) {
+ my ($r,$c) = ($1,$3);
+ $r = 12 if $r < 12;
+ $c = 70 if $c < 70;
+ $o->{row} = $r;
+ $o->{col} = $c;
} elsif ($in =~ m/^t\s*(\d+)$/) {
my $s = $1;
my $max = &Event::Stats::MAXTIME;
@@ -394,6 +402,11 @@ sub cmd {
} else {
$ev->suspend($do eq 's')
}
+ } elsif ($in =~ s/^\!//) {
+ my $v;
+ $v = eval $in;
+ $v = '<undef>' if !defined $v;
+ $o->{msg} = $@? $@ : $v;
} else {
$o->{msg} = "'$in'? Type 'h' for help!";
}
@@ -425,8 +438,9 @@ NetServer::ProcessTop - Make event loop
=head1 SYNOPSIS
- use NetServer::ProcessTop;
+ require NetServer::ProcessTop;
+ 'NetServer::ProcessTop'->import(); # creates server
warn "NetServer::ProcessTop listening on port ".(7000+($$ % 1000))."\n";
=head1 DESCRIPTION
@@ -489,6 +503,13 @@ improvements, don't be shy!
11 4 sleep 0 0:00 0.0% io NetServer::ProcessTop::Client localhost
8 4 sleep 0 0:00 0.0% io SSL
13 4 zomb 0 0:00 0.0% time QSGTable
+
+The three load averages are for the most recent 15 seconds, 1 minute,
+and 15 minutes, respectively.
+
+For efficiency, not all time intervals are available. When you change
+the time interval, it will be rounded to the closest for which there
+is data.
=head1 BUGS
gdiff -up '/usr/tmp/mp10291.d/old/NetServer-ProcessTop-1.01/README'
'/usr/tmp/mp10291.d/new/NetServer-ProcessTop-1.02/README'
Index: ./README
--- ./README Wed Apr 7 17:32:37 1999
+++ ./README Wed Dec 22 17:00:10 1999
@@ -4,6 +4,3 @@ This module sets up a mini-server access
what a process's event loop is doing. The output is formatted in a
manner similar to the popular 'top' program. Event priorities and
other parameters can be adjusted interactively.
-
-
-Requires Event 0.27.
gdiff -up '/usr/tmp/mp10291.d/old/NetServer-ProcessTop-1.01/TODO'
'/usr/tmp/mp10291.d/new/NetServer-ProcessTop-1.02/TODO'
Index: ./TODO
--- ./TODO Wed Apr 7 17:32:38 1999
+++ ./TODO Fri Jan 28 15:42:12 2000
@@ -1,3 +1,7 @@
+sort by type of watcher
+
+restrict REx to something safe?
+
show 'die' stat in bold
idle events are not display right (probably)
gdiff -up '/usr/tmp/mp10291.d/old/NetServer-ProcessTop-1.01/demo/top.pl'
'/usr/tmp/mp10291.d/new/NetServer-ProcessTop-1.02/demo/top.pl'
Index: ./demo/top.pl
--- ./demo/top.pl Fri Jun 18 10:55:13 1999
+++ ./demo/top.pl Fri Jan 28 15:38:10 2000
@@ -1,7 +1,16 @@
#!./perl -w
+#!./perl -wT
+BEGIN {
+ # untaint
+ @INC = map { $_ =~ /^(.*)$/; $1 } @INC;
+ require Config;
+ push @INC, (map { $_, "$_/$Config::Config{archname}" }
+ split /:+/, $ENV{PERL5LIB});
+ @INC = map { $_ =~ /^(.*)$/; $1 } @INC;
+}
use strict;
-use Event 0.27 qw(loop);
+use Event qw(loop);
require NetServer::ProcessTop;
for (1..40) {
#### End of Patch data ####
#### ApplyPatch data follows ####
# Data version : 1.0
# Date generated : Fri Jan 28 15:44:37 2000
# Generated by : makepatch 2.00 (2.0BETA)
# Recurse directories : Yes
# p 'ChangeLog' 1100 949092166 0100444
# p 'ProcessTop.pm' 14189 949092157 0100444
# p 'README' 296 945900010 0100444
# p 'TODO' 1786 949092132 0100444
# p 'demo/top.pl' 291 949091890 0100444
#### End of ApplyPatch data ####
#### End of Patch kit [created: Fri Jan 28 15:44:37 2000] ####
#### Checksum: 279 8903 64395 ####
--
"Never ascribe to malice that which can be explained by stupidity."
via, but not speaking for Deutsche Bank
