--- loncom/lonnet/perl/lonnet.pm 2001/11/20 22:30:20 1.174 +++ loncom/lonnet/perl/lonnet.pm 2001/12/05 14:48:28 1.182 @@ -1,6 +1,30 @@ # The LearningOnline Network # TCP networking package # +# $Id: lonnet.pm,v 1.182 2001/12/05 14:48:28 matthew Exp $ +# +# 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, # 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, @@ -35,9 +59,10 @@ # 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/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: lonnet.pm,v 1.174 2001/11/20 22:30:20 www Exp $ +# $Id: lonnet.pm,v 1.182 2001/12/05 14:48:28 matthew Exp $ # ### @@ -939,7 +964,7 @@ sub tmpreset { $path.'/tmpstore_'.$stuname.'_'.$domain.'_'.$namespace.'.db', &GDBM_WRCREAT,0640)) { foreach my $key (keys %hash) { - if ($key=~ /:$symb:/) { + if ($key=~ /:$symb/) { delete($hash{$key}); } } @@ -1688,14 +1713,14 @@ sub plaintext { # ------------------------------------------------------------------ Plain Text sub fileembstyle { - my $ending=shift; + my $ending=lc(shift); return $fe{$ending}; } # ------------------------------------------------------------ Description Text sub filedescription { - my $ending=shift; + my $ending=lc(shift); return $fd{$ending}; } @@ -2232,14 +2257,14 @@ sub EXT { # ---------------------------------------------------------------- Get metadata sub metadata { - my ($uri,$what,$liburi,$prefix)=@_; + my ($uri,$what,$liburi,$prefix,$depthcount)=@_; $uri=&declutter($uri); my $filename=$uri; $uri=~s/\.meta$//; # # 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 # unless (abs($metacache{$uri.':cachedtimestamp'}-time)<600) { @@ -2301,18 +2326,15 @@ sub metadata { # # This is not a package - some other kind of start tag # - my $entry=$token->[1]; - if ($entry eq 'import') { -# -# Importing a library here -# - my $libid=$token->[2]->{'id'}; - - - } else { - my $unikey=$entry; + my $entry=$token->[1]; + my $unikey; + if ($entry eq 'import') { + $unikey=''; + } else { + $unikey=$entry; + } if ($prefix) { - $unikey.='_'.$prefix; + $unikey.=$prefix; } else { if (defined($token->[2]->{'part'})) { $unikey.='_'.$token->[2]->{'part'}; @@ -2321,6 +2343,22 @@ sub metadata { if (defined($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'})) { $unikey.='_'.$token->[2]->{'name'}; } @@ -2334,7 +2372,7 @@ sub metadata { $metacache{$uri.':'.$unikey.'.default'}; } # end of not-a-package not-a-library import - } + } # end of not-a-package start tag } # the next is the end of "start tag" @@ -2342,6 +2380,7 @@ sub metadata { } $metacache{$uri.':keys'}=join(',',keys %metathesekeys); $metacache{$uri.':cachedtimestamp'}=time; +# this is the end of "was not already recently cached } return $metacache{$uri.':'.$what}; } @@ -2371,6 +2410,7 @@ sub symblist { sub symbread { my $thisfn=shift; unless ($thisfn) { + if ($ENV{'request.symb'}) { return $ENV{'request.symb'}; } $thisfn=$ENV{'request.filename'}; } $thisfn=declutter($thisfn); @@ -2567,8 +2607,7 @@ sub unescape { # ================================================================ Main Program -sub BEGIN { -unless ($readit) { +BEGIN { # ------------------------------------------------------------ Read access.conf { my $config=Apache::File->new("/etc/httpd/conf/access.conf"); @@ -2653,10 +2692,11 @@ unless ($readit) { my $config=Apache::File->new("$perlvar{'lonTabDir'}/filetypes.tab"); while (my $configline=<$config>) { + next if (/^\#/); chomp($configline); my ($ending,$emb,@descr)=split(/\s+/,$configline); if ($descr[0] ne '') { - $fe{$ending}=$emb; + $fe{$ending}=lc($emb); $fd{$ending}=join(' ',@descr); } } @@ -2668,5 +2708,5 @@ $readit='done'; &logtouch(); &logthis('INFO: Read configuration'); } -} + 1;