[LON-CAPA-cvs] cvs: loncom /cgi userstatus.pl
albertel
lon-capa-cvs@mail.lon-capa.org
Wed, 27 Aug 2003 18:20:12 -0000
This is a MIME encoded message
--albertel1062008412
Content-Type: text/plain
albertel Wed Aug 27 14:20:12 2003 EDT
Modified files:
/loncom/cgi userstatus.pl
Log:
- tabinated
- added more detail to summary at bottom
- added new mode 'summary' only prints out bottom
- made more modular
--albertel1062008412
Content-Type: text/plain
Content-Disposition: attachment; filename="albertel-20030827142012.txt"
Index: loncom/cgi/userstatus.pl
diff -u loncom/cgi/userstatus.pl:1.4 loncom/cgi/userstatus.pl:1.5
--- loncom/cgi/userstatus.pl:1.4 Tue Jul 29 16:23:17 2003
+++ loncom/cgi/userstatus.pl Wed Aug 27 14:20:11 2003
@@ -7,99 +7,171 @@
# 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 "<html><body bgcolor=#FFFFFF>\n<h1>User Status ".localtime()."</h1>"; }
-
-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<hr />"); }
- 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 '<font color="'.$color.'">';
- print '<h3>'.$userinfo{'environment.lastname'}.', '.
- $userinfo{'environment.firstname'}.' '.
- $userinfo{'environment.middlename'}.' '.
- $userinfo{'environment.generation'}." (".
- $userinfo{'user.name'}."\@".$userinfo{'user.domain'}.
- ")</h3>\n<b>Login time:</b> ".
- localtime($userinfo{'user.login.time'}).
- ' <b>Browser</b>: '.$userinfo{'browser.type'}." <b>Client:</b> ".
- $userinfo{'request.host'}."<br />\n<b>Role: </b>".
- $userinfo{'request.role'}." ";
- if ($userinfo{'request.course.id'}) {
- print "<b>Course:</b> ".
- $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 "<br /><b>Last Transaction:</b> ".localtime($mtime).
- " (".$since." secs ago) <br /><b>Last Access:</b> ".localtime($atime).
- " (".$sinceacc." secs ago)";
- print ("</font>");
- }
+&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=<LOADAVGH>;
-close(LOADAVGH);
-unless ($oneline) {
-print "<hr /><h2>User Count</h2>";
-foreach (sort keys %usercount) {
- print "<b>".$_.":</b> ".$usercount{$_}."<br />";
+
+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 "<html><body bgcolor=#FFFFFF>\n<h1>User Status ".localtime()."</h1>"; }
+
+ 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<hr />"); }
+ 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 '<font color="'.$color.'">';
+ print '<h3>'.$userinfo{'environment.lastname'}.', '.
+ $userinfo{'environment.firstname'}.' '.
+ $userinfo{'environment.middlename'}.' '.
+ $userinfo{'environment.generation'}." (".
+ $userinfo{'user.name'}."\@".$userinfo{'user.domain'}.
+ ")</h3>\n<b>Login time:</b> ".
+ localtime($userinfo{'user.login.time'}).
+ ' <b>Browser</b>: '.$userinfo{'browser.type'}." <b>Client:</b> ".
+ $userinfo{'request.host'}."<br />\n<b>Role: </b>".
+ $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 "<b>Course:</b> ".$coursename; }
+ &add_count('Course',$coursename,$userclass);
+ } else {
+ if (!$justsummary) { print "Not in a course."; }
+ &add_count('Course','No Course',$userclass);
+ }
+ if (!$justsummary) {
+ print "<br /><b>Last Transaction:</b> ".localtime($mtime).
+ " (".$since." secs ago) <br /><b>Last Access:</b> ".
+ localtime($atime)." (".$sinceacc." secs ago)";
+ print ("</font>");
+ }
+ }
+ }
+ closedir(DIR);
+ open (LOADAVGH,"/proc/loadavg");
+ my $loadavg=<LOADAVGH>;
+ close(LOADAVGH);
+ unless ($oneline) {
+ print "<hr /><h2>User Counts</h2>";
+# print "<pre>\n";
+ &showact('Overall',%usercount);
+ &showact('Domain',%usercount);
+ &showact('Course',%usercount);
+ &show('Browser',%usercount);
+
+# print "\n</pre>";
+ print "<b>Load Average:<b> ".$loadavg;
+ print "</body></html>";
+ } else {
+ foreach (sort keys %usercount) {
+ print $_.'='.$usercount{$_}.'&';
+ }
+ print 'loadavg='.$loadavg;
+ }
}
-print "<b>Load Average:<b> ".$loadavg;
-print "</body></html>";
-} else {
-foreach (sort keys %usercount) {
- print $_.'='.$usercount{$_}.'&';
+
+sub show {
+ my ($cat,%usercount)=@_;
+ print("<h3>$cat</h3>\n");
+ foreach my $type (sort(keys(%{$usercount{$cat}}))) {
+ print("<table border='1'><tr><th>$type</th><th>");
+ print(join("</th><th>",sort(keys(%{$usercount{$cat}{$type}}))));
+ my $temp;
+ my $count=0;
+ foreach my $version (sort(keys(%{$usercount{$cat}{$type}}))) {
+ $temp.="<td>".$usercount{$cat}{$type}{$version}.
+ "</td>";
+ $count+=$usercount{$cat}{$type}{$version};
+ }
+ print("</th></tr><tr><td>$count</td>");
+ print($temp."</tr></table>\n");
+ }
}
-print 'loadavg='.$loadavg;
+
+sub showact {
+ my ($cat,%usercount)=@_;
+ print("<h3>$cat</h3>\n");
+
+ print("<table border='1'><tr><th></th><th>");
+ print(join("</th><th>",('Any',@actl)));
+ print("</th></tr>");
+ foreach my $type (sort(keys(%{$usercount{$cat}}))) {
+ print("<tr><td>$type</td>");
+ my $temp;
+ my $count=0;
+ foreach my $activity (@actl) {
+ $temp.="<td> ".$usercount{$cat}{$type}{$activity}."</td>";
+ $count+=$usercount{$cat}{$type}{$activity};
+ }
+ print("<td>$count</td>");
+ print($temp);
+ }
+ print("</tr></table>\n");
}
+
--albertel1062008412--