--- loncom/cgi/userstatus.pl 2003/07/29 20:23:17 1.4
+++ loncom/cgi/userstatus.pl 2003/08/27 18:20:11 1.5
@@ -7,99 +7,171 @@ $|=1;
# 09/06/01 Gerd Kortemeyer)
# 02/18/02,02/19/02 Gerd Kortemeyer)
+use strict;
use lib '/home/httpd/lib/perl/';
use LONCAPA::Configuration;
use HTTP::Headers;
use IO::File;
+
+my %usercount;
+my @actl=('Active','Moderately Active','Inactive');
+
print "Content-type: text/html\n\n";
# -------------------- Read loncapa.conf (and by default, loncapa_apache.conf).
-my $perlvarref=LONCAPA::Configuration::read_conf('loncapa.conf');
-my %perlvar=%{$perlvarref};
-undef $perlvarref; # remove since sensitive and not needed
-delete $perlvar{'lonReceipt'}; # remove since sensitive and not needed
-delete $perlvar{'lonSqlAccess'}; # remove since sensitive and not needed
-
-my $oneline=($ENV{'QUERY_STRING'} eq 'simple');
-unless ($oneline) { print "
\nUser Status ".localtime()."
"; }
-
-my $filename;
-opendir(DIR,$perlvar{'lonIDsDir'});
-%usercounts=();
-while ($filename=readdir(DIR)) {
- unless ($filename=~/^\./) {
- my ($dev,$ino,$mode,$nlink,
- $uid,$gid,$rdev,$size,
- $atime,$mtime,$ctime,
- $blksize,$blocks)=stat($perlvar{'lonIDsDir'}.'/'.$filename);
- $now=time;
- $since=$now-$mtime;
- $sinceacc=$now-$atime;
- unless ($oneline) { print ("\n\n
"); }
- my %userinfo=();
- undef $userinfo;
- my $fh=IO::File->new($perlvar{'lonIDsDir'}.'/'.$filename);
- while ($line=<$fh>) {
- chomp($line);
- my ($name,$value)=split(/\=/,$line);
- $userinfo{$name}=$value;
- }
- $fh->close();
- $color="#000000";
- $userclass="Active";
- if ($since>300) { $color="#222222"; }
- if ($since>600) { $color="#444444"; }
- if ($since>3600) { $color="#666666"; $userclass="Moderately Active"; }
- if ($since>7200) { $color="#888888"; }
- if ($since>21600) { $color="#AAAAAA"; $userclass="Inactive"; }
- $usercount{$userclass}++;
- $usercount{'in Domain '.$userinfo{'user.domain'}}++;
- unless ($oneline) {
- print '';
- print ''.$userinfo{'environment.lastname'}.', '.
- $userinfo{'environment.firstname'}.' '.
- $userinfo{'environment.middlename'}.' '.
- $userinfo{'environment.generation'}." (".
- $userinfo{'user.name'}."\@".$userinfo{'user.domain'}.
- ")
\nLogin time: ".
- localtime($userinfo{'user.login.time'}).
- ' Browser: '.$userinfo{'browser.type'}." Client: ".
- $userinfo{'request.host'}."
\nRole: ".
- $userinfo{'request.role'}." ";
- if ($userinfo{'request.course.id'}) {
- print "Course: ".
- $userinfo{'course.'.$userinfo{'request.course.id'}.'.description'}.
- ' ('.$userinfo{'request.course.id'}.')';
- $usercount{'in Course '.
- $userinfo{'course.'.$userinfo{'request.course.id'}.'.description'}.
- ' ('.$userinfo{'request.course.id'}.')'}++;
- } else {
- print "Not in a course.";
- }
- print "
Last Transaction: ".localtime($mtime).
- " (".$since." secs ago)
Last Access: ".localtime($atime).
- " (".$sinceacc." secs ago)";
- print ("");
- }
+&main();
+
+sub analyze_time {
+ my ($since)=@_;
+ my $color="#000000";
+ my $userclass=$actl[0];
+ if ($since>300) { $color="#222222"; }
+ if ($since>600) { $color="#444444"; }
+ if ($since>3600) { $color="#666666"; $userclass=$actl[1]; }
+ if ($since>7200) { $color="#888888"; }
+ if ($since>21600) { $color="#AAAAAA"; $userclass=$actl[2]; }
+ return ($color,$userclass);
+}
+
+sub add_count {
+ my ($cat,$scope,$class)=@_;
+ if (!defined($usercount{$cat})) {
+ $usercount{$cat}={};
+ }
+ if (!defined($usercount{$cat}{$scope})) {
+ $usercount{$cat}{$scope}={};
}
+ $usercount{$cat}{$scope}{$class}++;
}
-closedir(DIR);
-open (LOADAVGH,"/proc/loadavg");
-$loadavg=;
-close(LOADAVGH);
-unless ($oneline) {
-print "
User Count
";
-foreach (sort keys %usercount) {
- print "".$_.": ".$usercount{$_}."
";
+
+sub main {
+ my $perlvar=LONCAPA::Configuration::read_conf('loncapa.conf');
+ delete $$perlvar{'lonReceipt'}; # remove since sensitive and not needed
+ delete $$perlvar{'lonSqlAccess'}; # remove since sensitive and not needed
+
+ my $oneline=($ENV{'QUERY_STRING'} eq 'simple');
+ my $justsummary=($ENV{'QUERY_STRING'} eq 'summary');
+ unless ($oneline) { print "\nUser Status ".localtime()."
"; }
+
+ opendir(DIR,$$perlvar{'lonIDsDir'});
+ my @allfiles=(sort(readdir(DIR)));
+ foreach my $filename (@allfiles) {
+ if ($filename=~/^\./) { next; }
+ my ($dev,$ino,$mode,$nlink,
+ $uid,$gid,$rdev,$size,
+ $atime,$mtime,$ctime,
+ $blksize,$blocks)=stat($$perlvar{'lonIDsDir'}.'/'.$filename);
+ my $now=time;
+ my $since=$now-$mtime;
+ my $sinceacc=$now-$atime;
+ unless ($oneline || $justsummary) { print ("\n\n
"); }
+ my %userinfo;
+ my $fh=IO::File->new($$perlvar{'lonIDsDir'}.'/'.$filename);
+ while (my $line=<$fh>) {
+ chomp($line);
+ my ($name,$value)=split(/\=/,$line);
+ $userinfo{$name}=$value;
+ }
+ $fh->close();
+ my ($color,$userclass)=&analyze_time($since);
+ &add_count('Overall','all',$userclass);
+ &add_count('Domain',$userinfo{'user.domain'},$userclass);
+
+ unless ($oneline) {
+ if (!$justsummary) {
+ print '';
+ print ''.$userinfo{'environment.lastname'}.', '.
+ $userinfo{'environment.firstname'}.' '.
+ $userinfo{'environment.middlename'}.' '.
+ $userinfo{'environment.generation'}." (".
+ $userinfo{'user.name'}."\@".$userinfo{'user.domain'}.
+ ")
\nLogin time: ".
+ localtime($userinfo{'user.login.time'}).
+ ' Browser: '.$userinfo{'browser.type'}." Client: ".
+ $userinfo{'request.host'}."
\nRole: ".
+ $userinfo{'request.role'}." ";
+ }
+ &add_count('Browser',$userinfo{'browser.type'},$userinfo{'browser.version'});
+ if ($userinfo{'request.course.id'}) {
+ my $cid=$userinfo{'request.course.id'};
+ my $coursename= $userinfo{'course.'.$cid.'.description'}.
+ ' ('.$cid.')';
+ if (!$justsummary) { print "Course: ".$coursename; }
+ &add_count('Course',$coursename,$userclass);
+ } else {
+ if (!$justsummary) { print "Not in a course."; }
+ &add_count('Course','No Course',$userclass);
+ }
+ if (!$justsummary) {
+ print "
Last Transaction: ".localtime($mtime).
+ " (".$since." secs ago)
Last Access: ".
+ localtime($atime)." (".$sinceacc." secs ago)";
+ print ("");
+ }
+ }
+ }
+ closedir(DIR);
+ open (LOADAVGH,"/proc/loadavg");
+ my $loadavg=;
+ close(LOADAVGH);
+ unless ($oneline) {
+ print "
User Counts
";
+# print "\n";
+ &showact('Overall',%usercount);
+ &showact('Domain',%usercount);
+ &showact('Course',%usercount);
+ &show('Browser',%usercount);
+
+# print "\n
";
+ print "Load Average: ".$loadavg;
+ print "";
+ } else {
+ foreach (sort keys %usercount) {
+ print $_.'='.$usercount{$_}.'&';
+ }
+ print 'loadavg='.$loadavg;
+ }
}
-print "Load Average: ".$loadavg;
-print "";
-} else {
-foreach (sort keys %usercount) {
- print $_.'='.$usercount{$_}.'&';
+
+sub show {
+ my ($cat,%usercount)=@_;
+ print("$cat
\n");
+ foreach my $type (sort(keys(%{$usercount{$cat}}))) {
+ print("$type | ");
+ print(join(" | ",sort(keys(%{$usercount{$cat}{$type}}))));
+ my $temp;
+ my $count=0;
+ foreach my $version (sort(keys(%{$usercount{$cat}{$type}}))) {
+ $temp.=" | ".$usercount{$cat}{$type}{$version}.
+ " | ";
+ $count+=$usercount{$cat}{$type}{$version};
+ }
+ print("
---|
$count | ");
+ print($temp."
\n");
+ }
}
-print 'loadavg='.$loadavg;
+
+sub showact {
+ my ($cat,%usercount)=@_;
+ print("$cat
\n");
+
+ print(" | ");
+ print(join(" | ",('Any',@actl)));
+ print(" |
");
+ foreach my $type (sort(keys(%{$usercount{$cat}}))) {
+ print("$type | ");
+ my $temp;
+ my $count=0;
+ foreach my $activity (@actl) {
+ $temp.=" ".$usercount{$cat}{$type}{$activity}." | ";
+ $count+=$usercount{$cat}{$type}{$activity};
+ }
+ print("$count | ");
+ print($temp);
+ }
+ print("
\n");
}
+