#!/usr/bin/perl
$|=1;
# User Status
# $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).
&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}++;
}
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;
}
}
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");
}