#!/usr/bin/perl $|=1; # User Status # $Id: userstatus.pl,v 1.16 2007/10/02 01: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 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). &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}++; } 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$filename
". "Login time: ". localtime($userinfo{'user.login.time'}). ' Browser: '.$userinfo{'browser.type'}. " on ".$userinfo{'browser.os'}."Client: ". $userinfo{'request.host'}."\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("
$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."
"); print(join(" | ",('Any',@actl))); 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("