Annotation of loncom/cgi/userstatus.pl, revision 1.14
1.1 www 1: #!/usr/bin/perl
2: $|=1;
3: # User Status
1.14 ! albertel 4: # $Id: userstatus.pl,v 1.13 2006/06/02 21:36:21 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.1 www 29:
1.5 albertel 30: use strict;
1.1 www 31: use lib '/home/httpd/lib/perl/';
32: use LONCAPA::Configuration;
1.13 albertel 33: use LONCAPA;
1.1 www 34: use HTTP::Headers;
35: use IO::File;
36:
1.5 albertel 37:
38: my %usercount;
39: my @actl=('Active','Moderately Active','Inactive');
40:
1.1 www 41:
1.3 www 42: print "Content-type: text/html\n\n";
43:
1.1 www 44: # -------------------- Read loncapa.conf (and by default, loncapa_apache.conf).
1.5 albertel 45: &main();
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 {
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)));
1.14 ! albertel 81: my %users;
1.5 albertel 82: foreach my $filename (@allfiles) {
83: if ($filename=~/^\./) { next; }
1.12 albertel 84: if ($filename=~/^publicuser_/) { next; }
1.5 albertel 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;
1.14 ! albertel 92: #unless ($oneline || $justsummary) { print ("\n\n<hr />"); }
1.5 albertel 93: my %userinfo;
1.11 albertel 94: ($userinfo{'user.name'},undef,$userinfo{'user.domain'})=
95: split('_',$filename);
1.5 albertel 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) {
1.11 albertel 101: my $fh=IO::File->new($$perlvar{'lonIDsDir'}.'/'.$filename);
102: while (my $line=<$fh>) {
103: chomp($line);
104: my ($name,$value)=split(/\=/,$line);
1.13 albertel 105: $name = &unescape($name);
106: $value = &unescape($value);
1.11 albertel 107: $userinfo{$name}=$value;
108: }
109: $fh->close();
1.5 albertel 110: if (!$justsummary) {
1.14 ! albertel 111: $users{$userclass}{$filename} .=
! 112: '<font color="'.$color.'">'.
! 113: '<h3>'.$userinfo{'environment.lastname'}.', '.
1.5 albertel 114: $userinfo{'environment.firstname'}.' '.
115: $userinfo{'environment.middlename'}.' '.
116: $userinfo{'environment.generation'}." (".
117: $userinfo{'user.name'}."\@".$userinfo{'user.domain'}.
118: ")</h3>\n<b>Login time:</b> ".
119: localtime($userinfo{'user.login.time'}).
1.9 albertel 120: ' <b>Browser</b>: '.$userinfo{'browser.type'}.
121: " on ".$userinfo{'browser.os'}."<b>Client:</b> ".
1.5 albertel 122: $userinfo{'request.host'}."<br />\n<b>Role: </b>".
123: $userinfo{'request.role'}." ";
124: }
125: &add_count('Browser',$userinfo{'browser.type'},$userinfo{'browser.version'});
1.10 albertel 126: &add_count('OS',$userinfo{'browser.os'},$userinfo{'browser.type'});
1.5 albertel 127: if ($userinfo{'request.course.id'}) {
128: my $cid=$userinfo{'request.course.id'};
129: my $coursename= $userinfo{'course.'.$cid.'.description'}.
130: ' ('.$cid.')';
1.14 ! albertel 131: if (!$justsummary) {
! 132: $users{$userclass}{$filename} .=
! 133: "<b>Course:</b> ".$coursename;
! 134: }
1.5 albertel 135: &add_count('Course',$coursename,$userclass);
136: } else {
1.14 ! albertel 137: if (!$justsummary) {
! 138: $users{$userclass}{$filename} .=
! 139: "Not in a course.";
! 140: }
1.5 albertel 141: &add_count('Course','No Course',$userclass);
142: }
143: if (!$justsummary) {
1.14 ! albertel 144: $users{$userclass}{$filename} .=
! 145: "<br /><b>Last Transaction:</b> ".localtime($mtime).
1.5 albertel 146: " (".$since." secs ago) <br /><b>Last Access:</b> ".
1.14 ! albertel 147: localtime($atime)." (".$sinceacc." secs ago)".
! 148: "</font>";
! 149: }
! 150: }
! 151: }
! 152: if (!$oneline && !$justsummary) {
! 153: foreach my $class (@actl) {
! 154: print("\n\n<hr /><h1>$class</h1>");
! 155: foreach my $filename (sort(keys(%{$users{$class}}))) {
! 156: print("\n\n".$users{$class}{$filename}."\n\n<hr />");
1.5 albertel 157: }
158: }
159: }
1.14 ! albertel 160:
1.5 albertel 161: closedir(DIR);
162: open (LOADAVGH,"/proc/loadavg");
163: my $loadavg=<LOADAVGH>;
164: close(LOADAVGH);
165: unless ($oneline) {
166: print "<hr /><h2>User Counts</h2>";
167: # print "<pre>\n";
168: &showact('Overall',%usercount);
169: &showact('Domain',%usercount);
170: &showact('Course',%usercount);
171: &show('Browser',%usercount);
1.9 albertel 172: &show('OS',%usercount);
1.5 albertel 173:
174: # print "\n</pre>";
175: print "<b>Load Average:<b> ".$loadavg;
176: print "</body></html>";
177: } else {
1.6 albertel 178: foreach my $l1 (sort keys %usercount) {
179: foreach my $l2 (sort keys %{$usercount{$l1}}) {
180: foreach my $l3 (sort keys %{$usercount{$l1}{$l2}}) {
181: print $l1.'_'.$l2.'_'.$l3.'='.$usercount{$l1}{$l2}{$l3}.'&';
182: }
183: }
184: }
185: #clusterstatus values
186: foreach my $act (@actl) {
187: print "$act=".$usercount{'Overall'}{'all'}{$act}.'&';
1.5 albertel 188: }
189: print 'loadavg='.$loadavg;
190: }
1.1 www 191: }
1.5 albertel 192:
193: sub show {
194: my ($cat,%usercount)=@_;
195: print("<h3>$cat</h3>\n");
196: foreach my $type (sort(keys(%{$usercount{$cat}}))) {
197: print("<table border='1'><tr><th>$type</th><th>");
198: print(join("</th><th>",sort(keys(%{$usercount{$cat}{$type}}))));
199: my $temp;
200: my $count=0;
201: foreach my $version (sort(keys(%{$usercount{$cat}{$type}}))) {
202: $temp.="<td>".$usercount{$cat}{$type}{$version}.
203: "</td>";
204: $count+=$usercount{$cat}{$type}{$version};
205: }
206: print("</th></tr><tr><td>$count</td>");
207: print($temp."</tr></table>\n");
208: }
1.3 www 209: }
1.5 albertel 210:
211: sub showact {
212: my ($cat,%usercount)=@_;
213: print("<h3>$cat</h3>\n");
214:
215: print("<table border='1'><tr><th></th><th>");
216: print(join("</th><th>",('Any',@actl)));
217: print("</th></tr>");
218: foreach my $type (sort(keys(%{$usercount{$cat}}))) {
219: print("<tr><td>$type</td>");
220: my $temp;
221: my $count=0;
222: foreach my $activity (@actl) {
223: $temp.="<td> ".$usercount{$cat}{$type}{$activity}."</td>";
224: $count+=$usercount{$cat}{$type}{$activity};
225: }
226: print("<td>$count</td>");
227: print($temp);
228: }
229: print("</tr></table>\n");
1.3 www 230: }
1.5 albertel 231:
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