Annotation of loncom/cgi/userstatus.pl, revision 1.17
1.1 www 1: #!/usr/bin/perl
2: $|=1;
3: # User Status
1.17 ! raeburn 4: # $Id: userstatus.pl,v 1.16 2007/10/02 01:36:31 albertel Exp $
1.7 albertel 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:
1.17 ! raeburn 29: use strict;
1.1 www 30:
31: use lib '/home/httpd/lib/perl/';
1.17 ! raeburn 32: use Apache::lonlocal;
1.1 www 33: use LONCAPA::Configuration;
1.17 ! raeburn 34: use LONCAPA::loncgi;
1.1 www 35: use HTTP::Headers;
1.15 albertel 36: use GDBM_File;
1.1 www 37:
1.17 ! raeburn 38: # -------------------- Read loncapa.conf (and by default, loncapa_apache.conf).
! 39: my $perlvar=&LONCAPA::Configuration::read_conf('loncapa.conf');
1.5 albertel 40:
1.17 ! raeburn 41: print "Content-type: text/html\n\n";
1.5 albertel 42: my %usercount;
43: my @actl=('Active','Moderately Active','Inactive');
44:
1.17 ! raeburn 45: &main($perlvar);
1.5 albertel 46:
47: sub analyze_time {
48: my ($since)=@_;
49: my $color="#000000";
50: my $userclass=$actl[0];
1.14 albertel 51: if ($since>300) { $color="#222222"; $userclass=$actl[1]; }
1.5 albertel 52: if ($since>600) { $color="#444444"; }
1.14 albertel 53: if ($since>1800) { $color="#666666"; }
1.5 albertel 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}={};
1.1 www 66: }
1.5 albertel 67: $usercount{$cat}{$scope}{$class}++;
1.1 www 68: }
1.5 albertel 69:
70: sub main {
1.17 ! raeburn 71: my ($perlvar) = @_;
1.5 albertel 72: delete $$perlvar{'lonReceipt'}; # remove since sensitive and not needed
73: delete $$perlvar{'lonSqlAccess'}; # remove since sensitive and not needed
74:
1.17 ! raeburn 75: if (!&LONCAPA::loncgi::check_ipbased_access()) {
! 76: if (!&LONCAPA::loncgi::check_cookie_and_load_env()) {
! 77: &Apache::lonlocal::get_language_handle();
! 78: print &LONCAPA::loncgi::missing_cookie_msg();
! 79: return;
! 80: }
! 81:
! 82: if (!&LONCAPA::loncgi::can_view('userstatus')) {
! 83: &Apache::lonlocal::get_language_handle();
! 84: print &LONCAPA::loncgi::unauthorized_msg('userstatus');
! 85: return;
! 86: }
! 87: }
! 88:
! 89: &Apache::lonlocal::get_language_handle();
! 90: my (%gets,$dom,$oneline,$justsummary);
! 91: &LONCAPA::loncgi::cgi_getitems($ENV{'QUERY_STRING'},\%gets);
! 92: if (defined($gets{'simple'})) {
! 93: $oneline = 'simple';
! 94: }
! 95: if (defined($gets{'summary'})) {
! 96: $justsummary = 'summary';
! 97: }
! 98:
! 99: my %lt = &Apache::lonlocal::texthash(
! 100: usrs => 'User Status',
! 101: login => 'Login time',
! 102: on => 'on',
! 103: Client => 'Client',
! 104: role => 'Role',
! 105: notc => 'Not in a course',
! 106: ltra => 'Last Transaction',
! 107: lacc => 'Last Access',
! 108: secs => 'secs ago',
! 109: usrc => 'User Counts',
! 110: load => 'Load Average',
! 111: Overall => 'Overall',
! 112: Domain => 'Domain',
! 113: Course => 'Course',
! 114: Browser => 'Browser',
! 115: OS => 'OS',
! 116: Active => 'Active',
! 117: 'Moderately Active' => 'Moderately Active',
! 118: Inactive => 'Inactive',
! 119: );
! 120:
! 121: unless ($oneline) {
! 122: my $now = time();
! 123: print '<html><body bgcolor="#FFFFFF">'."\n".
! 124: "<h1>$lt{'usrs'} ".&Apache::lonlocal::locallocaltime($now).'</h1>';
! 125: }
1.5 albertel 126:
127: opendir(DIR,$$perlvar{'lonIDsDir'});
128: my @allfiles=(sort(readdir(DIR)));
1.14 albertel 129: my %users;
1.5 albertel 130: foreach my $filename (@allfiles) {
131: if ($filename=~/^\./) { next; }
1.12 albertel 132: if ($filename=~/^publicuser_/) { next; }
1.5 albertel 133: my ($dev,$ino,$mode,$nlink,
134: $uid,$gid,$rdev,$size,
135: $atime,$mtime,$ctime,
136: $blksize,$blocks)=stat($$perlvar{'lonIDsDir'}.'/'.$filename);
137: my $now=time;
138: my $since=$now-$mtime;
139: my $sinceacc=$now-$atime;
1.14 albertel 140: #unless ($oneline || $justsummary) { print ("\n\n<hr />"); }
1.5 albertel 141: my %userinfo;
1.11 albertel 142: ($userinfo{'user.name'},undef,$userinfo{'user.domain'})=
143: split('_',$filename);
1.5 albertel 144: my ($color,$userclass)=&analyze_time($since);
145: &add_count('Overall','all',$userclass);
146: &add_count('Domain',$userinfo{'user.domain'},$userclass);
147:
148: unless ($oneline) {
1.15 albertel 149: if (!tie(%userinfo,'GDBM_File',
150: $$perlvar{'lonIDsDir'}.'/'.$filename,
151: &GDBM_READER(),0640)) {
152: next;
1.11 albertel 153: }
1.5 albertel 154: if (!$justsummary) {
1.14 albertel 155: $users{$userclass}{$filename} .=
156: '<font color="'.$color.'">'.
157: '<h3>'.$userinfo{'environment.lastname'}.', '.
1.5 albertel 158: $userinfo{'environment.firstname'}.' '.
159: $userinfo{'environment.middlename'}.' '.
160: $userinfo{'environment.generation'}." (".
161: $userinfo{'user.name'}."\@".$userinfo{'user.domain'}.
1.16 albertel 162: ")</h3>\n".
163: "<p><tt>$filename</tt></p>".
1.17 ! raeburn 164: "<b>$lt{'login'}:</b> ".
! 165: &Apache::lonlocal::locallocaltime($userinfo{'user.login.time'}).
! 166: " <b>$lt{'Browser'}</b>: ".$userinfo{'browser.type'}.
! 167: " $lt{'on'} ".$userinfo{'browser.os'}."<b>$lt{'Client'}:</b>".
! 168: $userinfo{'request.host'}."<br />\n<b>$lt{'role'}: </b>".
1.5 albertel 169: $userinfo{'request.role'}." ";
170: }
171: &add_count('Browser',$userinfo{'browser.type'},$userinfo{'browser.version'});
1.10 albertel 172: &add_count('OS',$userinfo{'browser.os'},$userinfo{'browser.type'});
1.5 albertel 173: if ($userinfo{'request.course.id'}) {
174: my $cid=$userinfo{'request.course.id'};
175: my $coursename= $userinfo{'course.'.$cid.'.description'}.
176: ' ('.$cid.')';
1.14 albertel 177: if (!$justsummary) {
178: $users{$userclass}{$filename} .=
1.17 ! raeburn 179: "<b>$lt{'Course'}:</b> ".$coursename;
1.14 albertel 180: }
1.5 albertel 181: &add_count('Course',$coursename,$userclass);
182: } else {
1.14 albertel 183: if (!$justsummary) {
1.17 ! raeburn 184: $users{$userclass}{$filename} .= $lt{'notc'};
1.14 albertel 185: }
1.5 albertel 186: &add_count('Course','No Course',$userclass);
187: }
188: if (!$justsummary) {
1.14 albertel 189: $users{$userclass}{$filename} .=
1.17 ! raeburn 190: "<br /><b>$lt{'ltra'}:</b> ".&Apache::lonlocal::locallocaltime($mtime).
! 191: " (".$since." $lt{'secs'}) <br /><b>$lt{'lacc'}:</b> ".
! 192: &Apache::lonlocal::locallocaltime($atime)." (".$sinceacc." $lt{'secs'})".
1.14 albertel 193: "</font>";
194: }
195: }
1.15 albertel 196: untie(%userinfo);
1.14 albertel 197: }
198: if (!$oneline && !$justsummary) {
199: foreach my $class (@actl) {
1.17 ! raeburn 200: print("\n\n<hr /><h1>$lt{$class}</h1>");
1.14 albertel 201: foreach my $filename (sort(keys(%{$users{$class}}))) {
202: print("\n\n".$users{$class}{$filename}."\n\n<hr />");
1.5 albertel 203: }
204: }
205: }
1.14 albertel 206:
1.5 albertel 207: closedir(DIR);
208: open (LOADAVGH,"/proc/loadavg");
209: my $loadavg=<LOADAVGH>;
210: close(LOADAVGH);
211: unless ($oneline) {
1.17 ! raeburn 212: print "<hr /><h2>$lt{'usrc'}</h2>";
1.5 albertel 213: # print "<pre>\n";
1.17 ! raeburn 214: &showact('Overall',\%lt,%usercount);
! 215: &showact('Domain',\%lt,%usercount);
! 216: &showact('Course',\%lt,%usercount);
! 217: &show('Browser',\%lt,%usercount);
! 218: &show('OS',\%lt,%usercount);
1.5 albertel 219:
220: # print "\n</pre>";
1.17 ! raeburn 221: print "<b>$lt{'load'}:<b> ".$loadavg;
1.5 albertel 222: print "</body></html>";
223: } else {
1.6 albertel 224: foreach my $l1 (sort keys %usercount) {
225: foreach my $l2 (sort keys %{$usercount{$l1}}) {
226: foreach my $l3 (sort keys %{$usercount{$l1}{$l2}}) {
227: print $l1.'_'.$l2.'_'.$l3.'='.$usercount{$l1}{$l2}{$l3}.'&';
228: }
229: }
230: }
231: #clusterstatus values
232: foreach my $act (@actl) {
233: print "$act=".$usercount{'Overall'}{'all'}{$act}.'&';
1.5 albertel 234: }
235: print 'loadavg='.$loadavg;
236: }
1.1 www 237: }
1.5 albertel 238:
239: sub show {
1.17 ! raeburn 240: my ($cat,$ltref,%usercount)=@_;
! 241: print("<h3>$ltref->{$cat}</h3>\n");
1.5 albertel 242: foreach my $type (sort(keys(%{$usercount{$cat}}))) {
243: print("<table border='1'><tr><th>$type</th><th>");
244: print(join("</th><th>",sort(keys(%{$usercount{$cat}{$type}}))));
245: my $temp;
246: my $count=0;
247: foreach my $version (sort(keys(%{$usercount{$cat}{$type}}))) {
248: $temp.="<td>".$usercount{$cat}{$type}{$version}.
249: "</td>";
250: $count+=$usercount{$cat}{$type}{$version};
251: }
252: print("</th></tr><tr><td>$count</td>");
253: print($temp."</tr></table>\n");
254: }
1.3 www 255: }
1.5 albertel 256:
257: sub showact {
1.17 ! raeburn 258: my ($cat,$ltref,%usercount)=@_;
! 259: print("<h3>$ltref->{$cat}</h3>\n");
1.5 albertel 260:
261: print("<table border='1'><tr><th></th><th>");
262: print(join("</th><th>",('Any',@actl)));
263: print("</th></tr>");
264: foreach my $type (sort(keys(%{$usercount{$cat}}))) {
265: print("<tr><td>$type</td>");
266: my $temp;
267: my $count=0;
268: foreach my $activity (@actl) {
269: $temp.="<td> ".$usercount{$cat}{$type}{$activity}."</td>";
270: $count+=$usercount{$cat}{$type}{$activity};
271: }
272: print("<td>$count</td>");
273: print($temp);
274: }
275: print("</tr></table>\n");
1.3 www 276: }
1.5 albertel 277:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to userstatus.pl CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / cgi