Annotation of loncom/cgi/userstatus.pl, revision 1.16

1.1       www         1: #!/usr/bin/perl
                      2: $|=1;
                      3: # User Status
1.16    ! albertel    4: # $Id: userstatus.pl,v 1.15 2006/09/19 21: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.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;
1.15      albertel   35: use GDBM_File;
1.1       www        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.15      albertel  101: 	    if (!tie(%userinfo,'GDBM_File',
                    102: 		     $$perlvar{'lonIDsDir'}.'/'.$filename,
                    103: 		     &GDBM_READER(),0640)) {
                    104: 		next;
1.11      albertel  105: 	    }
1.5       albertel  106: 	    if (!$justsummary) {
1.14      albertel  107: 		$users{$userclass}{$filename} .=
                    108: 		    '<font color="'.$color.'">'.
                    109: 		    '<h3>'.$userinfo{'environment.lastname'}.', '.
1.5       albertel  110: 		    $userinfo{'environment.firstname'}.' '.
                    111: 		    $userinfo{'environment.middlename'}.' '.
                    112: 		    $userinfo{'environment.generation'}." (".
                    113: 		    $userinfo{'user.name'}."\@".$userinfo{'user.domain'}.
1.16    ! albertel  114: 		    ")</h3>\n".
        !           115: 		    "<p><tt>$filename</tt></p>".
        !           116: 		    "<b>Login time:</b> ".
1.5       albertel  117: 		    localtime($userinfo{'user.login.time'}).
1.9       albertel  118: 		    ' <b>Browser</b>: '.$userinfo{'browser.type'}.
                    119: 		    " on ".$userinfo{'browser.os'}."<b>Client:</b> ".
1.5       albertel  120: 		    $userinfo{'request.host'}."<br />\n<b>Role: </b>".
                    121: 		    $userinfo{'request.role'}." ";
                    122: 	    }
                    123: 	    &add_count('Browser',$userinfo{'browser.type'},$userinfo{'browser.version'});
1.10      albertel  124: 	    &add_count('OS',$userinfo{'browser.os'},$userinfo{'browser.type'});
1.5       albertel  125: 	    if ($userinfo{'request.course.id'}) {
                    126: 		my $cid=$userinfo{'request.course.id'};
                    127: 		my $coursename= $userinfo{'course.'.$cid.'.description'}.
                    128: 		    ' ('.$cid.')';
1.14      albertel  129: 		if (!$justsummary) { 
                    130: 		    $users{$userclass}{$filename} .= 
                    131: 			"<b>Course:</b> ".$coursename; 
                    132: 		}
1.5       albertel  133: 		&add_count('Course',$coursename,$userclass);
                    134: 	    } else {
1.14      albertel  135: 		if (!$justsummary) {
                    136: 		    $users{$userclass}{$filename} .= 
                    137: 			"Not in a course.";
                    138: 		}
1.5       albertel  139: 		&add_count('Course','No Course',$userclass);
                    140: 	    }
                    141: 	    if (!$justsummary) {
1.14      albertel  142: 		$users{$userclass}{$filename} .=
                    143: 		    "<br /><b>Last Transaction:</b> ".localtime($mtime).
1.5       albertel  144: 		    " (".$since." secs ago) <br /><b>Last Access:</b> ".
1.14      albertel  145: 		    localtime($atime)." (".$sinceacc." secs ago)".
                    146: 		    "</font>";
                    147: 	    }
                    148: 	}
1.15      albertel  149: 	untie(%userinfo);
1.14      albertel  150:     }
                    151:     if (!$oneline && !$justsummary) {
                    152:        	foreach my $class (@actl) {
                    153: 	    print("\n\n<hr /><h1>$class</h1>");    
                    154: 	    foreach my $filename (sort(keys(%{$users{$class}}))) {
                    155: 		print("\n\n".$users{$class}{$filename}."\n\n<hr />");    
1.5       albertel  156: 	    }
                    157: 	}
                    158:     }
1.14      albertel  159: 
1.5       albertel  160:     closedir(DIR);
                    161:     open (LOADAVGH,"/proc/loadavg");
                    162:     my $loadavg=<LOADAVGH>;
                    163:     close(LOADAVGH);
                    164:     unless ($oneline) { 
                    165: 	print "<hr /><h2>User Counts</h2>";
                    166: #	print "<pre>\n";
                    167: 	&showact('Overall',%usercount);
                    168: 	&showact('Domain',%usercount);
                    169: 	&showact('Course',%usercount);
                    170: 	&show('Browser',%usercount);
1.9       albertel  171: 	&show('OS',%usercount);
1.5       albertel  172: 
                    173: #	print "\n</pre>";
                    174: 	print "<b>Load Average:<b> ".$loadavg;
                    175: 	print "</body></html>";
                    176:     } else {
1.6       albertel  177: 	foreach my $l1 (sort keys %usercount) {
                    178: 	    foreach my $l2 (sort keys %{$usercount{$l1}}) {
                    179: 		foreach my $l3 (sort keys %{$usercount{$l1}{$l2}}) {
                    180: 		    print $l1.'_'.$l2.'_'.$l3.'='.$usercount{$l1}{$l2}{$l3}.'&';
                    181: 		}
                    182: 	    }
                    183: 	}
                    184: 	#clusterstatus values
                    185: 	foreach my $act (@actl) {
                    186: 	    print "$act=".$usercount{'Overall'}{'all'}{$act}.'&';
1.5       albertel  187: 	}
                    188: 	print 'loadavg='.$loadavg;
                    189:     }
1.1       www       190: }
1.5       albertel  191: 
                    192: sub show {
                    193:     my ($cat,%usercount)=@_;
                    194:     print("<h3>$cat</h3>\n");
                    195:     foreach my $type (sort(keys(%{$usercount{$cat}}))) {
                    196: 	print("<table border='1'><tr><th>$type</th><th>");
                    197: 	print(join("</th><th>",sort(keys(%{$usercount{$cat}{$type}}))));
                    198: 	my $temp;
                    199: 	my $count=0;
                    200: 	foreach my $version (sort(keys(%{$usercount{$cat}{$type}}))) {
                    201: 	    $temp.="<td>".$usercount{$cat}{$type}{$version}.
                    202: 		"</td>";
                    203: 	    $count+=$usercount{$cat}{$type}{$version};
                    204: 	}
                    205: 	print("</th></tr><tr><td>$count</td>");
                    206: 	print($temp."</tr></table>\n");
                    207:     }    
1.3       www       208: }
1.5       albertel  209: 
                    210: sub showact {
                    211:     my ($cat,%usercount)=@_;
                    212:     print("<h3>$cat</h3>\n");
                    213:     
                    214:     print("<table border='1'><tr><th></th><th>");
                    215:     print(join("</th><th>",('Any',@actl)));
                    216:     print("</th></tr>");
                    217:     foreach my $type (sort(keys(%{$usercount{$cat}}))) {
                    218: 	print("<tr><td>$type</td>");
                    219: 	my $temp;
                    220: 	my $count=0;
                    221: 	foreach my $activity (@actl) {
                    222: 	    $temp.="<td>&nbsp;".$usercount{$cat}{$type}{$activity}."</td>";
                    223: 	    $count+=$usercount{$cat}{$type}{$activity};
                    224: 	}
                    225: 	print("<td>$count</td>");
                    226: 	print($temp);
                    227:     }    
                    228:     print("</tr></table>\n");
1.3       www       229: }
1.5       albertel  230: 

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>