--- loncom/cgi/userstatus.pl 2003/07/29 20:17:52 1.3 +++ loncom/cgi/userstatus.pl 2006/09/19 21:36:31 1.15 @@ -1,100 +1,228 @@ #!/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; +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 "\n

User 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"; $userclass=$actl[1]; } + if ($since>600) { $color="#444444"; } + if ($since>1800) { $color="#666666"; } + 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 "\n

User Status ".localtime()."

"; } + + 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, + $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) { + if (!tie(%userinfo,'GDBM_File', + $$perlvar{'lonIDsDir'}.'/'.$filename, + &GDBM_READER(),0640)) { + next; + } + if (!$justsummary) { + $users{$userclass}{$filename} .= + ''. + '

'.$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) { + $users{$userclass}{$filename} .= + "Course: ".$coursename; + } + &add_count('Course',$coursename,$userclass); + } else { + if (!$justsummary) { + $users{$userclass}{$filename} .= + "Not in a course."; + } + &add_count('Course','No Course',$userclass); + } + if (!$justsummary) { + $users{$userclass}{$filename} .= + "
Last Transaction: ".localtime($mtime). + " (".$since." secs ago)
Last Access: ". + localtime($atime)." (".$sinceacc." secs ago)". + ""; + } + } + untie(%userinfo); + } + if (!$oneline && !$justsummary) { + foreach my $class (@actl) { + print("\n\n

$class

"); + foreach my $filename (sort(keys(%{$users{$class}}))) { + print("\n\n".$users{$class}{$filename}."\n\n
"); + } + } + } + + 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(""; + $count+=$usercount{$cat}{$type}{$version}; + } + print(""); + print($temp."
$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
\n"); + } } + +sub showact { + my ($cat,%usercount)=@_; + print("

$cat

\n"); + + print(""); + foreach my $type (sort(keys(%{$usercount{$cat}}))) { + print(""); + my $temp; + my $count=0; + foreach my $activity (@actl) { + $temp.=""; + $count+=$usercount{$cat}{$type}{$activity}; + } + print(""); + print($temp); + } + print("
"); + print(join("",('Any',@actl))); + print("
$type ".$usercount{$cat}{$type}{$activity}."$count
\n"); } +