--- loncom/cgi/userstatus.pl 2003/07/29 20:17:52 1.3
+++ loncom/cgi/userstatus.pl 2004/09/22 15:00:04 1.11
@@ -1,100 +1,210 @@
#!/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.11 2004/09/22 15:00:04 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 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>1800) { $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);
-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;
+ ($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) {
+ my $fh=IO::File->new($$perlvar{'lonIDsDir'}.'/'.$filename);
+ while (my $line=<$fh>) {
+ chomp($line);
+ my ($name,$value)=split(/\=/,$line);
+ $userinfo{$name}=$value;
+ }
+ $fh->close();
+ 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'}.
+ " on ".$userinfo{'browser.os'}."Client: ".
+ $userinfo{'request.host'}."
\nRole: ".
+ $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 "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);
+ &show('OS',%usercount);
+
+# print "\n
";
+ print "Load Average: ".$loadavg;
+ print "";
+ } else {
+ 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;
+ }
}
-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");
+ }
}
+
+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");
}
+