version 1.174, 2001/11/20 22:30:20
|
version 1.182, 2001/12/05 14:48:28
|
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 |
# |
# |
# $Id$ |
# $Id$ |
# |
# |
Line 939 sub tmpreset {
|
Line 964 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 1713 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 2257 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 (abs($metacache{$uri.':cachedtimestamp'}-time)<600) { |
unless (abs($metacache{$uri.':cachedtimestamp'}-time)<600) { |
Line 2301 sub metadata {
|
Line 2326 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 2343 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 2372 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" |
Line 2342 sub metadata {
|
Line 2380 sub metadata {
|
} |
} |
$metacache{$uri.':keys'}=join(',',keys %metathesekeys); |
$metacache{$uri.':keys'}=join(',',keys %metathesekeys); |
$metacache{$uri.':cachedtimestamp'}=time; |
$metacache{$uri.':cachedtimestamp'}=time; |
|
# this is the end of "was not already recently cached |
} |
} |
return $metacache{$uri.':'.$what}; |
return $metacache{$uri.':'.$what}; |
} |
} |
Line 2371 sub symblist {
|
Line 2410 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 2567 sub unescape {
|
Line 2607 sub unescape {
|
|
|
# ================================================================ Main Program |
# ================================================================ Main Program |
|
|
sub BEGIN { |
BEGIN { |
unless ($readit) { |
|
# ------------------------------------------------------------ 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 2653 unless ($readit) {
|
Line 2692 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 (/^\#/); |
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 2668 $readit='done';
|
Line 2708 $readit='done';
|
&logtouch(); |
&logtouch(); |
&logthis('<font color=yellow>INFO: Read configuration</font>'); |
&logthis('<font color=yellow>INFO: Read configuration</font>'); |
} |
} |
} |
|
1; |
1; |