#!/usr/bin/perl $|=1; # User Status # $Id: userstatus.pl,v 1.18 2008/12/25 01:56:03 raeburn 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 Apache::lonlocal; use LONCAPA::Configuration; use LONCAPA::loncgi; use LONCAPA::lonauthcgi; use HTTP::Headers; use GDBM_File; # -------------------- Read loncapa.conf (and by default, loncapa_apache.conf). my $perlvar=&LONCAPA::Configuration::read_conf('loncapa.conf'); print "Content-type: text/html\n\n"; my %usercount; my @actl=('Active','Moderately Active','Inactive'); &main($perlvar); 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) = @_; delete $$perlvar{'lonReceipt'}; # remove since sensitive and not needed delete $$perlvar{'lonSqlAccess'}; # remove since sensitive and not needed if (!&LONCAPA::lonauthcgi::check_ipbased_access()) { if (!&LONCAPA::loncgi::check_cookie_and_load_env()) { &Apache::lonlocal::get_language_handle(); print &LONCAPA::loncgi::missing_cookie_msg(); return; } if (!&LONCAPA::lonauthcgi::can_view('userstatus')) { &Apache::lonlocal::get_language_handle(); print &LONCAPA::lonauthcgi::unauthorized_msg('userstatus'); return; } } &Apache::lonlocal::get_language_handle(); my (%gets,$dom,$oneline,$justsummary); &LONCAPA::loncgi::cgi_getitems($ENV{'QUERY_STRING'},\%gets); if (defined($gets{'simple'})) { $oneline = 'simple'; } if (defined($gets{'summary'})) { $justsummary = 'summary'; } my %lt = &Apache::lonlocal::texthash( usrs => 'User Status', login => 'Login time', on => 'on', Client => 'Client', role => 'Role', notc => 'Not in a course', ltra => 'Last Transaction', lacc => 'Last Access', secs => 'secs ago', usrc => 'User Counts', load => 'Load Average', Overall => 'Overall', Domain => 'Domain', Course => 'Course', Browser => 'Browser', OS => 'OS', Active => 'Active', 'Moderately Active' => 'Moderately Active', Inactive => 'Inactive', ); unless ($oneline) { my $now = time(); print '
'."\n". "$filename
". "$lt{'login'}: ". &Apache::lonlocal::locallocaltime($userinfo{'user.login.time'}). " $lt{'Browser'}: ".$userinfo{'browser.type'}. " $lt{'on'} ".$userinfo{'browser.os'}."$lt{'Client'}:". $userinfo{'request.host'}."\n"; &showact('Overall',\%lt,%usercount); &showact('Domain',\%lt,%usercount); &showact('Course',\%lt,%usercount); &show('Browser',\%lt,%usercount); &show('OS',\%lt,%usercount); # print "\n"; print "$lt{'load'}: ".$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,$ltref,%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("