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.183 and 1.190

version 1.183, 2001/12/05 21:00:23	version 1.190, 2001/12/12 23:34:14
Line 61	Line 61
# 10/5,10/10,11/13,11/15 Scott Harrison	# 10/5,10/10,11/13,11/15 Scott Harrison
# 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
# $Id$	# 12/6,12/7,12/12 Gerd Kortemeyer
#	#
###	###

Line 170 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 $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 IO::Socket;
use GDBM_File;	use GDBM_File;
use Apache::Constants qw(:common :http);	use Apache::Constants qw(:common :http);
Line 753 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 767 sub flushcourselogs {	Line 769 sub flushcourselogs {
}	}
}	}
} keys %courselogs;	} 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 {	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 788 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 797 sub courseacclog {	Line 815 sub courseacclog {
&courselog($what);	&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	# ----------------------------------------------------------- Check out an item

sub checkout {	sub checkout {
Line 1078 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 1087 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 1103 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 1113 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 1129 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 1710 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 2607 sub unescape {	Line 2652 sub unescape {

# ================================================================ Main Program	# ================================================================ Main Program

	sub goodbye {
	&flushcourselogs();
	&logthis("Shutting down");
	}

BEGIN {	BEGIN {
# ------------------------------------------------------------ Read access.conf	# ------------------------------------------------------------ Read access.conf
{	{
Line 2704 BEGIN {	Line 2754 BEGIN {

%metacache=();	%metacache=();

$readit='done';	$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.183
changed lines
	Added in v.1.190