--- loncom/lonnet/perl/lonnet.pm 2002/08/30 19:11:28 1.267.4.2 +++ loncom/lonnet/perl/lonnet.pm 2002/08/17 19:50:17 1.270 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.267.4.2 2002/08/30 19:11:28 albertel Exp $ +# $Id: lonnet.pm,v 1.270 2002/08/17 19:50:17 www Exp $ # # Copyright Michigan State University Board of Trustees # @@ -1435,7 +1435,7 @@ sub coursedescription { while (my ($name,$value) = each %returnhash) { $envhash{'course.'.$normalid.'.'.$name}=$value; } - $returnhash{'url'}='/res/'.declutter($returnhash{'url'}); + $returnhash{'url'}=&clutter($returnhash{'url'}); $returnhash{'fn'}=$perlvar{'lonDaemons'}.'/tmp/'. $ENV{'user.name'}.'_'.$cdomain.'_'.$cnum; $envhash{'course.'.$normalid.'.last_cache'}=time; @@ -2743,7 +2743,7 @@ sub metadata { my $package=$token->[2]->{'package'}; my $keyroot=''; if ($prefix) { - $keyroot.=$prefix; + $keyroot.='_'.$prefix; } else { if (defined($token->[2]->{'part'})) { $keyroot.='_'.$token->[2]->{'part'}; @@ -2801,14 +2801,12 @@ sub metadata { # # Importing a library here # + if (defined($depthcount)) { $depthcount++; } else + { $depthcount=0; } if ($depthcount<20) { - my $location=$parser->get_text('/import'); - my $dir=$filename; - $dir=~s|[^/]*$||; - $location=&filelocation($dir,$location); - foreach (sort(split(/\,/,&metadata($uri,'keys', - $location,$unikey, - $depthcount+1)))) { + foreach (split(/\,/,&metadata($uri,'keys', + $parser->get_text('/import'),$unikey, + $depthcount))) { $metathesekeys{$_}=1; } } @@ -2833,9 +2831,8 @@ sub metadata { # the next is the end of "start tag" } } - $metacache{$uri.':keys'}=join(',',keys %metathesekeys); &metadata_generate_part0(\%metathesekeys,\%metacache,$uri); - $metacache{$uri.':allpossiblekeys'}=join(',',keys %metathesekeys); + $metacache{$uri.':keys'}=join(',',keys %metathesekeys); $metacache{$uri.':cachedtimestamp'}=time; # this is the end of "was not already recently cached } @@ -3085,13 +3082,24 @@ sub receipt { # ------------------------------------------------------------ Serves up a file # returns either the contents of the file or a -1 sub getfile { - my $file=shift; + my $file=shift; + if ($file=~/^\/*uploaded\//) { # user file + my $ua=new LWP::UserAgent; + my $request=new HTTP::Request('GET',&tokenwrapper($file)); + my $response=$ua->request($request); + if ($response->is_success()) { + return $response->content; + } else { + return -1; + } + } else { # normal file from res space &repcopy($file); if (! -e $file ) { return -1; }; my $fh=Apache::File->new($file); my $a=''; while (<$fh>) { $a .=$_; } - return $a + return $a; + } } sub filelocation { @@ -3101,6 +3109,8 @@ sub filelocation { if ($file=~m:^/~:) { # is a contruction space reference $location = $file; $location =~ s:/~(.*?)/(.*):/home/$1/public_html/$2:; + } elsif ($file=~/^\/*uploaded/) { # is an uploaded file + $location=$file; } else { $file=~s/^$perlvar{'lonDocRoot'}//; $file=~s:^/*res::; @@ -3138,6 +3148,16 @@ sub declutter { return $thisfn; } +# ------------------------------------------------------------- Clutter up URLs + +sub clutter { + my $thisfn='/'.&declutter(shift); + unless ($thisfn=~/^\/(uploaded|adm|userfiles|ext|raw|priv)\//) { + $thisfn='/res'.$thisfn; + } + return $thisfn; +} + # -------------------------------------------------------- Escape Special Chars sub escape {