[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.18

version 1.3, 2003/07/29 20:17:52 version 1.18, 2008/12/25 01:56:03
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 Apache::lonlocal;
 use LONCAPA::Configuration;  use LONCAPA::Configuration;
   use LONCAPA::loncgi;
   use LONCAPA::lonauthcgi;
 use HTTP::Headers;  use HTTP::Headers;
 use IO::File;  use GDBM_File;
   
    
 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');  my $perlvar=&LONCAPA::Configuration::read_conf('loncapa.conf');
 my %perlvar=%{$perlvarref};  
 undef $perlvarref; # remove since sensitive and not needed  print "Content-type: text/html\n\n";
 delete $perlvar{'lonReceipt'}; # remove since sensitive and not needed  my %usercount;
 delete $perlvar{'lonSqlAccess'}; # remove since sensitive and not needed  my @actl=('Active','Moderately Active','Inactive');
   
 my $oneline=($ENV{'QUERY_STRING'} eq 'simple');  &main($perlvar);
 unless ($oneline) { print "<html><body bgcolor=#FFFFFF>\n<h1>User Status ".localtime()."</h1>"; }  
   sub analyze_time {
 my $filename;      my ($since)=@_;
 opendir(DIR,$perlvar{'lonIDsDir'});      my $color="#000000";
 %usercounts=();      my $userclass=$actl[0];
 while ($filename=readdir(DIR)) {      if ($since>300) { $color="#222222"; $userclass=$actl[1]; }
     unless ($filename=~/^\./) {      if ($since>600) { $color="#444444"; }
         my ($dev,$ino,$mode,$nlink,      if ($since>1800) { $color="#666666"; }
             $uid,$gid,$rdev,$size,      if ($since>7200) { $color="#888888"; }
             $atime,$mtime,$ctime,      if ($since>21600) { $color="#AAAAAA"; $userclass=$actl[2]; }
             $blksize,$blocks)=stat($perlvar{'lonIDsDir'}.'/'.$filename);      return ($color,$userclass);
         $now=time;  }
         $since=$now-$mtime;  
         $sinceacc=$now-$atime;  sub add_count {
  unless ($oneline) { print ("\n\n<hr />"); }      my ($cat,$scope,$class)=@_;
         my %userinfo=();      if (!defined($usercount{$cat})) {
         undef $userinfo;   $usercount{$cat}={};
         my $fh=IO::File->new($perlvar{'lonIDsDir'}.'/'.$filename);      }
         while ($line=<$fh>) {      if (!defined($usercount{$cat}{$scope})) {
             chomp($line);   $usercount{$cat}{$scope}={};
             my ($name,$value)=split(/\=/,$line);      }
             $userinfo{$name}=$value;      $usercount{$cat}{$scope}{$class}++;
   }
   
   sub main {
       my ($perlvar) = @_;
       delete $$perlvar{'lonReceipt'}; # remove since sensitive and not needed
       delete $$perlvar{'lonSqlAccess'}; # remove since sensitive and not needed
   
       if (!&LONCAPA::lonauthcgi::check_ipbased_access()) {
           if (!&LONCAPA::loncgi::check_cookie_and_load_env()) {
               &Apache::lonlocal::get_language_handle();
               print &LONCAPA::loncgi::missing_cookie_msg();
               return;
         }          }
         $fh->close();  
         $color="#000000";          if (!&LONCAPA::lonauthcgi::can_view('userstatus')) {
         $userclass="Active";              &Apache::lonlocal::get_language_handle();
         if ($since>300) { $color="#222222"; }              print &LONCAPA::lonauthcgi::unauthorized_msg('userstatus');
         if ($since>600) { $color="#444444"; }              return;
         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)";      &Apache::lonlocal::get_language_handle();
        print ("</font>");       my (%gets,$dom,$oneline,$justsummary);
      }            &LONCAPA::loncgi::cgi_getitems($ENV{'QUERY_STRING'},\%gets);
       if (defined($gets{'simple'})) { 
           $oneline = 'simple'; 
       } 
       if (defined($gets{'summary'})) { 
           $justsummary = 'summary'; 
       }
    
       my %lt = &Apache::lonlocal::texthash(
                     usrs                => 'User Status',
                     login               => 'Login time',
                     on                  => 'on',
                     Client              => 'Client',
                     role                => 'Role',
                     notc                => 'Not in a course',
                     ltra                => 'Last Transaction',
                     lacc                => 'Last Access',
                     secs                => 'secs ago',
                     usrc                => 'User Counts',
                     load                => 'Load Average',
                     Overall             => 'Overall',
                     Domain              => 'Domain',
                     Course              => 'Course',
                     Browser             => 'Browser',
                     OS                  => 'OS',
                     Active              => 'Active',
                     'Moderately Active' => 'Moderately Active',
                     Inactive            => 'Inactive',
               );
       
       unless ($oneline) {
           my $now = time();
           print '<html><body bgcolor="#FFFFFF">'."\n".
                 "<h1>$lt{'usrs'} ".&Apache::lonlocal::locallocaltime($now).'</h1>';
       }
   
       opendir(DIR,$$perlvar{'lonIDsDir'});
       my @allfiles=(sort(readdir(DIR)));
       my %users;
       foreach my $filename (@allfiles) {
    if ($filename=~/^\./) { next; }
    if ($filename=~/^publicuser_/) { 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;
    ($userinfo{'user.name'},undef,$userinfo{'user.domain'})=
       split('_',$filename);
    my ($color,$userclass)=&analyze_time($since);
    &add_count('Overall','all',$userclass);
    &add_count('Domain',$userinfo{'user.domain'},$userclass);
   
    unless ($oneline) {
       if (!tie(%userinfo,'GDBM_File',
        $$perlvar{'lonIDsDir'}.'/'.$filename,
        &GDBM_READER(),0640)) {
    next;
       }
       if (!$justsummary) {
    $users{$userclass}{$filename} .=
       '<font color="'.$color.'">'.
       '<h3>'.$userinfo{'environment.lastname'}.', '.
       $userinfo{'environment.firstname'}.' '.
       $userinfo{'environment.middlename'}.' '.
       $userinfo{'environment.generation'}." (".
       $userinfo{'user.name'}."\@".$userinfo{'user.domain'}.
       ")</h3>\n".
       "<p><tt>$filename</tt></p>".
       "<b>$lt{'login'}:</b> ".
       &Apache::lonlocal::locallocaltime($userinfo{'user.login.time'}).
       " <b>$lt{'Browser'}</b>: ".$userinfo{'browser.type'}.
       " $lt{'on'} ".$userinfo{'browser.os'}."<b>$lt{'Client'}:</b>".
       $userinfo{'request.host'}."<br />\n<b>$lt{'role'}: </b>".
       $userinfo{'request.role'}." ";
       }
       &add_count('Browser',$userinfo{'browser.type'},$userinfo{'browser.version'});
       &add_count('OS',$userinfo{'browser.os'},$userinfo{'browser.type'});
       if ($userinfo{'request.course.id'}) {
    my $cid=$userinfo{'request.course.id'};
    my $coursename= $userinfo{'course.'.$cid.'.description'}.
       ' ('.$cid.')';
    if (!$justsummary) { 
       $users{$userclass}{$filename} .= 
    "<b>$lt{'Course'}:</b> ".$coursename; 
    }
    &add_count('Course',$coursename,$userclass);
       } else {
    if (!$justsummary) {
       $users{$userclass}{$filename} .= $lt{'notc'}; 
    }
    &add_count('Course','No Course',$userclass);
       }
       if (!$justsummary) {
    $users{$userclass}{$filename} .=
       "<br /><b>$lt{'ltra'}:</b> ".&Apache::lonlocal::locallocaltime($mtime).
       " (".$since." $lt{'secs'}) <br /><b>$lt{'lacc'}:</b> ".
       &Apache::lonlocal::locallocaltime($atime)." (".$sinceacc." $lt{'secs'})".
       "</font>";
       }
    }
    untie(%userinfo);
       }
       if (!$oneline && !$justsummary) {
           foreach my $class (@actl) {
       print("\n\n<hr /><h1>$lt{$class}</h1>");    
       foreach my $filename (sort(keys(%{$users{$class}}))) {
    print("\n\n".$users{$class}{$filename}."\n\n<hr />");    
       }
    }
       }
   
       closedir(DIR);
       open (LOADAVGH,"/proc/loadavg");
       my $loadavg=<LOADAVGH>;
       close(LOADAVGH);
       unless ($oneline) { 
    print "<hr /><h2>$lt{'usrc'}</h2>";
   # print "<pre>\n";
    &showact('Overall',\%lt,%usercount);
    &showact('Domain',\%lt,%usercount);
    &showact('Course',\%lt,%usercount);
    &show('Browser',\%lt,%usercount);
    &show('OS',\%lt,%usercount);
   
   # print "\n</pre>";
    print "<b>$lt{'load'}:<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;
     }      }
 }  }
 closedir(DIR);  
 unless ($oneline) {   sub show {
 print "<hr /><h2>User Count</h2>";      my ($cat,$ltref,%usercount)=@_;
 foreach (sort keys %usercount) {      print("<h3>$ltref->{$cat}</h3>\n");
     print "<b>".$_.":</b> ".$usercount{$_}."<br />";      foreach my $type (sort(keys(%{$usercount{$cat}}))) {
 }   print("<table border='1'><tr><th>$type</th><th>");
 print "</body></html>";   print(join("</th><th>",sort(keys(%{$usercount{$cat}{$type}}))));
 } else {   my $temp;
 foreach (sort keys %usercount) {   my $count=0;
     print $_.'='.$usercount{$_}.'&';   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,$ltref,%usercount)=@_;
       print("<h3>$ltref->{$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.18

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