--- loncom/lonnet/perl/lonnet.pm 2001/11/29 18:54:16 1.178
+++ loncom/lonnet/perl/lonnet.pm 2001/12/12 23:34:14 1.190
@@ -1,7 +1,7 @@
# The LearningOnline Network
# TCP networking package
#
-# $Id: lonnet.pm,v 1.178 2001/11/29 18:54:16 www Exp $
+# $Id: lonnet.pm,v 1.190 2001/12/12 23:34:14 www Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -59,9 +59,10 @@
# 8/4,8/7,8/8,8/9,8/11,8/16,8/17,8/18,8/20,8/23,9/20,9/21,9/26,
# 10/2 Gerd Kortemeyer
# 10/5,10/10,11/13,11/15 Scott Harrison
-# 11/17,11/20,11/22 Gerd Kortemeyer
-#
-# $Id: lonnet.pm,v 1.178 2001/11/29 18:54:16 www Exp $
+# 11/17,11/20,11/22,11/29 Gerd Kortemeyer
+# 12/5 Matthew Hall
+# 12/5 Guy Albertelli
+# 12/6,12/7,12/12 Gerd Kortemeyer
#
###
@@ -169,7 +170,10 @@ use Apache::File;
use LWP::UserAgent();
use HTTP::Headers;
use vars
-qw(%perlvar %hostname %homecache %hostip %spareid %hostdom %libserv %pr %prp %fe %fd $readit %metacache %packagetab %courselogs);
+qw(%perlvar %hostname %homecache %hostip %spareid %hostdom
+ %libserv %pr %prp %fe %fd %metacache %packagetab
+ %courselogs %accesshash $processmarker $dumpcount
+ %coursedombuf %coursehombuf);
use IO::Socket;
use GDBM_File;
use Apache::Constants qw(:common :http);
@@ -752,10 +756,9 @@ sub flushcourselogs {
&logthis('Flushing course log buffers');
map {
my $crsid=$_;
- if (&reply('log:'.$ENV{'course.'.$crsid.'.domain'}.':'.
- $ENV{'course.'.$crsid.'.num'}.':'.
- &escape($courselogs{$crsid}),
- $ENV{'course.'.$crsid.'.home'}) eq 'ok') {
+ if (&reply('log:'.$coursedombuf{$crsid}.':'.
+ &escape($courselogs{$crsid}),
+ $coursehombuf{$crsid}) eq 'ok') {
delete $courselogs{$crsid};
} else {
&logthis('Failed to flush log buffer for '.$crsid);
@@ -766,12 +769,27 @@ sub flushcourselogs {
}
}
} keys %courselogs;
+ &logthis('Flushing access logs');
+ map {
+ my $entry=$_;
+ $entry=~/\_\_\_(\w+)\/(\w+)\/(.*)\_\_\_(\w+)$/;
+ my %temphash=($entry => $accesshash{$entry});
+ if (&Apache::lonnet::put('resevaldata',\%temphash,$1,$2) eq 'ok') {
+ delete $accesshash{$entry};
+ }
+ } keys %accesshash;
+ $dumpcount++;
}
sub courselog {
my $what=shift;
$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'}.'.num'};
+ $coursehombuf{$ENV{'request.course.id'}}=
+ $ENV{'course.'.$ENV{'request.course.id'}.'.home'};
if (defined $courselogs{$ENV{'request.course.id'}}) {
$courselogs{$ENV{'request.course.id'}}.='&'.$what;
} else {
@@ -787,6 +805,7 @@ sub courseacclog {
unless ($ENV{'request.course.id'}) { return ''; }
my $what=$fnsymb.':'.$ENV{'user.name'}.':'.$ENV{'user.domain'};
if ($what=~/(problem|exam|quiz|assess|survey|form)$/) {
+ $what.=':POST';
map {
if ($_=~/^form\.(.*)/) {
$what.=':'.$1.'='.$ENV{$_};
@@ -796,6 +815,18 @@ sub courseacclog {
&courselog($what);
}
+sub countacc {
+ my $url=&declutter(shift);
+ unless ($ENV{'request.course.id'}) { return ''; }
+ $accesshash{$ENV{'request.course.id'}.'___'.$url.'___course'}=1;
+ my $key=$processmarker.'_'.$dumpcount.'___'.$url.'___count';
+ if (defined($accesshash{$key})) {
+ $accesshash{$key}++;
+ } else {
+ $accesshash{$key}=1;
+ }
+}
+
# ----------------------------------------------------------- Check out an item
sub checkout {
@@ -963,7 +994,7 @@ sub tmpreset {
$path.'/tmpstore_'.$stuname.'_'.$domain.'_'.$namespace.'.db',
&GDBM_WRCREAT,0640)) {
foreach my $key (keys %hash) {
- if ($key=~ /:$symb:/) {
+ if ($key=~ /:$symb/) {
delete($hash{$key});
}
}
@@ -1077,7 +1108,11 @@ sub store {
&devalidate($symb);
$symb=escape($symb);
- if (!$namespace) { unless ($namespace=$ENV{'request.course.id'}) { return ''; } }
+ if (!$namespace) {
+ unless ($namespace=$ENV{'request.course.id'}) {
+ return '';
+ }
+ }
if (!$domain) { $domain=$ENV{'user.domain'}; }
if (!$stuname) { $stuname=$ENV{'user.name'}; }
if (!$home) { $home=$ENV{'user.home'}; }
@@ -1086,6 +1121,7 @@ sub store {
$namevalue.=escape($_).'='.escape($$storehash{$_}).'&';
} keys %$storehash;
$namevalue=~s/\&$//;
+ &courselog($symb.':'.$stuname.':'.$domain.':STORE:'.$namevalue);
return reply("store:$domain:$stuname:$namespace:$symb:$namevalue","$home");
}
@@ -1102,7 +1138,11 @@ sub cstore {
&devalidate($symb);
$symb=escape($symb);
- if (!$namespace) { unless ($namespace=$ENV{'request.course.id'}) { return ''; } }
+ if (!$namespace) {
+ unless ($namespace=$ENV{'request.course.id'}) {
+ return '';
+ }
+ }
if (!$domain) { $domain=$ENV{'user.domain'}; }
if (!$stuname) { $stuname=$ENV{'user.name'}; }
if (!$home) { $home=$ENV{'user.home'}; }
@@ -1112,7 +1152,9 @@ sub cstore {
$namevalue.=escape($_).'='.escape($$storehash{$_}).'&';
} keys %$storehash;
$namevalue=~s/\&$//;
- return critical("store:$domain:$stuname:$namespace:$symb:$namevalue","$home");
+ &courselog($symb.':'.$stuname.':'.$domain.':CSTORE:'.$namevalue);
+ return critical
+ ("store:$domain:$stuname:$namespace:$symb:$namevalue","$home");
}
# --------------------------------------------------------------------- Restore
@@ -1128,7 +1170,11 @@ sub restore {
} else {
$symb=&escape($symb);
}
- if (!$namespace) { unless ($namespace=$ENV{'request.course.id'}) { return ''; } }
+ if (!$namespace) {
+ unless ($namespace=$ENV{'request.course.id'}) {
+ return '';
+ }
+ }
if (!$domain) { $domain=$ENV{'user.domain'}; }
if (!$stuname) { $stuname=$ENV{'user.name'}; }
if (!$home) { $home=$ENV{'user.home'}; }
@@ -1709,17 +1755,17 @@ sub plaintext {
return $prp{$short};
}
-# ------------------------------------------------------------------ Plain Text
+# ------------------------------------------------------------- Embedding Style
sub fileembstyle {
- my $ending=shift;
+ my $ending=lc(shift);
return $fe{$ending};
}
# ------------------------------------------------------------ Description Text
sub filedescription {
- my $ending=shift;
+ my $ending=lc(shift);
return $fd{$ending};
}
@@ -2409,6 +2455,7 @@ sub symblist {
sub symbread {
my $thisfn=shift;
unless ($thisfn) {
+ if ($ENV{'request.symb'}) { return $ENV{'request.symb'}; }
$thisfn=$ENV{'request.filename'};
}
$thisfn=declutter($thisfn);
@@ -2605,8 +2652,12 @@ sub unescape {
# ================================================================ Main Program
-sub BEGIN {
-unless ($readit) {
+sub goodbye {
+ &flushcourselogs();
+ &logthis("Shutting down");
+}
+
+BEGIN {
# ------------------------------------------------------------ Read access.conf
{
my $config=Apache::File->new("/etc/httpd/conf/access.conf");
@@ -2691,10 +2742,11 @@ unless ($readit) {
my $config=Apache::File->new("$perlvar{'lonTabDir'}/filetypes.tab");
while (my $configline=<$config>) {
+ next if ($configline =~ /^\#/);
chomp($configline);
my ($ending,$emb,@descr)=split(/\s+/,$configline);
if ($descr[0] ne '') {
- $fe{$ending}=$emb;
+ $fe{$ending}=lc($emb);
$fd{$ending}=join(' ',@descr);
}
}
@@ -2702,9 +2754,11 @@ unless ($readit) {
%metacache=();
-$readit='done';
+$processmarker=$$.'_'.time.'_'.$perlvar{'lonHostID'};
+$dumpcount=0;
+
&logtouch();
&logthis('<font color=yellow>INFO: Read configuration</font>');
}
-}
+
1;