version 1.13, 2006/06/02 21:36:21
|
version 1.18, 2008/12/25 01:56:03
|
Line 26 $|=1;
|
Line 26 $|=1;
|
# http://www.lon-capa.org/ |
# http://www.lon-capa.org/ |
# |
# |
|
|
|
|
use strict; |
use strict; |
|
|
use lib '/home/httpd/lib/perl/'; |
use lib '/home/httpd/lib/perl/'; |
|
use Apache::lonlocal; |
use LONCAPA::Configuration; |
use LONCAPA::Configuration; |
use LONCAPA; |
use LONCAPA::loncgi; |
|
use LONCAPA::lonauthcgi; |
use HTTP::Headers; |
use HTTP::Headers; |
use IO::File; |
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 %usercount; |
my @actl=('Active','Moderately Active','Inactive'); |
my @actl=('Active','Moderately Active','Inactive'); |
|
|
|
&main($perlvar); |
print "Content-type: text/html\n\n"; |
|
|
|
# -------------------- Read loncapa.conf (and by default, loncapa_apache.conf). |
|
&main(); |
|
|
|
sub analyze_time { |
sub analyze_time { |
my ($since)=@_; |
my ($since)=@_; |
my $color="#000000"; |
my $color="#000000"; |
my $userclass=$actl[0]; |
my $userclass=$actl[0]; |
if ($since>300) { $color="#222222"; } |
if ($since>300) { $color="#222222"; $userclass=$actl[1]; } |
if ($since>600) { $color="#444444"; } |
if ($since>600) { $color="#444444"; } |
if ($since>1800) { $color="#666666"; $userclass=$actl[1]; } |
if ($since>1800) { $color="#666666"; } |
if ($since>7200) { $color="#888888"; } |
if ($since>7200) { $color="#888888"; } |
if ($since>21600) { $color="#AAAAAA"; $userclass=$actl[2]; } |
if ($since>21600) { $color="#AAAAAA"; $userclass=$actl[2]; } |
return ($color,$userclass); |
return ($color,$userclass); |
Line 68 sub add_count {
|
Line 69 sub add_count {
|
} |
} |
|
|
sub main { |
sub main { |
my $perlvar=LONCAPA::Configuration::read_conf('loncapa.conf'); |
my ($perlvar) = @_; |
delete $$perlvar{'lonReceipt'}; # remove since sensitive and not needed |
delete $$perlvar{'lonReceipt'}; # remove since sensitive and not needed |
delete $$perlvar{'lonSqlAccess'}; # remove since sensitive and not needed |
delete $$perlvar{'lonSqlAccess'}; # remove since sensitive and not needed |
|
|
my $oneline=($ENV{'QUERY_STRING'} eq 'simple'); |
if (!&LONCAPA::lonauthcgi::check_ipbased_access()) { |
my $justsummary=($ENV{'QUERY_STRING'} eq 'summary'); |
if (!&LONCAPA::loncgi::check_cookie_and_load_env()) { |
unless ($oneline) { print "<html><body bgcolor=#FFFFFF>\n<h1>User Status ".localtime()."</h1>"; } |
&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 '<html><body bgcolor="#FFFFFF">'."\n". |
|
"<h1>$lt{'usrs'} ".&Apache::lonlocal::locallocaltime($now).'</h1>'; |
|
} |
|
|
opendir(DIR,$$perlvar{'lonIDsDir'}); |
opendir(DIR,$$perlvar{'lonIDsDir'}); |
my @allfiles=(sort(readdir(DIR))); |
my @allfiles=(sort(readdir(DIR))); |
|
my %users; |
foreach my $filename (@allfiles) { |
foreach my $filename (@allfiles) { |
if ($filename=~/^\./) { next; } |
if ($filename=~/^\./) { next; } |
if ($filename=~/^publicuser_/) { next; } |
if ($filename=~/^publicuser_/) { next; } |
Line 88 sub main {
|
Line 138 sub main {
|
my $now=time; |
my $now=time; |
my $since=$now-$mtime; |
my $since=$now-$mtime; |
my $sinceacc=$now-$atime; |
my $sinceacc=$now-$atime; |
unless ($oneline || $justsummary) { print ("\n\n<hr />"); } |
#unless ($oneline || $justsummary) { print ("\n\n<hr />"); } |
my %userinfo; |
my %userinfo; |
($userinfo{'user.name'},undef,$userinfo{'user.domain'})= |
($userinfo{'user.name'},undef,$userinfo{'user.domain'})= |
split('_',$filename); |
split('_',$filename); |
Line 97 sub main {
|
Line 147 sub main {
|
&add_count('Domain',$userinfo{'user.domain'},$userclass); |
&add_count('Domain',$userinfo{'user.domain'},$userclass); |
|
|
unless ($oneline) { |
unless ($oneline) { |
my $fh=IO::File->new($$perlvar{'lonIDsDir'}.'/'.$filename); |
if (!tie(%userinfo,'GDBM_File', |
while (my $line=<$fh>) { |
$$perlvar{'lonIDsDir'}.'/'.$filename, |
chomp($line); |
&GDBM_READER(),0640)) { |
my ($name,$value)=split(/\=/,$line); |
next; |
$name = &unescape($name); |
|
$value = &unescape($value); |
|
$userinfo{$name}=$value; |
|
} |
} |
$fh->close(); |
|
if (!$justsummary) { |
if (!$justsummary) { |
print '<font color="'.$color.'">'; |
$users{$userclass}{$filename} .= |
print '<h3>'.$userinfo{'environment.lastname'}.', '. |
'<font color="'.$color.'">'. |
|
'<h3>'.$userinfo{'environment.lastname'}.', '. |
$userinfo{'environment.firstname'}.' '. |
$userinfo{'environment.firstname'}.' '. |
$userinfo{'environment.middlename'}.' '. |
$userinfo{'environment.middlename'}.' '. |
$userinfo{'environment.generation'}." (". |
$userinfo{'environment.generation'}." (". |
$userinfo{'user.name'}."\@".$userinfo{'user.domain'}. |
$userinfo{'user.name'}."\@".$userinfo{'user.domain'}. |
")</h3>\n<b>Login time:</b> ". |
")</h3>\n". |
localtime($userinfo{'user.login.time'}). |
"<p><tt>$filename</tt></p>". |
' <b>Browser</b>: '.$userinfo{'browser.type'}. |
"<b>$lt{'login'}:</b> ". |
" on ".$userinfo{'browser.os'}."<b>Client:</b> ". |
&Apache::lonlocal::locallocaltime($userinfo{'user.login.time'}). |
$userinfo{'request.host'}."<br />\n<b>Role: </b>". |
" <b>$lt{'Browser'}</b>: ".$userinfo{'browser.type'}. |
|
" $lt{'on'} ".$userinfo{'browser.os'}."<b>$lt{'Client'}:</b>". |
|
$userinfo{'request.host'}."<br />\n<b>$lt{'role'}: </b>". |
$userinfo{'request.role'}." "; |
$userinfo{'request.role'}." "; |
} |
} |
&add_count('Browser',$userinfo{'browser.type'},$userinfo{'browser.version'}); |
&add_count('Browser',$userinfo{'browser.type'},$userinfo{'browser.version'}); |
Line 126 sub main {
|
Line 175 sub main {
|
my $cid=$userinfo{'request.course.id'}; |
my $cid=$userinfo{'request.course.id'}; |
my $coursename= $userinfo{'course.'.$cid.'.description'}. |
my $coursename= $userinfo{'course.'.$cid.'.description'}. |
' ('.$cid.')'; |
' ('.$cid.')'; |
if (!$justsummary) { print "<b>Course:</b> ".$coursename; } |
if (!$justsummary) { |
|
$users{$userclass}{$filename} .= |
|
"<b>$lt{'Course'}:</b> ".$coursename; |
|
} |
&add_count('Course',$coursename,$userclass); |
&add_count('Course',$coursename,$userclass); |
} else { |
} else { |
if (!$justsummary) { print "Not in a course."; } |
if (!$justsummary) { |
|
$users{$userclass}{$filename} .= $lt{'notc'}; |
|
} |
&add_count('Course','No Course',$userclass); |
&add_count('Course','No Course',$userclass); |
} |
} |
if (!$justsummary) { |
if (!$justsummary) { |
print "<br /><b>Last Transaction:</b> ".localtime($mtime). |
$users{$userclass}{$filename} .= |
" (".$since." secs ago) <br /><b>Last Access:</b> ". |
"<br /><b>$lt{'ltra'}:</b> ".&Apache::lonlocal::locallocaltime($mtime). |
localtime($atime)." (".$sinceacc." secs ago)"; |
" (".$since." $lt{'secs'}) <br /><b>$lt{'lacc'}:</b> ". |
print ("</font>"); |
&Apache::lonlocal::locallocaltime($atime)." (".$sinceacc." $lt{'secs'})". |
|
"</font>"; |
} |
} |
} |
} |
|
untie(%userinfo); |
} |
} |
|
if (!$oneline && !$justsummary) { |
|
foreach my $class (@actl) { |
|
print("\n\n<hr /><h1>$lt{$class}</h1>"); |
|
foreach my $filename (sort(keys(%{$users{$class}}))) { |
|
print("\n\n".$users{$class}{$filename}."\n\n<hr />"); |
|
} |
|
} |
|
} |
|
|
closedir(DIR); |
closedir(DIR); |
open (LOADAVGH,"/proc/loadavg"); |
open (LOADAVGH,"/proc/loadavg"); |
my $loadavg=<LOADAVGH>; |
my $loadavg=<LOADAVGH>; |
close(LOADAVGH); |
close(LOADAVGH); |
unless ($oneline) { |
unless ($oneline) { |
print "<hr /><h2>User Counts</h2>"; |
print "<hr /><h2>$lt{'usrc'}</h2>"; |
# print "<pre>\n"; |
# print "<pre>\n"; |
&showact('Overall',%usercount); |
&showact('Overall',\%lt,%usercount); |
&showact('Domain',%usercount); |
&showact('Domain',\%lt,%usercount); |
&showact('Course',%usercount); |
&showact('Course',\%lt,%usercount); |
&show('Browser',%usercount); |
&show('Browser',\%lt,%usercount); |
&show('OS',%usercount); |
&show('OS',\%lt,%usercount); |
|
|
# print "\n</pre>"; |
# print "\n</pre>"; |
print "<b>Load Average:<b> ".$loadavg; |
print "<b>$lt{'load'}:<b> ".$loadavg; |
print "</body></html>"; |
print "</body></html>"; |
} else { |
} else { |
foreach my $l1 (sort keys %usercount) { |
foreach my $l1 (sort keys %usercount) { |
Line 173 sub main {
|
Line 238 sub main {
|
} |
} |
|
|
sub show { |
sub show { |
my ($cat,%usercount)=@_; |
my ($cat,$ltref,%usercount)=@_; |
print("<h3>$cat</h3>\n"); |
print("<h3>$ltref->{$cat}</h3>\n"); |
foreach my $type (sort(keys(%{$usercount{$cat}}))) { |
foreach my $type (sort(keys(%{$usercount{$cat}}))) { |
print("<table border='1'><tr><th>$type</th><th>"); |
print("<table border='1'><tr><th>$type</th><th>"); |
print(join("</th><th>",sort(keys(%{$usercount{$cat}{$type}})))); |
print(join("</th><th>",sort(keys(%{$usercount{$cat}{$type}})))); |
Line 191 sub show {
|
Line 256 sub show {
|
} |
} |
|
|
sub showact { |
sub showact { |
my ($cat,%usercount)=@_; |
my ($cat,$ltref,%usercount)=@_; |
print("<h3>$cat</h3>\n"); |
print("<h3>$ltref->{$cat}</h3>\n"); |
|
|
print("<table border='1'><tr><th></th><th>"); |
print("<table border='1'><tr><th></th><th>"); |
print(join("</th><th>",('Any',@actl))); |
print(join("</th><th>",('Any',@actl))); |