[LON-CAPA-cvs] cvs: loncom /cgi userstatus.pl
raeburn
raeburn@source.lon-capa.org
Fri, 28 Nov 2008 20:45:21 -0000
raeburn Fri Nov 28 20:45:21 2008 EDT
Modified files:
/loncom/cgi userstatus.pl
Log:
- Add localization
- Use routines in LONCAPA::loncgi for access control.
Index: loncom/cgi/userstatus.pl
diff -u loncom/cgi/userstatus.pl:1.16 loncom/cgi/userstatus.pl:1.17
--- loncom/cgi/userstatus.pl:1.16 Tue Oct 2 01:36:31 2007
+++ loncom/cgi/userstatus.pl Fri Nov 28 20:45:21 2008
@@ -1,7 +1,7 @@
#!/usr/bin/perl
$|=1;
# User Status
-# $Id: userstatus.pl,v 1.16 2007/10/02 01:36:31 albertel Exp $
+# $Id: userstatus.pl,v 1.17 2008/11/28 20:45:21 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -26,23 +26,23 @@
# http://www.lon-capa.org/
#
-
use strict;
+
use lib '/home/httpd/lib/perl/';
+use Apache::lonlocal;
use LONCAPA::Configuration;
-use LONCAPA;
+use LONCAPA::loncgi;
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');
-
-print "Content-type: text/html\n\n";
-
-# -------------------- Read loncapa.conf (and by default, loncapa_apache.conf).
-&main();
+&main($perlvar);
sub analyze_time {
my ($since)=@_;
@@ -68,13 +68,61 @@
}
sub main {
- my $perlvar=LONCAPA::Configuration::read_conf('loncapa.conf');
+ my ($perlvar) = @_;
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 "<html><body bgcolor=#FFFFFF>\n<h1>User Status ".localtime()."</h1>"; }
+ if (!&LONCAPA::loncgi::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::loncgi::can_view('userstatus')) {
+ &Apache::lonlocal::get_language_handle();
+ print &LONCAPA::loncgi::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'});
my @allfiles=(sort(readdir(DIR)));
@@ -113,11 +161,11 @@
$userinfo{'user.name'}."\@".$userinfo{'user.domain'}.
")</h3>\n".
"<p><tt>$filename</tt></p>".
- "<b>Login time:</b> ".
- localtime($userinfo{'user.login.time'}).
- ' <b>Browser</b>: '.$userinfo{'browser.type'}.
- " on ".$userinfo{'browser.os'}."<b>Client:</b> ".
- $userinfo{'request.host'}."<br />\n<b>Role: </b>".
+ "<b>$lt{'login'}:</b> ".
+ &Apache::lonlocal::locallocaltime($userinfo{'user.login.time'}).
+ " <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'}." ";
}
&add_count('Browser',$userinfo{'browser.type'},$userinfo{'browser.version'});
@@ -128,21 +176,20 @@
' ('.$cid.')';
if (!$justsummary) {
$users{$userclass}{$filename} .=
- "<b>Course:</b> ".$coursename;
+ "<b>$lt{'Course'}:</b> ".$coursename;
}
&add_count('Course',$coursename,$userclass);
} else {
if (!$justsummary) {
- $users{$userclass}{$filename} .=
- "Not in a course.";
+ $users{$userclass}{$filename} .= $lt{'notc'};
}
&add_count('Course','No Course',$userclass);
}
if (!$justsummary) {
$users{$userclass}{$filename} .=
- "<br /><b>Last Transaction:</b> ".localtime($mtime).
- " (".$since." secs ago) <br /><b>Last Access:</b> ".
- localtime($atime)." (".$sinceacc." secs ago)".
+ "<br /><b>$lt{'ltra'}:</b> ".&Apache::lonlocal::locallocaltime($mtime).
+ " (".$since." $lt{'secs'}) <br /><b>$lt{'lacc'}:</b> ".
+ &Apache::lonlocal::locallocaltime($atime)." (".$sinceacc." $lt{'secs'})".
"</font>";
}
}
@@ -150,7 +197,7 @@
}
if (!$oneline && !$justsummary) {
foreach my $class (@actl) {
- print("\n\n<hr /><h1>$class</h1>");
+ print("\n\n<hr /><h1>$lt{$class}</h1>");
foreach my $filename (sort(keys(%{$users{$class}}))) {
print("\n\n".$users{$class}{$filename}."\n\n<hr />");
}
@@ -162,16 +209,16 @@
my $loadavg=<LOADAVGH>;
close(LOADAVGH);
unless ($oneline) {
- print "<hr /><h2>User Counts</h2>";
+ print "<hr /><h2>$lt{'usrc'}</h2>";
# print "<pre>\n";
- &showact('Overall',%usercount);
- &showact('Domain',%usercount);
- &showact('Course',%usercount);
- &show('Browser',%usercount);
- &show('OS',%usercount);
+ &showact('Overall',\%lt,%usercount);
+ &showact('Domain',\%lt,%usercount);
+ &showact('Course',\%lt,%usercount);
+ &show('Browser',\%lt,%usercount);
+ &show('OS',\%lt,%usercount);
# print "\n</pre>";
- print "<b>Load Average:<b> ".$loadavg;
+ print "<b>$lt{'load'}:<b> ".$loadavg;
print "</body></html>";
} else {
foreach my $l1 (sort keys %usercount) {
@@ -190,8 +237,8 @@
}
sub show {
- my ($cat,%usercount)=@_;
- print("<h3>$cat</h3>\n");
+ my ($cat,$ltref,%usercount)=@_;
+ print("<h3>$ltref->{$cat}</h3>\n");
foreach my $type (sort(keys(%{$usercount{$cat}}))) {
print("<table border='1'><tr><th>$type</th><th>");
print(join("</th><th>",sort(keys(%{$usercount{$cat}{$type}}))));
@@ -208,8 +255,8 @@
}
sub showact {
- my ($cat,%usercount)=@_;
- print("<h3>$cat</h3>\n");
+ my ($cat,$ltref,%usercount)=@_;
+ print("<h3>$ltref->{$cat}</h3>\n");
print("<table border='1'><tr><th></th><th>");
print(join("</th><th>",('Any',@actl)));