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

Diff for /loncom/cgi/userstatus.pl between versions 1.3 and 1.8

version 1.3, 2003/07/29 20:17:52 version 1.8, 2003/10/30 22:52:25
Line 1 Line 1
 #!/usr/bin/perl  #!/usr/bin/perl
 $|=1;  $|=1;
 # The LearningOnline Network with CAPA  
 # User Status  # User Status
 # (Versions  # $Id$
 # (Running loncron  #
 # 09/06/01 Gerd Kortemeyer)  # Copyright Michigan State University Board of Trustees
 # 02/18/02,02/19/02 Gerd Kortemeyer)  #
   # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
   #
   # LON-CAPA is free software; you can redistribute it and/or modify
   # it under the terms of the GNU General Public License as published by
   # the Free Software Foundation; either version 2 of the License, or
   # (at your option) any later version.
   #
   # LON-CAPA is distributed in the hope that it will be useful,
   # but WITHOUT ANY WARRANTY; without even the implied warranty of
   # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   # GNU General Public License for more details.
   #
   # You should have received a copy of the GNU General Public License
   # along with LON-CAPA; if not, write to the Free Software
   # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
   #
   # /home/httpd/html/adm/gpl.txt
   #
   # http://www.lon-capa.org/
   #
   
   
   use strict;
 use lib '/home/httpd/lib/perl/';  use lib '/home/httpd/lib/perl/';
 use LONCAPA::Configuration;  use LONCAPA::Configuration;
   
 use HTTP::Headers;  use HTTP::Headers;
 use IO::File;  use IO::File;
   
   
   my %usercount;
   my @actl=('Active','Moderately Active','Inactive');
   
     
 print "Content-type: text/html\n\n";  print "Content-type: text/html\n\n";
               
 # -------------------- Read loncapa.conf (and by default, loncapa_apache.conf).  # -------------------- Read loncapa.conf (and by default, loncapa_apache.conf).
 my $perlvarref=LONCAPA::Configuration::read_conf('loncapa.conf');  &main();
 my %perlvar=%{$perlvarref};  
 undef $perlvarref; # remove since sensitive and not needed  sub analyze_time {
 delete $perlvar{'lonReceipt'}; # remove since sensitive and not needed      my ($since)=@_;
 delete $perlvar{'lonSqlAccess'}; # remove since sensitive and not needed      my $color="#000000";
       my $userclass=$actl[0];
 my $oneline=($ENV{'QUERY_STRING'} eq 'simple');      if ($since>300) { $color="#222222"; }
 unless ($oneline) { print "<html><body bgcolor=#FFFFFF>\n<h1>User Status ".localtime()."</h1>"; }      if ($since>600) { $color="#444444"; }
       if ($since>1800) { $color="#666666"; $userclass=$actl[1]; }
 my $filename;      if ($since>7200) { $color="#888888"; }
 opendir(DIR,$perlvar{'lonIDsDir'});      if ($since>21600) { $color="#AAAAAA"; $userclass=$actl[2]; }
 %usercounts=();      return ($color,$userclass);
 while ($filename=readdir(DIR)) {  }
     unless ($filename=~/^\./) {  
         my ($dev,$ino,$mode,$nlink,  sub add_count {
             $uid,$gid,$rdev,$size,      my ($cat,$scope,$class)=@_;
             $atime,$mtime,$ctime,      if (!defined($usercount{$cat})) {
             $blksize,$blocks)=stat($perlvar{'lonIDsDir'}.'/'.$filename);   $usercount{$cat}={};
         $now=time;  
         $since=$now-$mtime;  
         $sinceacc=$now-$atime;  
  unless ($oneline) { print ("\n\n<hr />"); }  
         my %userinfo=();  
         undef $userinfo;  
         my $fh=IO::File->new($perlvar{'lonIDsDir'}.'/'.$filename);  
         while ($line=<$fh>) {  
             chomp($line);  
             my ($name,$value)=split(/\=/,$line);  
             $userinfo{$name}=$value;  
         }  
         $fh->close();  
         $color="#000000";  
         $userclass="Active";  
         if ($since>300) { $color="#222222"; }  
         if ($since>600) { $color="#444444"; }  
         if ($since>3600) { $color="#666666"; $userclass="Moderately Active"; }  
         if ($since>7200) { $color="#888888"; }  
         if ($since>21600) { $color="#AAAAAA"; $userclass="Inactive"; }  
         $usercount{$userclass}++;  
         $usercount{'in Domain '.$userinfo{'user.domain'}}++;  
       unless ($oneline) {  
         print '<font color="'.$color.'">';  
         print '<h3>'.$userinfo{'environment.lastname'}.', '.  
        $userinfo{'environment.firstname'}.' '.  
        $userinfo{'environment.middlename'}.' '.  
        $userinfo{'environment.generation'}." (".  
                $userinfo{'user.name'}."\@".$userinfo{'user.domain'}.  
                ")</h3>\n<b>Login time:</b> ".  
                localtime($userinfo{'user.login.time'}).  
               ' <b>Browser</b>: '.$userinfo{'browser.type'}." <b>Client:</b> ".  
                $userinfo{'request.host'}."<br />\n<b>Role: </b>".  
                $userinfo{'request.role'}." ";  
  if ($userinfo{'request.course.id'}) {  
             print "<b>Course:</b> ".  
           $userinfo{'course.'.$userinfo{'request.course.id'}.'.description'}.  
                 ' ('.$userinfo{'request.course.id'}.')';  
             $usercount{'in Course '.  
    $userinfo{'course.'.$userinfo{'request.course.id'}.'.description'}.  
    ' ('.$userinfo{'request.course.id'}.')'}++;  
         } else {  
     print "Not in a course.";  
         }  
         print "<br /><b>Last Transaction:</b> ".localtime($mtime).  
        " (".$since." secs ago) <br /><b>Last Access:</b> ".localtime($atime).  
        " (".$sinceacc." secs ago)";  
        print ("</font>");   
      }        
     }      }
       if (!defined($usercount{$cat}{$scope})) {
    $usercount{$cat}{$scope}={};
       }
       $usercount{$cat}{$scope}{$class}++;
 }  }
 closedir(DIR);  
 unless ($oneline) {   sub main {
 print "<hr /><h2>User Count</h2>";      my $perlvar=LONCAPA::Configuration::read_conf('loncapa.conf');
 foreach (sort keys %usercount) {      delete $$perlvar{'lonReceipt'}; # remove since sensitive and not needed
     print "<b>".$_.":</b> ".$usercount{$_}."<br />";      delete $$perlvar{'lonSqlAccess'}; # remove since sensitive and not needed
   
       my $oneline=($ENV{'QUERY_STRING'} eq 'simple');
       my $justsummary=($ENV{'QUERY_STRING'} eq 'summary');
       unless ($oneline) { print "<html><body bgcolor=#FFFFFF>\n<h1>User Status ".localtime()."</h1>"; }
   
       opendir(DIR,$$perlvar{'lonIDsDir'});
       my @allfiles=(sort(readdir(DIR)));
       foreach my $filename (@allfiles) {
    if ($filename=~/^\./) { next; }
    my ($dev,$ino,$mode,$nlink,
       $uid,$gid,$rdev,$size,
       $atime,$mtime,$ctime,
       $blksize,$blocks)=stat($$perlvar{'lonIDsDir'}.'/'.$filename);
    my $now=time;
    my $since=$now-$mtime;
    my $sinceacc=$now-$atime;
    unless ($oneline || $justsummary) { print ("\n\n<hr />"); }
    my %userinfo;
    my $fh=IO::File->new($$perlvar{'lonIDsDir'}.'/'.$filename);
    while (my $line=<$fh>) {
       chomp($line);
       my ($name,$value)=split(/\=/,$line);
       $userinfo{$name}=$value;
    }
    $fh->close();
    my ($color,$userclass)=&analyze_time($since);
    &add_count('Overall','all',$userclass);
    &add_count('Domain',$userinfo{'user.domain'},$userclass);
   
    unless ($oneline) {
       if (!$justsummary) {
    print '<font color="'.$color.'">';
    print '<h3>'.$userinfo{'environment.lastname'}.', '.
       $userinfo{'environment.firstname'}.' '.
       $userinfo{'environment.middlename'}.' '.
       $userinfo{'environment.generation'}." (".
       $userinfo{'user.name'}."\@".$userinfo{'user.domain'}.
       ")</h3>\n<b>Login time:</b> ".
       localtime($userinfo{'user.login.time'}).
       ' <b>Browser</b>: '.$userinfo{'browser.type'}." <b>Client:</b> ".
       $userinfo{'request.host'}."<br />\n<b>Role: </b>".
       $userinfo{'request.role'}." ";
       }
       &add_count('Browser',$userinfo{'browser.type'},$userinfo{'browser.version'});
       if ($userinfo{'request.course.id'}) {
    my $cid=$userinfo{'request.course.id'};
    my $coursename= $userinfo{'course.'.$cid.'.description'}.
       ' ('.$cid.')';
    if (!$justsummary) { print "<b>Course:</b> ".$coursename; }
    &add_count('Course',$coursename,$userclass);
       } else {
    if (!$justsummary) { print "Not in a course."; }
    &add_count('Course','No Course',$userclass);
       }
       if (!$justsummary) {
    print "<br /><b>Last Transaction:</b> ".localtime($mtime).
       " (".$since." secs ago) <br /><b>Last Access:</b> ".
       localtime($atime)." (".$sinceacc." secs ago)";
    print ("</font>"); 
       }
    }
       }
       closedir(DIR);
       open (LOADAVGH,"/proc/loadavg");
       my $loadavg=<LOADAVGH>;
       close(LOADAVGH);
       unless ($oneline) { 
    print "<hr /><h2>User Counts</h2>";
   # print "<pre>\n";
    &showact('Overall',%usercount);
    &showact('Domain',%usercount);
    &showact('Course',%usercount);
    &show('Browser',%usercount);
   
   # print "\n</pre>";
    print "<b>Load Average:<b> ".$loadavg;
    print "</body></html>";
       } else {
    foreach my $l1 (sort keys %usercount) {
       foreach my $l2 (sort keys %{$usercount{$l1}}) {
    foreach my $l3 (sort keys %{$usercount{$l1}{$l2}}) {
       print $l1.'_'.$l2.'_'.$l3.'='.$usercount{$l1}{$l2}{$l3}.'&';
    }
       }
    }
    #clusterstatus values
    foreach my $act (@actl) {
       print "$act=".$usercount{'Overall'}{'all'}{$act}.'&';
    }
    print 'loadavg='.$loadavg;
       }
 }  }
 print "</body></html>";  
 } else {  sub show {
 foreach (sort keys %usercount) {      my ($cat,%usercount)=@_;
     print $_.'='.$usercount{$_}.'&';      print("<h3>$cat</h3>\n");
       foreach my $type (sort(keys(%{$usercount{$cat}}))) {
    print("<table border='1'><tr><th>$type</th><th>");
    print(join("</th><th>",sort(keys(%{$usercount{$cat}{$type}}))));
    my $temp;
    my $count=0;
    foreach my $version (sort(keys(%{$usercount{$cat}{$type}}))) {
       $temp.="<td>".$usercount{$cat}{$type}{$version}.
    "</td>";
       $count+=$usercount{$cat}{$type}{$version};
    }
    print("</th></tr><tr><td>$count</td>");
    print($temp."</tr></table>\n");
       }    
 }  }
   
   sub showact {
       my ($cat,%usercount)=@_;
       print("<h3>$cat</h3>\n");
       
       print("<table border='1'><tr><th></th><th>");
       print(join("</th><th>",('Any',@actl)));
       print("</th></tr>");
       foreach my $type (sort(keys(%{$usercount{$cat}}))) {
    print("<tr><td>$type</td>");
    my $temp;
    my $count=0;
    foreach my $activity (@actl) {
       $temp.="<td>&nbsp;".$usercount{$cat}{$type}{$activity}."</td>";
       $count+=$usercount{$cat}{$type}{$activity};
    }
    print("<td>$count</td>");
    print($temp);
       }    
       print("</tr></table>\n");
 }  }
   
Removed from v.1.3  
changed lines
  Added in v.1.8

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