loncom/cgi/userstatus.pl - view

File: [LON-CAPA] / loncom / cgi / userstatus.pl
Revision 1.20: download - view: text, annotated - select for diffs
Tue Mar 23 12:01:49 2010 UTC (14 years, 1 month ago) by bisitz
Branches: MAIN
CVS tags: version_2_11_2_uiuc, version_2_11_2_msu, version_2_11_2_educog, version_2_11_2, version_2_11_1, version_2_11_0_RC3, version_2_11_0_RC2, version_2_11_0_RC1, version_2_11_0, version_2_10_X, version_2_10_1, version_2_10_0_RC2, version_2_10_0_RC1, version_2_10_0, loncapaMITrelate_1, language_hyphenation_merge, language_hyphenation, PRINT_INCOMPLETE_base, PRINT_INCOMPLETE, HEAD, BZ4492-merge, BZ4492-feature_horizontal_radioresponse, BZ4492-feature_Support_horizontal_radioresponse, BZ4492-Support_horizontal_radioresponse

- XHTML:
    - Page header
    - Replaced font tag and bgcolor attribute by corresponding style attribute
    - Empty table header cell
- Corrected unbalanced tags
   - Summary table (</tr> moved inside loop)
   - Load average (</b> close, not open)
- Added missing white space in user data

1: #!/usr/bin/perl 2: $|=1; 3: # User Status 4: # $Id: userstatus.pl,v 1.20 2010/03/23 12:01:49 bisitz Exp $ 5: # 6: # Copyright Michigan State University Board of Trustees 7: # 8: # This file is part of the LearningOnline Network with CAPA (LON-CAPA). 9: # 10: # LON-CAPA is free software; you can redistribute it and/or modify 11: # it under the terms of the GNU General Public License as published by 12: # the Free Software Foundation; either version 2 of the License, or 13: # (at your option) any later version. 14: # 15: # LON-CAPA is distributed in the hope that it will be useful, 16: # but WITHOUT ANY WARRANTY; without even the implied warranty of 17: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 18: # GNU General Public License for more details. 19: # 20: # You should have received a copy of the GNU General Public License 21: # along with LON-CAPA; if not, write to the Free Software 22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 23: # 24: # /home/httpd/html/adm/gpl.txt 25: # 26: # http://www.lon-capa.org/ 27: # 28: 29: use strict; 30: 31: use lib '/home/httpd/lib/perl/'; 32: use Apache::lonlocal; 33: use LONCAPA::Configuration; 34: use LONCAPA::loncgi; 35: use LONCAPA::lonauthcgi; 36: use HTTP::Headers; 37: use GDBM_File; 38: 39: # -------------------- Read loncapa.conf (and by default, loncapa_apache.conf). 40: my $perlvar=&LONCAPA::Configuration::read_conf('loncapa.conf'); 41: 42: print "Content-type: text/html\n\n"; 43: my %usercount; 44: my @actl=('Active','Moderately Active','Inactive'); 45: 46: &main($perlvar); 47: 48: sub analyze_time { 49: my ($since)=@_; 50: my $color="#000000"; 51: my $userclass=$actl[0]; 52: if ($since>300) { $color="#222222"; $userclass=$actl[1]; } 53: if ($since>600) { $color="#444444"; } 54: if ($since>1800) { $color="#666666"; } 55: if ($since>7200) { $color="#888888"; } 56: if ($since>21600) { $color="#AAAAAA"; $userclass=$actl[2]; } 57: return ($color,$userclass); 58: } 59: 60: sub add_count { 61: my ($cat,$scope,$class)=@_; 62: if (!defined($usercount{$cat})) { 63: $usercount{$cat}={}; 64: } 65: if (!defined($usercount{$cat}{$scope})) { 66: $usercount{$cat}{$scope}={}; 67: } 68: $usercount{$cat}{$scope}{$class}++; 69: } 70: 71: sub main { 72: my ($perlvar) = @_; 73: delete $$perlvar{'lonReceipt'}; # remove since sensitive and not needed 74: delete $$perlvar{'lonSqlAccess'}; # remove since sensitive and not needed 75: 76: if (!&LONCAPA::lonauthcgi::check_ipbased_access('userstatus')) { 77: if (!&LONCAPA::loncgi::check_cookie_and_load_env()) { 78: &Apache::lonlocal::get_language_handle(); 79: print &LONCAPA::loncgi::missing_cookie_msg(); 80: return; 81: } 82: 83: if (!&LONCAPA::lonauthcgi::can_view('userstatus')) { 84: &Apache::lonlocal::get_language_handle(); 85: print &LONCAPA::lonauthcgi::unauthorized_msg('userstatus'); 86: return; 87: } 88: } 89: 90: &Apache::lonlocal::get_language_handle(); 91: my (%gets,$dom,$oneline,$justsummary); 92: &LONCAPA::loncgi::cgi_getitems($ENV{'QUERY_STRING'},\%gets); 93: if (defined($gets{'simple'})) { 94: $oneline = 'simple'; 95: } 96: if (defined($gets{'summary'})) { 97: $justsummary = 'summary'; 98: } 99: 100: my %lt = &Apache::lonlocal::texthash( 101: usrs => 'User Status', 102: login => 'Login time', 103: on => 'on', 104: Client => 'Client', 105: role => 'Role', 106: notc => 'Not in a course', 107: ltra => 'Last Transaction', 108: lacc => 'Last Access', 109: secs => 'secs ago', 110: usrc => 'User Counts', 111: load => 'Load Average', 112: Overall => 'Overall', 113: Domain => 'Domain', 114: Course => 'Course', 115: Browser => 'Browser', 116: OS => 'OS', 117: Active => 'Active', 118: 'Moderately Active' => 'Moderately Active', 119: Inactive => 'Inactive', 120: ); 121: 122: unless ($oneline) { 123: my $now = time(); 124: print '<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">'."\n". 125: '<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">'."\n"."\n". 126: '<head>'."\n". 127: '<meta http-equiv="Content-Type" content="text/html; charset=utf-8" />'."\n". 128: '<title>LON-CAPA '.$lt{'usrs'}.'</title>'."\n". 129: '</head>'."\n". 130: '<body style="background-color:#FFFFFF">'."\n". 131: "<h1>$lt{'usrs'} ".&Apache::lonlocal::locallocaltime($now).'</h1>'; 132: } 133: 134: opendir(DIR,$$perlvar{'lonIDsDir'}); 135: my @allfiles=(sort(readdir(DIR))); 136: my %users; 137: foreach my $filename (@allfiles) { 138: if ($filename=~/^\./) { next; } 139: if ($filename=~/^publicuser_/) { next; } 140: my ($dev,$ino,$mode,$nlink, 141: $uid,$gid,$rdev,$size, 142: $atime,$mtime,$ctime, 143: $blksize,$blocks)=stat($$perlvar{'lonIDsDir'}.'/'.$filename); 144: my $now=time; 145: my $since=$now-$mtime; 146: my $sinceacc=$now-$atime; 147: #unless ($oneline || $justsummary) { print ("\n\n<hr />"); } 148: my %userinfo; 149: ($userinfo{'user.name'},undef,$userinfo{'user.domain'})= 150: split('_',$filename); 151: my ($color,$userclass)=&analyze_time($since); 152: &add_count('Overall','all',$userclass); 153: &add_count('Domain',$userinfo{'user.domain'},$userclass); 154: 155: unless ($oneline) { 156: if (!tie(%userinfo,'GDBM_File', 157: $$perlvar{'lonIDsDir'}.'/'.$filename, 158: &GDBM_READER(),0640)) { 159: next; 160: } 161: if (!$justsummary) { 162: $users{$userclass}{$filename} .= 163: '<div style="color:'.$color.'">'. 164: '<h3>'.$userinfo{'environment.lastname'}.', '. 165: $userinfo{'environment.firstname'}.' '. 166: $userinfo{'environment.middlename'}.' '. 167: $userinfo{'environment.generation'}." (". 168: $userinfo{'user.name'}.":".$userinfo{'user.domain'}. 169: ")</h3>\n". 170: "<p><tt>$filename</tt></p>". 171: "<b>$lt{'login'}:</b> ". 172: &Apache::lonlocal::locallocaltime($userinfo{'user.login.time'}). 173: " <b>$lt{'Browser'}</b>: ".$userinfo{'browser.type'}. 174: " $lt{'on'} ".$userinfo{'browser.os'}." <b>$lt{'Client'}:</b>". 175: $userinfo{'request.host'}."<br />\n<b>$lt{'role'}: </b>". 176: $userinfo{'request.role'}." "; 177: } 178: &add_count('Browser',$userinfo{'browser.type'},$userinfo{'browser.version'}); 179: &add_count('OS',$userinfo{'browser.os'},$userinfo{'browser.type'}); 180: if ($userinfo{'request.course.id'}) { 181: my $cid=$userinfo{'request.course.id'}; 182: my $coursename= $userinfo{'course.'.$cid.'.description'}. 183: ' ('.$cid.')'; 184: if (!$justsummary) { 185: $users{$userclass}{$filename} .= 186: "<b>$lt{'Course'}:</b> ".$coursename; 187: } 188: &add_count('Course',$coursename,$userclass); 189: } else { 190: if (!$justsummary) { 191: $users{$userclass}{$filename} .= $lt{'notc'}; 192: } 193: &add_count('Course','No Course',$userclass); 194: } 195: if (!$justsummary) { 196: $users{$userclass}{$filename} .= 197: "<br /><b>$lt{'ltra'}:</b> ".&Apache::lonlocal::locallocaltime($mtime). 198: " (".$since." $lt{'secs'}) <br /><b>$lt{'lacc'}:</b> ". 199: &Apache::lonlocal::locallocaltime($atime)." (".$sinceacc." $lt{'secs'})". 200: "</div>"; 201: } 202: } 203: untie(%userinfo); 204: } 205: if (!$oneline && !$justsummary) { 206: foreach my $class (@actl) { 207: print("\n\n<hr /><h1>$lt{$class}</h1>"); 208: foreach my $filename (sort(keys(%{$users{$class}}))) { 209: print("\n\n".$users{$class}{$filename}."\n\n<hr />"); 210: } 211: } 212: } 213: 214: closedir(DIR); 215: open (LOADAVGH,"/proc/loadavg"); 216: my $loadavg=<LOADAVGH>; 217: close(LOADAVGH); 218: unless ($oneline) { 219: print "<hr /><h2>$lt{'usrc'}</h2>"; 220: # print "<pre>\n"; 221: &showact('Overall',\%lt,%usercount); 222: &showact('Domain',\%lt,%usercount); 223: &showact('Course',\%lt,%usercount); 224: &show('Browser',\%lt,%usercount); 225: &show('OS',\%lt,%usercount); 226: 227: # print "\n</pre>"; 228: print "<b>$lt{'load'}:</b> ".$loadavg; 229: print "</body></html>"; 230: } else { 231: foreach my $l1 (sort keys %usercount) { 232: foreach my $l2 (sort keys %{$usercount{$l1}}) { 233: foreach my $l3 (sort keys %{$usercount{$l1}{$l2}}) { 234: print $l1.'_'.$l2.'_'.$l3.'='.$usercount{$l1}{$l2}{$l3}.'&'; 235: } 236: } 237: } 238: #clusterstatus values 239: foreach my $act (@actl) { 240: print "$act=".$usercount{'Overall'}{'all'}{$act}.'&'; 241: } 242: print 'loadavg='.$loadavg; 243: } 244: } 245: 246: sub show { 247: my ($cat,$ltref,%usercount)=@_; 248: print("<h3>$ltref->{$cat}</h3>\n"); 249: foreach my $type (sort(keys(%{$usercount{$cat}}))) { 250: print("<table border='1'><tr><th>$type</th><th>"); 251: print(join("</th><th>",sort(keys(%{$usercount{$cat}{$type}})))); 252: my $temp; 253: my $count=0; 254: foreach my $version (sort(keys(%{$usercount{$cat}{$type}}))) { 255: $temp.="<td>".$usercount{$cat}{$type}{$version}. 256: "</td>"; 257: $count+=$usercount{$cat}{$type}{$version}; 258: } 259: print("</th></tr><tr><td>$count</td>"); 260: print($temp."</tr></table>\n"); 261: } 262: } 263: 264: sub showact { 265: my ($cat,$ltref,%usercount)=@_; 266: print("<h3>$ltref->{$cat}</h3>\n"); 267: 268: print("<table border='1'><tr><th> </th><th>"); 269: print(join("</th><th>",('Any',@actl))); 270: print("</th></tr>"); 271: foreach my $type (sort(keys(%{$usercount{$cat}}))) { 272: print("<tr><td>$type</td>"); 273: my $temp; 274: my $count=0; 275: foreach my $activity (@actl) { 276: $temp.="<td> ".$usercount{$cat}{$type}{$activity}."</td>"; 277: $count+=$usercount{$cat}{$type}{$activity}; 278: } 279: print("<td>$count</td>"); 280: print($temp); 281: print('</tr>'); 282: } 283: print("</table>\n"); 284: } 285: