[BACK]Return to userstatus.pl CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom / cgi

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

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: 
                     10: use lib '/home/httpd/lib/perl/';
                     11: use LONCAPA::Configuration;
                     12: 
                     13: use HTTP::Headers;
                     14: use IO::File;
                     15: 
                     16:  
1.3     ! www        17: print "Content-type: text/html\n\n";
        !            18:       
1.1       www        19: # -------------------- Read loncapa.conf (and by default, loncapa_apache.conf).
                     20: my $perlvarref=LONCAPA::Configuration::read_conf('loncapa.conf');
                     21: my %perlvar=%{$perlvarref};
                     22: undef $perlvarref; # remove since sensitive and not needed
                     23: delete $perlvar{'lonReceipt'}; # remove since sensitive and not needed
                     24: delete $perlvar{'lonSqlAccess'}; # remove since sensitive and not needed
                     25: 
1.3     ! www        26: my $oneline=($ENV{'QUERY_STRING'} eq 'simple');
        !            27: unless ($oneline) { print "<html><body bgcolor=#FFFFFF>\n<h1>User Status ".localtime()."</h1>"; }
1.1       www        28: 
                     29: my $filename;
                     30: opendir(DIR,$perlvar{'lonIDsDir'});
                     31: %usercounts=();
                     32: while ($filename=readdir(DIR)) {
                     33:     unless ($filename=~/^\./) {
                     34:         my ($dev,$ino,$mode,$nlink,
                     35:             $uid,$gid,$rdev,$size,
                     36:             $atime,$mtime,$ctime,
                     37:             $blksize,$blocks)=stat($perlvar{'lonIDsDir'}.'/'.$filename);
                     38:         $now=time;
                     39:         $since=$now-$mtime;
                     40:         $sinceacc=$now-$atime;
1.3     ! www        41: 	unless ($oneline) { print ("\n\n<hr />"); }
1.1       www        42:         my %userinfo=();
                     43:         undef $userinfo;
                     44:         my $fh=IO::File->new($perlvar{'lonIDsDir'}.'/'.$filename);
                     45:         while ($line=<$fh>) {
                     46:             chomp($line);
                     47:             my ($name,$value)=split(/\=/,$line);
                     48:             $userinfo{$name}=$value;
                     49:         }
                     50:         $fh->close();
                     51:         $color="#000000";
                     52:         $userclass="Active";
                     53:         if ($since>300) { $color="#222222"; }
                     54:         if ($since>600) { $color="#444444"; }
                     55:         if ($since>3600) { $color="#666666"; $userclass="Moderately Active"; }
                     56:         if ($since>7200) { $color="#888888"; }
                     57:         if ($since>21600) { $color="#AAAAAA"; $userclass="Inactive"; }
                     58:         $usercount{$userclass}++;
1.2       www        59:         $usercount{'in Domain '.$userinfo{'user.domain'}}++;
1.3     ! www        60:       unless ($oneline) {
1.1       www        61:         print '<font color="'.$color.'">';
                     62:         print '<h3>'.$userinfo{'environment.lastname'}.', '.
                     63: 	       $userinfo{'environment.firstname'}.' '.
                     64: 	       $userinfo{'environment.middlename'}.' '.
                     65: 	       $userinfo{'environment.generation'}." (".
                     66:                $userinfo{'user.name'}."\@".$userinfo{'user.domain'}.
                     67:                ")</h3>\n<b>Login time:</b> ".
                     68:                localtime($userinfo{'user.login.time'}).
                     69:               ' <b>Browser</b>: '.$userinfo{'browser.type'}." <b>Client:</b> ".
                     70:                $userinfo{'request.host'}."<br />\n<b>Role: </b>".
                     71:                $userinfo{'request.role'}." ";
                     72: 	if ($userinfo{'request.course.id'}) {
                     73:             print "<b>Course:</b> ".
                     74:           $userinfo{'course.'.$userinfo{'request.course.id'}.'.description'}.
                     75:                 ' ('.$userinfo{'request.course.id'}.')';
                     76:             $usercount{'in Course '.
                     77:    $userinfo{'course.'.$userinfo{'request.course.id'}.'.description'}.
                     78: 			   ' ('.$userinfo{'request.course.id'}.')'}++;
                     79:         } else {
                     80: 	    print "Not in a course.";
                     81:         }
                     82:         print "<br /><b>Last Transaction:</b> ".localtime($mtime).
                     83:        " (".$since." secs ago) <br /><b>Last Access:</b> ".localtime($atime).
                     84:        " (".$sinceacc." secs ago)";
1.3     ! www        85:        print ("</font>"); 
        !            86:      }      
1.1       www        87:     }
                     88: }
                     89: closedir(DIR);
1.3     ! www        90: unless ($oneline) { 
1.1       www        91: print "<hr /><h2>User Count</h2>";
                     92: foreach (sort keys %usercount) {
                     93:     print "<b>".$_.":</b> ".$usercount{$_}."<br />";
                     94: }
                     95: print "</body></html>";
1.3     ! www        96: } else {
        !            97: foreach (sort keys %usercount) {
        !            98:     print $_.'='.$usercount{$_}.'&';
        !            99: }
        !           100: }
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>