--- loncom/cgi/userstatus.pl	2003/08/27 18:20:11	1.5
+++ loncom/cgi/userstatus.pl	2006/09/19 21:36:31	1.15
@@ -1,18 +1,38 @@
 #!/usr/bin/perl
 $|=1;
-# The LearningOnline Network with CAPA
 # User Status
-# (Versions
-# (Running loncron
-# 09/06/01 Gerd Kortemeyer)
-# 02/18/02,02/19/02 Gerd Kortemeyer)
+# $Id: userstatus.pl,v 1.15 2006/09/19 21:36:31 albertel Exp $
+#
+# Copyright Michigan State University Board of Trustees
+#
+# This file is part of the LearningOnline Network with CAPA (LON-CAPA).
+#
+# LON-CAPA is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# LON-CAPA is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with LON-CAPA; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+#
+# /home/httpd/html/adm/gpl.txt
+#
+# http://www.lon-capa.org/
+#
+
 
 use strict;
 use lib '/home/httpd/lib/perl/';
 use LONCAPA::Configuration;
-
+use LONCAPA;
 use HTTP::Headers;
-use IO::File;
+use GDBM_File;
 
 
 my %usercount;
@@ -28,9 +48,9 @@ sub analyze_time {
     my ($since)=@_;
     my $color="#000000";
     my $userclass=$actl[0];
-    if ($since>300) { $color="#222222"; }
+    if ($since>300) { $color="#222222"; $userclass=$actl[1]; }
     if ($since>600) { $color="#444444"; }
-    if ($since>3600) { $color="#666666"; $userclass=$actl[1]; }
+    if ($since>1800) { $color="#666666"; }
     if ($since>7200) { $color="#888888"; }
     if ($since>21600) { $color="#AAAAAA"; $userclass=$actl[2]; }
     return ($color,$userclass);
@@ -58,8 +78,10 @@ sub main {
 
     opendir(DIR,$$perlvar{'lonIDsDir'});
     my @allfiles=(sort(readdir(DIR)));
+    my %users;
     foreach my $filename (@allfiles) {
 	if ($filename=~/^\./) { next; }
+	if ($filename=~/^publicuser_/) { next; }
 	my ($dev,$ino,$mode,$nlink,
 	    $uid,$gid,$rdev,$size,
 	    $atime,$mtime,$ctime,
@@ -67,52 +89,72 @@ sub main {
 	my $now=time;
 	my $since=$now-$mtime;
 	my $sinceacc=$now-$atime;
-	unless ($oneline || $justsummary) { print ("\n\n<hr />"); }
+	#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();
+	($userinfo{'user.name'},undef,$userinfo{'user.domain'})=
+	    split('_',$filename);
 	my ($color,$userclass)=&analyze_time($since);
 	&add_count('Overall','all',$userclass);
 	&add_count('Domain',$userinfo{'user.domain'},$userclass);
 	
 	unless ($oneline) {
+	    if (!tie(%userinfo,'GDBM_File',
+		     $$perlvar{'lonIDsDir'}.'/'.$filename,
+		     &GDBM_READER(),0640)) {
+		next;
+	    }
 	    if (!$justsummary) {
-		print '<font color="'.$color.'">';
-		print '<h3>'.$userinfo{'environment.lastname'}.', '.
+		$users{$userclass}{$filename} .=
+		    '<font color="'.$color.'">'.
+		    '<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> ".
+		    ' <b>Browser</b>: '.$userinfo{'browser.type'}.
+		    " on ".$userinfo{'browser.os'}."<b>Client:</b> ".
 		    $userinfo{'request.host'}."<br />\n<b>Role: </b>".
 		    $userinfo{'request.role'}." ";
 	    }
 	    &add_count('Browser',$userinfo{'browser.type'},$userinfo{'browser.version'});
+	    &add_count('OS',$userinfo{'browser.os'},$userinfo{'browser.type'});
 	    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; }
+		if (!$justsummary) { 
+		    $users{$userclass}{$filename} .= 
+			"<b>Course:</b> ".$coursename; 
+		}
 		&add_count('Course',$coursename,$userclass);
 	    } else {
-		if (!$justsummary) { print "Not in a course."; }
+		if (!$justsummary) {
+		    $users{$userclass}{$filename} .= 
+			"Not in a course.";
+		}
 		&add_count('Course','No Course',$userclass);
 	    }
 	    if (!$justsummary) {
-		print "<br /><b>Last Transaction:</b> ".localtime($mtime).
+		$users{$userclass}{$filename} .=
+		    "<br /><b>Last Transaction:</b> ".localtime($mtime).
 		    " (".$since." secs ago) <br /><b>Last Access:</b> ".
-		    localtime($atime)." (".$sinceacc." secs ago)";
-		print ("</font>"); 
+		    localtime($atime)." (".$sinceacc." secs ago)".
+		    "</font>";
+	    }
+	}
+	untie(%userinfo);
+    }
+    if (!$oneline && !$justsummary) {
+       	foreach my $class (@actl) {
+	    print("\n\n<hr /><h1>$class</h1>");    
+	    foreach my $filename (sort(keys(%{$users{$class}}))) {
+		print("\n\n".$users{$class}{$filename}."\n\n<hr />");    
 	    }
 	}
     }
+
     closedir(DIR);
     open (LOADAVGH,"/proc/loadavg");
     my $loadavg=<LOADAVGH>;
@@ -124,13 +166,22 @@ sub main {
 	&showact('Domain',%usercount);
 	&showact('Course',%usercount);
 	&show('Browser',%usercount);
+	&show('OS',%usercount);
 
 #	print "\n</pre>";
 	print "<b>Load Average:<b> ".$loadavg;
 	print "</body></html>";
     } else {
-	foreach (sort keys %usercount) {
-	    print $_.'='.$usercount{$_}.'&';
+	foreach my $l1 (sort keys %usercount) {
+	    foreach my $l2 (sort keys %{$usercount{$l1}}) {
+		foreach my $l3 (sort keys %{$usercount{$l1}{$l2}}) {
+		    print $l1.'_'.$l2.'_'.$l3.'='.$usercount{$l1}{$l2}{$l3}.'&';
+		}
+	    }
+	}
+	#clusterstatus values
+	foreach my $act (@actl) {
+	    print "$act=".$usercount{'Overall'}{'all'}{$act}.'&';
 	}
 	print 'loadavg='.$loadavg;
     }