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.173 and 1.185

version 1.173, 2001/11/20 17:58:05	version 1.185, 2001/12/06 21:03:02
Line 1	Line 1
# The LearningOnline Network	# The LearningOnline Network
# TCP networking package	# TCP networking package
#	#
	# $Id$
	#
	# Copyright Michigan State University Board of Trustees
	#
	# This file is part of the LearningOnline Network with CAPA (LON-CAPA).
	#
	# LON-CAPA is free software; you can redistribute it and/or modify
	# it under the terms of the GNU General Public License as published by
	# the Free Software Foundation; either version 2 of the License, or
	# (at your option) any later version.
	#
	# LON-CAPA is distributed in the hope that it will be useful,
	# but WITHOUT ANY WARRANTY; without even the implied warranty of
	# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
	# GNU General Public License for more details.
	#
	# You should have received a copy of the GNU General Public License
	# along with LON-CAPA; if not, write to the Free Software
	# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
	#
	# /home/httpd/html/adm/gpl.txt
	#
	# http://www.lon-capa.org/
	#
# 6/1/99,6/2,6/10,6/11,6/12,6/14,6/26,6/28,6/29,6/30,	# 6/1/99,6/2,6/10,6/11,6/12,6/14,6/26,6/28,6/29,6/30,
# 7/1,7/2,7/9,7/10,7/12,7/14,7/15,7/19,	# 7/1,7/2,7/9,7/10,7/12,7/14,7/15,7/19,
# 11/8,11/16,11/18,11/22,11/23,12/22,	# 11/8,11/16,11/18,11/22,11/23,12/22,
Line 35	Line 59
# 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,	# 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/2 Gerd Kortemeyer
# 10/5,10/10,11/13,11/15 Scott Harrison	# 10/5,10/10,11/13,11/15 Scott Harrison
# 11/17 Gerd Kortemeyer	# 11/17,11/20,11/22,11/29 Gerd Kortemeyer
	# 12/5 Matthew Hall
	# 12/5 Guy Albertelli
	# 12/6 Gerd Kortemeyer
#	#
# $Id$	# $Id$
#	#
Line 145 use Apache::File;	Line 172 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);
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 742 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;
}	}

sub courselog {	sub courselog {
Line 772 sub courseacclog {	Line 808 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.'___'.$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 939 sub tmpreset {	Line 987 sub tmpreset {
$path.'/tmpstore_'.$stuname.'_'.$domain.'_'.$namespace.'.db',	$path.'/tmpstore_'.$stuname.'_'.$domain.'_'.$namespace.'.db',
&GDBM_WRCREAT,0640)) {	&GDBM_WRCREAT,0640)) {
foreach my $key (keys %hash) {	foreach my $key (keys %hash) {
if ($key=~ /:$symb:/) {	if ($key=~ /:$symb/) {
delete($hash{$key});	delete($hash{$key});
}	}
}	}
Line 1688 sub plaintext {	Line 1736 sub plaintext {
# ------------------------------------------------------------------ Plain Text	# ------------------------------------------------------------------ Plain Text

sub fileembstyle {	sub fileembstyle {
my $ending=shift;	my $ending=lc(shift);
return $fe{$ending};	return $fe{$ending};
}	}

# ------------------------------------------------------------ Description Text	# ------------------------------------------------------------ Description Text

sub filedescription {	sub filedescription {
my $ending=shift;	my $ending=lc(shift);
return $fd{$ending};	return $fd{$ending};
}	}

Line 2232 sub EXT {	Line 2280 sub EXT {
# ---------------------------------------------------------------- Get metadata	# ---------------------------------------------------------------- Get metadata

sub metadata {	sub metadata {
my ($uri,$what,$liburi,$prefix)=@_;	my ($uri,$what,$liburi,$prefix,$depthcount)=@_;

$uri=&declutter($uri);	$uri=&declutter($uri);
my $filename=$uri;	my $filename=$uri;
$uri=~s/\.meta$//;	$uri=~s/\.meta$//;
#	#
# Is the metadata already cached?	# Is the metadata already cached?
# If "keys" are set, the assumption is that everything is already cached.	# Look at timestamp of caching
# Everything is cached by the main uri, libraries are never directly cached	# Everything is cached by the main uri, libraries are never directly cached
#	#
unless ($metacache{$uri.':keys'}) {	unless (abs($metacache{$uri.':cachedtimestamp'}-time)<600) {
#	#
# Is this a recursive call for a library?	# Is this a recursive call for a library?
#	#
Line 2301 sub metadata {	Line 2349 sub metadata {
#	#
# This is not a package - some other kind of start tag	# This is not a package - some other kind of start tag
#	#
my $entry=$token->[1];	my $entry=$token->[1];
if ($entry eq 'import') {	my $unikey;
#	if ($entry eq 'import') {
# Importing a library here	$unikey='';
#	} else {
my $libid=$token->[2]->{'id'};	$unikey=$entry;
	}

} else {
my $unikey=$entry;
if ($prefix) {	if ($prefix) {
$unikey.='_'.$prefix;	$unikey.=$prefix;
} else {	} else {
if (defined($token->[2]->{'part'})) {	if (defined($token->[2]->{'part'})) {
$unikey.='_'.$token->[2]->{'part'};	$unikey.='_'.$token->[2]->{'part'};
Line 2321 sub metadata {	Line 2366 sub metadata {
if (defined($token->[2]->{'id'})) {	if (defined($token->[2]->{'id'})) {
$unikey.='_'.$token->[2]->{'id'};	$unikey.='_'.$token->[2]->{'id'};
}	}

	if ($entry eq 'import') {
	#
	# Importing a library here
	#
	if (defined($depthcount)) { $depthcount++; } else
	{ $depthcount=0; }
	if ($depthcount<20) {
	map {
	$metathesekeys{$_}=1;
	} split(/\,/,&metadata($uri,'keys',
	$parser->get_text('/import'),$unikey,
	$depthcount));
	}
	} else {

if (defined($token->[2]->{'name'})) {	if (defined($token->[2]->{'name'})) {
$unikey.='_'.$token->[2]->{'name'};	$unikey.='_'.$token->[2]->{'name'};
}	}
Line 2334 sub metadata {	Line 2395 sub metadata {
$metacache{$uri.':'.$unikey.'.default'};	$metacache{$uri.':'.$unikey.'.default'};
}	}
# end of not-a-package not-a-library import	# end of not-a-package not-a-library import
}	}
# end of not-a-package start tag	# end of not-a-package start tag
}	}
# the next is the end of "start tag"	# the next is the end of "start tag"
}	}
}	}
$metacache{$uri.':keys'}=join(',',keys %metathesekeys);	$metacache{$uri.':keys'}=join(',',keys %metathesekeys);
	$metacache{$uri.':cachedtimestamp'}=time;
	# this is the end of "was not already recently cached
}	}
return $metacache{$uri.':'.$what};	return $metacache{$uri.':'.$what};
}	}
Line 2370 sub symblist {	Line 2433 sub symblist {
sub symbread {	sub symbread {
my $thisfn=shift;	my $thisfn=shift;
unless ($thisfn) {	unless ($thisfn) {
	if ($ENV{'request.symb'}) { return $ENV{'request.symb'}; }
$thisfn=$ENV{'request.filename'};	$thisfn=$ENV{'request.filename'};
}	}
$thisfn=declutter($thisfn);	$thisfn=declutter($thisfn);
Line 2566 sub unescape {	Line 2630 sub unescape {

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

sub BEGIN {	sub goodbye {
unless ($readit) {	&flushcourselogs();
	&logthis("Shutting down");
	}

	BEGIN {
# ------------------------------------------------------------ Read access.conf	# ------------------------------------------------------------ Read access.conf
{	{
my $config=Apache::File->new("/etc/httpd/conf/access.conf");	my $config=Apache::File->new("/etc/httpd/conf/access.conf");
Line 2652 unless ($readit) {	Line 2720 unless ($readit) {
my $config=Apache::File->new("$perlvar{'lonTabDir'}/filetypes.tab");	my $config=Apache::File->new("$perlvar{'lonTabDir'}/filetypes.tab");

while (my $configline=<$config>) {	while (my $configline=<$config>) {
	next if ($configline =~ /^\#/);
chomp($configline);	chomp($configline);
my ($ending,$emb,@descr)=split(/\s+/,$configline);	my ($ending,$emb,@descr)=split(/\s+/,$configline);
if ($descr[0] ne '') {	if ($descr[0] ne '') {
$fe{$ending}=$emb;	$fe{$ending}=lc($emb);
$fd{$ending}=join(' ',@descr);	$fd{$ending}=join(' ',@descr);
}	}
}	}
Line 2663 unless ($readit) {	Line 2732 unless ($readit) {

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

$readit='done';	$processmarker=$$.'_'.time.'_'.$perlvar{'lonHostID'};

&logtouch();	&logtouch();
&logthis('<font color=yellow>INFO: Read configuration</font>');	&logthis('<font color=yellow>INFO: Read configuration</font>');
}	}
}
1;	1;

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

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