loncom/lonnet/perl/lonnet.pm - diff

Return to lonnet.pm CVS log

Up to [LON-CAPA] / loncom / lonnet / perl

Diff for /loncom/lonnet/perl/lonnet.pm between versions 1.185 and 1.190

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>');

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

Removed from v.1.185
changed lines
	Added in v.1.190