loncom/cgi/userstatus.pl - view

File: [LON-CAPA] / loncom / cgi / userstatus.pl
Revision 1.15: download - view: text, annotated - select for diffs
Tue Sep 19 21:36:31 2006 UTC (17 years, 7 months ago) by albertel
Branches: MAIN
CVS tags: version_2_5_X, version_2_5_2, version_2_5_1, version_2_5_0, version_2_4_X, version_2_4_99_0, version_2_4_2, version_2_4_1, version_2_4_0, version_2_3_X, version_2_3_99_0, version_2_3_2, version_2_3_1, version_2_3_0, version_2_2_99_1, version_2_2_99_0, HEAD

- change sesion env into a .db file
  (simplifies the appenv/delenv process)

1: #!/usr/bin/perl 2: $|=1; 3: # User Status 4: # $Id: userstatus.pl,v 1.15 2006/09/19 21:36:31 albertel 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: 30: use strict; 31: use lib '/home/httpd/lib/perl/'; 32: use LONCAPA::Configuration; 33: use LONCAPA; 34: use HTTP::Headers; 35: use GDBM_File; 36: 37: 38: my %usercount; 39: my @actl=('Active','Moderately Active','Inactive'); 40: 41: 42: print "Content-type: text/html\n\n"; 43: 44: # -------------------- Read loncapa.conf (and by default, loncapa_apache.conf). 45: &main(); 46: 47: sub analyze_time { 48: my ($since)=@_; 49: my $color="#000000"; 50: my $userclass=$actl[0]; 51: if ($since>300) { $color="#222222"; $userclass=$actl[1]; } 52: if ($since>600) { $color="#444444"; } 53: if ($since>1800) { $color="#666666"; } 54: if ($since>7200) { $color="#888888"; } 55: if ($since>21600) { $color="#AAAAAA"; $userclass=$actl[2]; } 56: return ($color,$userclass); 57: } 58: 59: sub add_count { 60: my ($cat,$scope,$class)=@_; 61: if (!defined($usercount{$cat})) { 62: $usercount{$cat}={}; 63: } 64: if (!defined($usercount{$cat}{$scope})) { 65: $usercount{$cat}{$scope}={}; 66: } 67: $usercount{$cat}{$scope}{$class}++; 68: } 69: 70: sub main { 71: my $perlvar=LONCAPA::Configuration::read_conf('loncapa.conf'); 72: delete $$perlvar{'lonReceipt'}; # remove since sensitive and not needed 73: delete $$perlvar{'lonSqlAccess'}; # remove since sensitive and not needed 74: 75: my $oneline=($ENV{'QUERY_STRING'} eq 'simple'); 76: my $justsummary=($ENV{'QUERY_STRING'} eq 'summary'); 77: unless ($oneline) { print "<html><body bgcolor=#FFFFFF>\n<h1>User Status ".localtime()."</h1>"; } 78: 79: opendir(DIR,$$perlvar{'lonIDsDir'}); 80: my @allfiles=(sort(readdir(DIR))); 81: my %users; 82: foreach my $filename (@allfiles) { 83: if ($filename=~/^\./) { next; } 84: if ($filename=~/^publicuser_/) { next; } 85: my ($dev,$ino,$mode,$nlink, 86: $uid,$gid,$rdev,$size, 87: $atime,$mtime,$ctime, 88: $blksize,$blocks)=stat($$perlvar{'lonIDsDir'}.'/'.$filename); 89: my $now=time; 90: my $since=$now-$mtime; 91: my $sinceacc=$now-$atime; 92: #unless ($oneline || $justsummary) { print ("\n\n<hr />"); } 93: my %userinfo; 94: ($userinfo{'user.name'},undef,$userinfo{'user.domain'})= 95: split('_',$filename); 96: my ($color,$userclass)=&analyze_time($since); 97: &add_count('Overall','all',$userclass); 98: &add_count('Domain',$userinfo{'user.domain'},$userclass); 99: 100: unless ($oneline) { 101: if (!tie(%userinfo,'GDBM_File', 102: $$perlvar{'lonIDsDir'}.'/'.$filename, 103: &GDBM_READER(),0640)) { 104: next; 105: } 106: if (!$justsummary) { 107: $users{$userclass}{$filename} .= 108: '<font color="'.$color.'">'. 109: '<h3>'.$userinfo{'environment.lastname'}.', '. 110: $userinfo{'environment.firstname'}.' '. 111: $userinfo{'environment.middlename'}.' '. 112: $userinfo{'environment.generation'}." (". 113: $userinfo{'user.name'}."\@".$userinfo{'user.domain'}. 114: ")</h3>\n<b>Login time:</b> ". 115: localtime($userinfo{'user.login.time'}). 116: ' <b>Browser</b>: '.$userinfo{'browser.type'}. 117: " on ".$userinfo{'browser.os'}."<b>Client:</b> ". 118: $userinfo{'request.host'}."<br />\n<b>Role: </b>". 119: $userinfo{'request.role'}." "; 120: } 121: &add_count('Browser',$userinfo{'browser.type'},$userinfo{'browser.version'}); 122: &add_count('OS',$userinfo{'browser.os'},$userinfo{'browser.type'}); 123: if ($userinfo{'request.course.id'}) { 124: my $cid=$userinfo{'request.course.id'}; 125: my $coursename= $userinfo{'course.'.$cid.'.description'}. 126: ' ('.$cid.')'; 127: if (!$justsummary) { 128: $users{$userclass}{$filename} .= 129: "<b>Course:</b> ".$coursename; 130: } 131: &add_count('Course',$coursename,$userclass); 132: } else { 133: if (!$justsummary) { 134: $users{$userclass}{$filename} .= 135: "Not in a course."; 136: } 137: &add_count('Course','No Course',$userclass); 138: } 139: if (!$justsummary) { 140: $users{$userclass}{$filename} .= 141: "<br /><b>Last Transaction:</b> ".localtime($mtime). 142: " (".$since." secs ago) <br /><b>Last Access:</b> ". 143: localtime($atime)." (".$sinceacc." secs ago)". 144: "</font>"; 145: } 146: } 147: untie(%userinfo); 148: } 149: if (!$oneline && !$justsummary) { 150: foreach my $class (@actl) { 151: print("\n\n<hr /><h1>$class</h1>"); 152: foreach my $filename (sort(keys(%{$users{$class}}))) { 153: print("\n\n".$users{$class}{$filename}."\n\n<hr />"); 154: } 155: } 156: } 157: 158: closedir(DIR); 159: open (LOADAVGH,"/proc/loadavg"); 160: my $loadavg=<LOADAVGH>; 161: close(LOADAVGH); 162: unless ($oneline) { 163: print "<hr /><h2>User Counts</h2>"; 164: # print "<pre>\n"; 165: &showact('Overall',%usercount); 166: &showact('Domain',%usercount); 167: &showact('Course',%usercount); 168: &show('Browser',%usercount); 169: &show('OS',%usercount); 170: 171: # print "\n</pre>"; 172: print "<b>Load Average:<b> ".$loadavg; 173: print "</body></html>"; 174: } else { 175: foreach my $l1 (sort keys %usercount) { 176: foreach my $l2 (sort keys %{$usercount{$l1}}) { 177: foreach my $l3 (sort keys %{$usercount{$l1}{$l2}}) { 178: print $l1.'_'.$l2.'_'.$l3.'='.$usercount{$l1}{$l2}{$l3}.'&'; 179: } 180: } 181: } 182: #clusterstatus values 183: foreach my $act (@actl) { 184: print "$act=".$usercount{'Overall'}{'all'}{$act}.'&'; 185: } 186: print 'loadavg='.$loadavg; 187: } 188: } 189: 190: sub show { 191: my ($cat,%usercount)=@_; 192: print("<h3>$cat</h3>\n"); 193: foreach my $type (sort(keys(%{$usercount{$cat}}))) { 194: print("<table border='1'><tr><th>$type</th><th>"); 195: print(join("</th><th>",sort(keys(%{$usercount{$cat}{$type}})))); 196: my $temp; 197: my $count=0; 198: foreach my $version (sort(keys(%{$usercount{$cat}{$type}}))) { 199: $temp.="<td>".$usercount{$cat}{$type}{$version}. 200: "</td>"; 201: $count+=$usercount{$cat}{$type}{$version}; 202: } 203: print("</th></tr><tr><td>$count</td>"); 204: print($temp."</tr></table>\n"); 205: } 206: } 207: 208: sub showact { 209: my ($cat,%usercount)=@_; 210: print("<h3>$cat</h3>\n"); 211: 212: print("<table border='1'><tr><th></th><th>"); 213: print(join("</th><th>",('Any',@actl))); 214: print("</th></tr>"); 215: foreach my $type (sort(keys(%{$usercount{$cat}}))) { 216: print("<tr><td>$type</td>"); 217: my $temp; 218: my $count=0; 219: foreach my $activity (@actl) { 220: $temp.="<td> ".$usercount{$cat}{$type}{$activity}."</td>"; 221: $count+=$usercount{$cat}{$type}{$activity}; 222: } 223: print("<td>$count</td>"); 224: print($temp); 225: } 226: print("</tr></table>\n"); 227: } 228: