--- loncom/lonnet/perl/lonnet.pm 2006/01/11 08:25:06 1.683.2.9 +++ loncom/lonnet/perl/lonnet.pm 2006/01/31 22:02:03 1.683.2.14 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.683.2.9 2006/01/11 08:25:06 albertel Exp $ +# $Id: lonnet.pm,v 1.683.2.14 2006/01/31 22:02:03 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -3066,6 +3066,7 @@ sub customaccess { sub allowed { my ($priv,$uri,$symb)=@_; + my $ver_orguri=$uri; $uri=&deversion($uri); my $orguri=$uri; $uri=&declutter($uri); @@ -3166,7 +3167,7 @@ sub allowed { $thisallowed.=$1; } } else { - my $refuri=$env{'httpref.'.$orguri}; + my $refuri = $env{'httpref.'.$orguri} || $env{'httpref.'.$ver_orguri}; if ($refuri) { if ($refuri =~ m|^/adm/|) { $thisallowed='F'; @@ -4981,8 +4982,7 @@ sub metadata { # if it is a non metadata possible uri return quickly if (($uri eq '') || (($uri =~ m|^/*adm/|) && - ($uri !~ m|^adm/includes|) && ($uri !~ m|/bulletinboard$|) - && ($uri !~ m|^adm/coursedocs/|) && ($uri !~ m|^adm/wrapper/|)) || + ($uri !~ m|^adm/includes|) && ($uri !~ m|/bulletinboard$|)) || ($uri =~ m|/$|) || ($uri =~ m|/.meta$|) || ($uri =~ /^~/) || ($uri =~ m|home/[^/]+/public_html/|)) { return undef; @@ -5167,7 +5167,7 @@ sub metadata { $metaentry{':keys'}=join(',',keys %metathesekeys); &metadata_generate_part0(\%metathesekeys,\%metaentry,$uri); $metaentry{':allpossiblekeys'}=join(',',keys %metathesekeys); - &do_cache_new('meta',$uri,\%metaentry,60*60*24); + &do_cache_new('meta',$uri,\%metaentry,60*60); # this is the end of "was not already recently cached } return $metaentry{':'.$what}; @@ -5263,10 +5263,17 @@ sub get_slot { $cdom=$env{'course.'.$courseid.'.domain'}; $cnum=$env{'course.'.$courseid.'.num'}; } - my %slotinfo=&get('slots',[$which],$cdom,$cnum); - &Apache::lonhomework::showhash(%slotinfo); - my ($tmp)=keys(%slotinfo); - if ($tmp=~/^error:/) { return (); } + my $key=join("\0",'slots',$cdom,$cnum,$which); + my %slotinfo; + if (exists($remembered{$key})) { + $slotinfo{$which} = $remembered{$key}; + } else { + %slotinfo=&get('slots',[$which],$cdom,$cnum); + &Apache::lonhomework::showhash(%slotinfo); + my ($tmp)=keys(%slotinfo); + if ($tmp=~/^error:/) { return (); } + $remembered{$key} = $slotinfo{$which}; + } if (ref($slotinfo{$which}) eq 'HASH') { return %{$slotinfo{$which}}; } @@ -6006,6 +6013,11 @@ sub filelocation { my ($dir,$file) = @_; my $location; $file=~ s/^\s*(\S+)\s*$/$1/; ## strip off leading and trailing spaces + + if ($file =~ m-^/adm/-) { + $file=~s-^/adm/wrapper/-/-; + $file=~s-^/adm/coursedocs/showdoc/-/-; + } if ($file=~m:^/~:) { # is a contruction space reference $location = $file; $location =~ s:/~(.*?)/(.*):/home/$1/public_html/$2:; @@ -6045,6 +6057,9 @@ sub hreflocation { my ($dir,$file)=@_; unless (($file=~m-^http://-i) || ($file=~m-^/-)) { $file=filelocation($dir,$file); + } elsif ($file=~m-^/adm/-) { + $file=~s-^/adm/wrapper/-/-; + $file=~s-^/adm/coursedocs/showdoc/-/-; } if ($file=~m-^\Q$perlvar{'lonDocRoot'}\E-) { $file=~s-^\Q$perlvar{'lonDocRoot'}\E--; @@ -6108,14 +6123,21 @@ sub clutter { } else { my ($ext) = ($thisfn =~ /\.(\w+)$/); my $embstyle=&Apache::loncommon::fileembstyle($ext); - if (($embstyle eq 'img') + if ($embstyle eq 'ssi' + || ($embstyle eq 'hdn') + || ($embstyle eq 'rat') + || ($embstyle eq 'prv') + || ($embstyle eq 'ign')) { + #do nothing with these + } elsif (($embstyle eq 'img') || ($embstyle eq 'emb') || ($embstyle eq 'wrp')) { $thisfn='/adm/wrapper'.$thisfn; - } elsif ($embstyle eq 'ssi') { - #do nothing with these - } elsif ($thisfn!~/\.(sequence|page)$/) { + } elsif ($embstyle eq 'unk' + && $thisfn!~/\.(sequence|page)$/) { $thisfn='/adm/coursedocs/showdoc'.$thisfn; + } else { + #&logthis("Got a blank emb style"); } } }