Annotation of loncom/cgi/userstatus.pl, revision 1.5
1.1 www 1: #!/usr/bin/perl
2: $|=1;
3: # The LearningOnline Network with CAPA
4: # User Status
5: # (Versions
6: # (Running loncron
7: # 09/06/01 Gerd Kortemeyer)
8: # 02/18/02,02/19/02 Gerd Kortemeyer)
9:
1.5 ! albertel 10: use strict;
1.1 www 11: use lib '/home/httpd/lib/perl/';
12: use LONCAPA::Configuration;
13:
14: use HTTP::Headers;
15: use IO::File;
16:
1.5 ! albertel 17:
! 18: my %usercount;
! 19: my @actl=('Active','Moderately Active','Inactive');
! 20:
1.1 www 21:
1.3 www 22: print "Content-type: text/html\n\n";
23:
1.1 www 24: # -------------------- Read loncapa.conf (and by default, loncapa_apache.conf).
1.5 ! albertel 25: &main();
! 26:
! 27: sub analyze_time {
! 28: my ($since)=@_;
! 29: my $color="#000000";
! 30: my $userclass=$actl[0];
! 31: if ($since>300) { $color="#222222"; }
! 32: if ($since>600) { $color="#444444"; }
! 33: if ($since>3600) { $color="#666666"; $userclass=$actl[1]; }
! 34: if ($since>7200) { $color="#888888"; }
! 35: if ($since>21600) { $color="#AAAAAA"; $userclass=$actl[2]; }
! 36: return ($color,$userclass);
! 37: }
! 38:
! 39: sub add_count {
! 40: my ($cat,$scope,$class)=@_;
! 41: if (!defined($usercount{$cat})) {
! 42: $usercount{$cat}={};
! 43: }
! 44: if (!defined($usercount{$cat}{$scope})) {
! 45: $usercount{$cat}{$scope}={};
1.1 www 46: }
1.5 ! albertel 47: $usercount{$cat}{$scope}{$class}++;
1.1 www 48: }
1.5 ! albertel 49:
! 50: sub main {
! 51: my $perlvar=LONCAPA::Configuration::read_conf('loncapa.conf');
! 52: delete $$perlvar{'lonReceipt'}; # remove since sensitive and not needed
! 53: delete $$perlvar{'lonSqlAccess'}; # remove since sensitive and not needed
! 54:
! 55: my $oneline=($ENV{'QUERY_STRING'} eq 'simple');
! 56: my $justsummary=($ENV{'QUERY_STRING'} eq 'summary');
! 57: unless ($oneline) { print "<html><body bgcolor=#FFFFFF>\n<h1>User Status ".localtime()."</h1>"; }
! 58:
! 59: opendir(DIR,$$perlvar{'lonIDsDir'});
! 60: my @allfiles=(sort(readdir(DIR)));
! 61: foreach my $filename (@allfiles) {
! 62: if ($filename=~/^\./) { next; }
! 63: my ($dev,$ino,$mode,$nlink,
! 64: $uid,$gid,$rdev,$size,
! 65: $atime,$mtime,$ctime,
! 66: $blksize,$blocks)=stat($$perlvar{'lonIDsDir'}.'/'.$filename);
! 67: my $now=time;
! 68: my $since=$now-$mtime;
! 69: my $sinceacc=$now-$atime;
! 70: unless ($oneline || $justsummary) { print ("\n\n<hr />"); }
! 71: my %userinfo;
! 72: my $fh=IO::File->new($$perlvar{'lonIDsDir'}.'/'.$filename);
! 73: while (my $line=<$fh>) {
! 74: chomp($line);
! 75: my ($name,$value)=split(/\=/,$line);
! 76: $userinfo{$name}=$value;
! 77: }
! 78: $fh->close();
! 79: my ($color,$userclass)=&analyze_time($since);
! 80: &add_count('Overall','all',$userclass);
! 81: &add_count('Domain',$userinfo{'user.domain'},$userclass);
! 82:
! 83: unless ($oneline) {
! 84: if (!$justsummary) {
! 85: print '<font color="'.$color.'">';
! 86: print '<h3>'.$userinfo{'environment.lastname'}.', '.
! 87: $userinfo{'environment.firstname'}.' '.
! 88: $userinfo{'environment.middlename'}.' '.
! 89: $userinfo{'environment.generation'}." (".
! 90: $userinfo{'user.name'}."\@".$userinfo{'user.domain'}.
! 91: ")</h3>\n<b>Login time:</b> ".
! 92: localtime($userinfo{'user.login.time'}).
! 93: ' <b>Browser</b>: '.$userinfo{'browser.type'}." <b>Client:</b> ".
! 94: $userinfo{'request.host'}."<br />\n<b>Role: </b>".
! 95: $userinfo{'request.role'}." ";
! 96: }
! 97: &add_count('Browser',$userinfo{'browser.type'},$userinfo{'browser.version'});
! 98: if ($userinfo{'request.course.id'}) {
! 99: my $cid=$userinfo{'request.course.id'};
! 100: my $coursename= $userinfo{'course.'.$cid.'.description'}.
! 101: ' ('.$cid.')';
! 102: if (!$justsummary) { print "<b>Course:</b> ".$coursename; }
! 103: &add_count('Course',$coursename,$userclass);
! 104: } else {
! 105: if (!$justsummary) { print "Not in a course."; }
! 106: &add_count('Course','No Course',$userclass);
! 107: }
! 108: if (!$justsummary) {
! 109: print "<br /><b>Last Transaction:</b> ".localtime($mtime).
! 110: " (".$since." secs ago) <br /><b>Last Access:</b> ".
! 111: localtime($atime)." (".$sinceacc." secs ago)";
! 112: print ("</font>");
! 113: }
! 114: }
! 115: }
! 116: closedir(DIR);
! 117: open (LOADAVGH,"/proc/loadavg");
! 118: my $loadavg=<LOADAVGH>;
! 119: close(LOADAVGH);
! 120: unless ($oneline) {
! 121: print "<hr /><h2>User Counts</h2>";
! 122: # print "<pre>\n";
! 123: &showact('Overall',%usercount);
! 124: &showact('Domain',%usercount);
! 125: &showact('Course',%usercount);
! 126: &show('Browser',%usercount);
! 127:
! 128: # print "\n</pre>";
! 129: print "<b>Load Average:<b> ".$loadavg;
! 130: print "</body></html>";
! 131: } else {
! 132: foreach (sort keys %usercount) {
! 133: print $_.'='.$usercount{$_}.'&';
! 134: }
! 135: print 'loadavg='.$loadavg;
! 136: }
1.1 www 137: }
1.5 ! albertel 138:
! 139: sub show {
! 140: my ($cat,%usercount)=@_;
! 141: print("<h3>$cat</h3>\n");
! 142: foreach my $type (sort(keys(%{$usercount{$cat}}))) {
! 143: print("<table border='1'><tr><th>$type</th><th>");
! 144: print(join("</th><th>",sort(keys(%{$usercount{$cat}{$type}}))));
! 145: my $temp;
! 146: my $count=0;
! 147: foreach my $version (sort(keys(%{$usercount{$cat}{$type}}))) {
! 148: $temp.="<td>".$usercount{$cat}{$type}{$version}.
! 149: "</td>";
! 150: $count+=$usercount{$cat}{$type}{$version};
! 151: }
! 152: print("</th></tr><tr><td>$count</td>");
! 153: print($temp."</tr></table>\n");
! 154: }
1.3 www 155: }
1.5 ! albertel 156:
! 157: sub showact {
! 158: my ($cat,%usercount)=@_;
! 159: print("<h3>$cat</h3>\n");
! 160:
! 161: print("<table border='1'><tr><th></th><th>");
! 162: print(join("</th><th>",('Any',@actl)));
! 163: print("</th></tr>");
! 164: foreach my $type (sort(keys(%{$usercount{$cat}}))) {
! 165: print("<tr><td>$type</td>");
! 166: my $temp;
! 167: my $count=0;
! 168: foreach my $activity (@actl) {
! 169: $temp.="<td> ".$usercount{$cat}{$type}{$activity}."</td>";
! 170: $count+=$usercount{$cat}{$type}{$activity};
! 171: }
! 172: print("<td>$count</td>");
! 173: print($temp);
! 174: }
! 175: print("</tr></table>\n");
1.3 www 176: }
1.5 ! albertel 177:
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