loncom/cgi/userstatus.pl - diff

Return to userstatus.pl CVS log

Up to [LON-CAPA] / loncom / cgi

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

version 1.8, 2003/10/30 22:52:25	version 1.15, 2006/09/19 21:36:31
Line 30 $\|=1;	Line 30 $\|=1;
use strict;	use strict;
use lib '/home/httpd/lib/perl/';	use lib '/home/httpd/lib/perl/';
use LONCAPA::Configuration;	use LONCAPA::Configuration;
	use LONCAPA;
use HTTP::Headers;	use HTTP::Headers;
use IO::File;	use GDBM_File;


my %usercount;	my %usercount;
Line 48 sub analyze_time {	Line 48 sub analyze_time {
my ($since)=@_;	my ($since)=@_;
my $color="#000000";	my $color="#000000";
my $userclass=$actl[0];	my $userclass=$actl[0];
if ($since>300) { $color="#222222"; }	if ($since>300) { $color="#222222"; $userclass=$actl[1]; }
if ($since>600) { $color="#444444"; }	if ($since>600) { $color="#444444"; }
if ($since>1800) { $color="#666666"; $userclass=$actl[1]; }	if ($since>1800) { $color="#666666"; }
if ($since>7200) { $color="#888888"; }	if ($since>7200) { $color="#888888"; }
if ($since>21600) { $color="#AAAAAA"; $userclass=$actl[2]; }	if ($since>21600) { $color="#AAAAAA"; $userclass=$actl[2]; }
return ($color,$userclass);	return ($color,$userclass);
Line 78 sub main {	Line 78 sub main {

opendir(DIR,$$perlvar{'lonIDsDir'});	opendir(DIR,$$perlvar{'lonIDsDir'});
my @allfiles=(sort(readdir(DIR)));	my @allfiles=(sort(readdir(DIR)));
	my %users;
foreach my $filename (@allfiles) {	foreach my $filename (@allfiles) {
if ($filename=~/^\./) { next; }	if ($filename=~/^\./) { next; }
	if ($filename=~/^publicuser_/) { next; }
my ($dev,$ino,$mode,$nlink,	my ($dev,$ino,$mode,$nlink,
$uid,$gid,$rdev,$size,	$uid,$gid,$rdev,$size,
$atime,$mtime,$ctime,	$atime,$mtime,$ctime,
Line 87 sub main {	Line 89 sub main {
my $now=time;	my $now=time;
my $since=$now-$mtime;	my $since=$now-$mtime;
my $sinceacc=$now-$atime;	my $sinceacc=$now-$atime;
unless ($oneline \|\| $justsummary) { print ("\n\n<hr />"); }	#unless ($oneline \|\| $justsummary) { print ("\n\n<hr />"); }
my %userinfo;	my %userinfo;
my $fh=IO::File->new($$perlvar{'lonIDsDir'}.'/'.$filename);	($userinfo{'user.name'},undef,$userinfo{'user.domain'})=
while (my $line=<$fh>) {	split('_',$filename);
chomp($line);
my ($name,$value)=split(/\=/,$line);
$userinfo{$name}=$value;
}
$fh->close();
my ($color,$userclass)=&analyze_time($since);	my ($color,$userclass)=&analyze_time($since);
&add_count('Overall','all',$userclass);	&add_count('Overall','all',$userclass);
&add_count('Domain',$userinfo{'user.domain'},$userclass);	&add_count('Domain',$userinfo{'user.domain'},$userclass);

unless ($oneline) {	unless ($oneline) {
	if (!tie(%userinfo,'GDBM_File',
	$$perlvar{'lonIDsDir'}.'/'.$filename,
	&GDBM_READER(),0640)) {
	next;
	}
if (!$justsummary) {	if (!$justsummary) {
print '<font color="'.$color.'">';	$users{$userclass}{$filename} .=
print '<h3>'.$userinfo{'environment.lastname'}.', '.	'<font color="'.$color.'">'.
	'<h3>'.$userinfo{'environment.lastname'}.', '.
$userinfo{'environment.firstname'}.' '.	$userinfo{'environment.firstname'}.' '.
$userinfo{'environment.middlename'}.' '.	$userinfo{'environment.middlename'}.' '.
$userinfo{'environment.generation'}." (".	$userinfo{'environment.generation'}." (".
$userinfo{'user.name'}."\@".$userinfo{'user.domain'}.	$userinfo{'user.name'}."\@".$userinfo{'user.domain'}.
")</h3>\n<b>Login time:</b> ".	")</h3>\n<b>Login time:</b> ".
localtime($userinfo{'user.login.time'}).	localtime($userinfo{'user.login.time'}).
' <b>Browser</b>: '.$userinfo{'browser.type'}." <b>Client:</b> ".	' <b>Browser</b>: '.$userinfo{'browser.type'}.
	" on ".$userinfo{'browser.os'}."<b>Client:</b> ".
$userinfo{'request.host'}."<br />\n<b>Role: </b>".	$userinfo{'request.host'}."<br />\n<b>Role: </b>".
$userinfo{'request.role'}." ";	$userinfo{'request.role'}." ";
}	}
&add_count('Browser',$userinfo{'browser.type'},$userinfo{'browser.version'});	&add_count('Browser',$userinfo{'browser.type'},$userinfo{'browser.version'});
	&add_count('OS',$userinfo{'browser.os'},$userinfo{'browser.type'});
if ($userinfo{'request.course.id'}) {	if ($userinfo{'request.course.id'}) {
my $cid=$userinfo{'request.course.id'};	my $cid=$userinfo{'request.course.id'};
my $coursename= $userinfo{'course.'.$cid.'.description'}.	my $coursename= $userinfo{'course.'.$cid.'.description'}.
' ('.$cid.')';	' ('.$cid.')';
if (!$justsummary) { print "<b>Course:</b> ".$coursename; }	if (!$justsummary) {
	$users{$userclass}{$filename} .=
	"<b>Course:</b> ".$coursename;
	}
&add_count('Course',$coursename,$userclass);	&add_count('Course',$coursename,$userclass);
} else {	} else {
if (!$justsummary) { print "Not in a course."; }	if (!$justsummary) {
	$users{$userclass}{$filename} .=
	"Not in a course.";
	}
&add_count('Course','No Course',$userclass);	&add_count('Course','No Course',$userclass);
}	}
if (!$justsummary) {	if (!$justsummary) {
print "<br /><b>Last Transaction:</b> ".localtime($mtime).	$users{$userclass}{$filename} .=
	"<br /><b>Last Transaction:</b> ".localtime($mtime).
" (".$since." secs ago) <br /><b>Last Access:</b> ".	" (".$since." secs ago) <br /><b>Last Access:</b> ".
localtime($atime)." (".$sinceacc." secs ago)";	localtime($atime)." (".$sinceacc." secs ago)".
print ("</font>");	"</font>";
}	}
}	}
	untie(%userinfo);
}	}
	if (!$oneline && !$justsummary) {
	foreach my $class (@actl) {
	print("\n\n<hr /><h1>$class</h1>");
	foreach my $filename (sort(keys(%{$users{$class}}))) {
	print("\n\n".$users{$class}{$filename}."\n\n<hr />");
	}
	}
	}

closedir(DIR);	closedir(DIR);
open (LOADAVGH,"/proc/loadavg");	open (LOADAVGH,"/proc/loadavg");
my $loadavg=<LOADAVGH>;	my $loadavg=<LOADAVGH>;
Line 144 sub main {	Line 166 sub main {
&showact('Domain',%usercount);	&showact('Domain',%usercount);
&showact('Course',%usercount);	&showact('Course',%usercount);
&show('Browser',%usercount);	&show('Browser',%usercount);
	&show('OS',%usercount);

# print "\n</pre>";	# print "\n</pre>";
print "<b>Load Average:<b> ".$loadavg;	print "<b>Load Average:<b> ".$loadavg;

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

Removed from v.1.8
changed lines
	Added in v.1.15