[LON-CAPA-cvs] cvs: loncom / lond /lonnet/perl lonnet.pm
www
lon-capa-cvs@mail.lon-capa.org
Tue, 25 Mar 2003 22:03:23 -0000
www Tue Mar 25 17:03:23 2003 EDT
Modified files:
/loncom lond
/loncom/lonnet/perl lonnet.pm
Log:
Reverse lookup course id database file.
/home/httpd/lonUsers/domain/nohist_courseids.db
Gets generated by lonnet::flushcourselogs
Includes courseid, description, and last access time
New commands in lond:
* courseidput - to write to this file
* courseiddump - to quere it
Not concerned about backward compatibility, since only used by
non-mission-critical functionality, and only called if server is updated
anyway. 'no_such_cmd' not a problem.
Index: loncom/lond
diff -u loncom/lond:1.117 loncom/lond:1.118
--- loncom/lond:1.117 Mon Mar 24 14:46:52 2003
+++ loncom/lond Tue Mar 25 17:03:23 2003
@@ -2,7 +2,7 @@
# The LearningOnline Network
# lond "LON Daemon" Server (port "LOND" 5663)
#
-# $Id: lond,v 1.117 2003/03/24 19:46:52 www Exp $
+# $Id: lond,v 1.118 2003/03/25 22:03:23 www Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -1534,6 +1534,71 @@
." IO::File->new Failed ".
"while attempting queryreply\n";
}
+# ----------------------------------------------------------------- courseidput
+ } elsif ($userinput =~ /^courseidput/) {
+ my ($cmd,$udom,$what)=split(/:/,$userinput);
+ chomp($what);
+ $udom=~s/\W//g;
+ my $proname=
+ "$perlvar{'lonUsersDir'}/$udom/nohist_courseids";
+ my $now=time;
+ my @pairs=split(/\&/,$what);
+ if (tie(%hash,'GDBM_File',"$proname.db",&GDBM_WRCREAT,0640)) {
+ foreach $pair (@pairs) {
+ ($key,$value)=split(/=/,$pair);
+ $hash{$key}=$value.':'.$now;
+ }
+ if (untie(%hash)) {
+ print $client "ok\n";
+ } else {
+ print $client "error: ".($!+0)
+ ." untie(GDBM) Failed ".
+ "while attempting courseidput\n";
+ }
+ } else {
+ print $client "error: ".($!+0)
+ ." tie(GDBM) Failed ".
+ "while attempting courseidput\n";
+ }
+# ---------------------------------------------------------------- courseiddump
+ } elsif ($userinput =~ /^courseiddump/) {
+ my ($cmd,$udom,$since,$description)
+ =split(/:/,$userinput);
+ if (defined($description)) {
+ $description=&unescape($description);
+ } else {
+ $description='.';
+ }
+ unless (defined($since)) { $since=0; }
+ my $qresult='';
+ my $proname=
+ "$perlvar{'lonUsersDir'}/$udom/nohist_courseids";
+ if (tie(%hash,'GDBM_File',"$proname.db",&GDBM_READER(),0640)) {
+ while (($key,$value) = each(%hash)) {
+ my ($descr,$lasttime)=split(/\:/,$value);
+ if ($lasttime<$since) { next; }
+ if ($regexp eq '.') {
+ $qresult.=$key.'='.$descr.'&';
+ } else {
+ my $unescapeVal = &unescape($descr);
+ if (eval('$unescapeVal=~/$description/')) {
+ $qresult.="$key=$descr&";
+ }
+ }
+ }
+ if (untie(%hash)) {
+ chop($qresult);
+ print $client "$qresult\n";
+ } else {
+ print $client "error: ".($!+0)
+ ." untie(GDBM) Failed ".
+ "while attempting courseiddump\n";
+ }
+ } else {
+ print $client "error: ".($!+0)
+ ." tie(GDBM) Failed ".
+ "while attempting courseiddump\n";
+ }
# ----------------------------------------------------------------------- idput
} elsif ($userinput =~ /^idput/) {
my ($cmd,$udom,$what)=split(/:/,$userinput);
Index: loncom/lonnet/perl/lonnet.pm
diff -u loncom/lonnet/perl/lonnet.pm:1.351 loncom/lonnet/perl/lonnet.pm:1.352
--- loncom/lonnet/perl/lonnet.pm:1.351 Tue Mar 25 14:18:40 2003
+++ loncom/lonnet/perl/lonnet.pm Tue Mar 25 17:03:23 2003
@@ -1,7 +1,7 @@
# The LearningOnline Network
# TCP networking package
#
-# $Id: lonnet.pm,v 1.351 2003/03/25 19:18:40 www Exp $
+# $Id: lonnet.pm,v 1.352 2003/03/25 22:03:23 www Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -75,7 +75,7 @@
qw(%perlvar %hostname %homecache %badServerCache %hostip %iphost %spareid %hostdom
%libserv %pr %prp %metacache %packagetab %titlecache
%courselogs %accesshash %userrolehash $processmarker $dumpcount
- %coursedombuf %coursehombuf %courseresdatacache
+ %coursedombuf %coursenumbuf %coursehombuf %coursedescrbuf %courseresdatacache
%domaindescription %domain_auth_def %domain_auth_arg_def $tmpdir);
use IO::Socket;
use GDBM_File;
@@ -1027,12 +1027,24 @@
}
# ------------------------------------------------------------------ Course Log
+#
+# This routine flushes several buffers of non-mission-critical nature
+#
sub flushcourselogs {
- &logthis('Flushing course log buffers');
+ &logthis('Flushing log buffers');
+#
+# course logs
+# This is a log of all transactions in a course, which can be used
+# for data mining purposes
+#
+# It also collects the courseid database, which lists last transaction
+# times and course titles for all courseids
+#
+ my %courseidbuffer=();
foreach (keys %courselogs) {
my $crsid=$_;
- if (&reply('log:'.$coursedombuf{$crsid}.':'.
+ if (&reply('log:'.$coursedombuf{$crsid}.':'.$coursenumbuf{$crsid}.':'.
&escape($courselogs{$crsid}),
$coursehombuf{$crsid}) eq 'ok') {
delete $courselogs{$crsid};
@@ -1043,9 +1055,26 @@
" exceeded maximum size, deleting.</font>");
delete $courselogs{$crsid};
}
- }
+ }
+ if ($courseidbuffer{$coursehombuf{$crsid}}) {
+ $courseidbuffer{$coursehombuf{$crsid}}.='&'.
+ &escape($crsid).'='.&escape($coursedescrbuf{$crsid});
+ } else {
+ $courseidbuffer{$coursehombuf{$crsid}}=
+ &escape($crsid).'='.&escape($coursedescrbuf{$crsid});
+ }
}
- &logthis('Flushing access logs');
+#
+# Write course id database (reverse lookup) to homeserver of courses
+# Is used in pickcourse
+#
+ foreach (keys %courseidbuffer) {
+ &reply('courseidput:'.$hostdom{$_}.':'.$courseidbuffer{$_},$_);
+ }
+#
+# File accesses
+# Writes to the dynamic metadata of resources to get hit counts, etc.
+#
foreach (keys %accesshash) {
my $entry=$_;
$entry=~/\_\_\_(\w+)\/(\w+)\/(.*)\_\_\_(\w+)$/;
@@ -1054,7 +1083,10 @@
delete $accesshash{$entry};
}
}
- &logthis('Flushing role logs');
+#
+# Roles
+# Reverse lookup of user roles for course faculty/staff and co-authorship
+#
foreach (keys %userrolehash) {
my $entry=$_;
my ($role,$uname,$udom,$runame,$rudom,$rsec)=
@@ -1073,10 +1105,13 @@
$what=time.':'.$what;
unless ($ENV{'request.course.id'}) { return ''; }
$coursedombuf{$ENV{'request.course.id'}}=
- $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}.':'.
+ $ENV{'course.'.$ENV{'request.course.id'}.'.domain'};
+ $coursenumbuf{$ENV{'request.course.id'}}=
$ENV{'course.'.$ENV{'request.course.id'}.'.num'};
$coursehombuf{$ENV{'request.course.id'}}=
$ENV{'course.'.$ENV{'request.course.id'}.'.home'};
+ $coursedescrbuf{$ENV{'request.course.id'}}=
+ $ENV{'course.'.$ENV{'request.course.id'}.'.description'};
if (defined $courselogs{$ENV{'request.course.id'}}) {
$courselogs{$ENV{'request.course.id'}}.='&'.$what;
} else {