version 1.185, 2001/12/06 21:03:02
|
version 1.190, 2001/12/12 23:34:14
|
Line 62
|
Line 62
|
# 11/17,11/20,11/22,11/29 Gerd Kortemeyer |
# 11/17,11/20,11/22,11/29 Gerd Kortemeyer |
# 12/5 Matthew Hall |
# 12/5 Matthew Hall |
# 12/5 Guy Albertelli |
# 12/5 Guy Albertelli |
# 12/6 Gerd Kortemeyer |
# 12/6,12/7,12/12 Gerd Kortemeyer |
# |
|
# $Id$ |
|
# |
# |
### |
### |
|
|
Line 172 use Apache::File;
|
Line 170 use Apache::File;
|
use LWP::UserAgent(); |
use LWP::UserAgent(); |
use HTTP::Headers; |
use HTTP::Headers; |
use vars |
use vars |
qw(%perlvar %hostname %homecache %hostip %spareid %hostdom %libserv %pr %prp %fe %fd %metacache %packagetab %courselogs %accesshash $processmarker); |
qw(%perlvar %hostname %homecache %hostip %spareid %hostdom |
|
%libserv %pr %prp %fe %fd %metacache %packagetab |
|
%courselogs %accesshash $processmarker $dumpcount |
|
%coursedombuf %coursehombuf); |
use IO::Socket; |
use IO::Socket; |
use GDBM_File; |
use GDBM_File; |
use Apache::Constants qw(:common :http); |
use Apache::Constants qw(:common :http); |
Line 755 sub flushcourselogs {
|
Line 756 sub flushcourselogs {
|
&logthis('Flushing course log buffers'); |
&logthis('Flushing course log buffers'); |
map { |
map { |
my $crsid=$_; |
my $crsid=$_; |
if (&reply('log:'.$ENV{'course.'.$crsid.'.domain'}.':'. |
if (&reply('log:'.$coursedombuf{$crsid}.':'. |
$ENV{'course.'.$crsid.'.num'}.':'. |
&escape($courselogs{$crsid}), |
&escape($courselogs{$crsid}), |
$coursehombuf{$crsid}) eq 'ok') { |
$ENV{'course.'.$crsid.'.home'}) eq 'ok') { |
|
delete $courselogs{$crsid}; |
delete $courselogs{$crsid}; |
} else { |
} else { |
&logthis('Failed to flush log buffer for '.$crsid); |
&logthis('Failed to flush log buffer for '.$crsid); |
Line 778 sub flushcourselogs {
|
Line 778 sub flushcourselogs {
|
delete $accesshash{$entry}; |
delete $accesshash{$entry}; |
} |
} |
} keys %accesshash; |
} keys %accesshash; |
|
$dumpcount++; |
} |
} |
|
|
sub courselog { |
sub courselog { |
my $what=shift; |
my $what=shift; |
$what=time.':'.$what; |
$what=time.':'.$what; |
unless ($ENV{'request.course.id'}) { return ''; } |
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'}}) { |
if (defined $courselogs{$ENV{'request.course.id'}}) { |
$courselogs{$ENV{'request.course.id'}}.='&'.$what; |
$courselogs{$ENV{'request.course.id'}}.='&'.$what; |
} else { |
} else { |
Line 799 sub courseacclog {
|
Line 805 sub courseacclog {
|
unless ($ENV{'request.course.id'}) { return ''; } |
unless ($ENV{'request.course.id'}) { return ''; } |
my $what=$fnsymb.':'.$ENV{'user.name'}.':'.$ENV{'user.domain'}; |
my $what=$fnsymb.':'.$ENV{'user.name'}.':'.$ENV{'user.domain'}; |
if ($what=~/(problem|exam|quiz|assess|survey|form)$/) { |
if ($what=~/(problem|exam|quiz|assess|survey|form)$/) { |
|
$what.=':POST'; |
map { |
map { |
if ($_=~/^form\.(.*)/) { |
if ($_=~/^form\.(.*)/) { |
$what.=':'.$1.'='.$ENV{$_}; |
$what.=':'.$1.'='.$ENV{$_}; |
Line 812 sub countacc {
|
Line 819 sub countacc {
|
my $url=&declutter(shift); |
my $url=&declutter(shift); |
unless ($ENV{'request.course.id'}) { return ''; } |
unless ($ENV{'request.course.id'}) { return ''; } |
$accesshash{$ENV{'request.course.id'}.'___'.$url.'___course'}=1; |
$accesshash{$ENV{'request.course.id'}.'___'.$url.'___course'}=1; |
my $key=$processmarker.'___'.$url.'___count'; |
my $key=$processmarker.'_'.$dumpcount.'___'.$url.'___count'; |
if (defined($accesshash{$key})) { |
if (defined($accesshash{$key})) { |
$accesshash{$key}++; |
$accesshash{$key}++; |
} else { |
} else { |
Line 1101 sub store {
|
Line 1108 sub store {
|
&devalidate($symb); |
&devalidate($symb); |
|
|
$symb=escape($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 (!$domain) { $domain=$ENV{'user.domain'}; } |
if (!$stuname) { $stuname=$ENV{'user.name'}; } |
if (!$stuname) { $stuname=$ENV{'user.name'}; } |
if (!$home) { $home=$ENV{'user.home'}; } |
if (!$home) { $home=$ENV{'user.home'}; } |
Line 1110 sub store {
|
Line 1121 sub store {
|
$namevalue.=escape($_).'='.escape($$storehash{$_}).'&'; |
$namevalue.=escape($_).'='.escape($$storehash{$_}).'&'; |
} keys %$storehash; |
} keys %$storehash; |
$namevalue=~s/\&$//; |
$namevalue=~s/\&$//; |
|
&courselog($symb.':'.$stuname.':'.$domain.':STORE:'.$namevalue); |
return reply("store:$domain:$stuname:$namespace:$symb:$namevalue","$home"); |
return reply("store:$domain:$stuname:$namespace:$symb:$namevalue","$home"); |
} |
} |
|
|
Line 1126 sub cstore {
|
Line 1138 sub cstore {
|
&devalidate($symb); |
&devalidate($symb); |
|
|
$symb=escape($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 (!$domain) { $domain=$ENV{'user.domain'}; } |
if (!$stuname) { $stuname=$ENV{'user.name'}; } |
if (!$stuname) { $stuname=$ENV{'user.name'}; } |
if (!$home) { $home=$ENV{'user.home'}; } |
if (!$home) { $home=$ENV{'user.home'}; } |
Line 1136 sub cstore {
|
Line 1152 sub cstore {
|
$namevalue.=escape($_).'='.escape($$storehash{$_}).'&'; |
$namevalue.=escape($_).'='.escape($$storehash{$_}).'&'; |
} keys %$storehash; |
} keys %$storehash; |
$namevalue=~s/\&$//; |
$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 |
# --------------------------------------------------------------------- Restore |
Line 1152 sub restore {
|
Line 1170 sub restore {
|
} else { |
} else { |
$symb=&escape($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 (!$domain) { $domain=$ENV{'user.domain'}; } |
if (!$stuname) { $stuname=$ENV{'user.name'}; } |
if (!$stuname) { $stuname=$ENV{'user.name'}; } |
if (!$home) { $home=$ENV{'user.home'}; } |
if (!$home) { $home=$ENV{'user.home'}; } |
Line 1733 sub plaintext {
|
Line 1755 sub plaintext {
|
return $prp{$short}; |
return $prp{$short}; |
} |
} |
|
|
# ------------------------------------------------------------------ Plain Text |
# ------------------------------------------------------------- Embedding Style |
|
|
sub fileembstyle { |
sub fileembstyle { |
my $ending=lc(shift); |
my $ending=lc(shift); |
Line 2733 BEGIN {
|
Line 2755 BEGIN {
|
%metacache=(); |
%metacache=(); |
|
|
$processmarker=$$.'_'.time.'_'.$perlvar{'lonHostID'}; |
$processmarker=$$.'_'.time.'_'.$perlvar{'lonHostID'}; |
|
$dumpcount=0; |
|
|
&logtouch(); |
&logtouch(); |
&logthis('<font color=yellow>INFO: Read configuration</font>'); |
&logthis('<font color=yellow>INFO: Read configuration</font>'); |