--- loncom/lonnet/perl/lonnet.pm 2002/08/30 19:09:27 1.267.4.1 +++ loncom/lonnet/perl/lonnet.pm 2002/08/17 18:58:28 1.269 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.267.4.1 2002/08/30 19:09:27 albertel Exp $ +# $Id: lonnet.pm,v 1.269 2002/08/17 18:58:28 www Exp $ # # Copyright Michigan State University Board of Trustees # @@ -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; } } @@ -3084,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 { @@ -3137,6 +3146,14 @@ sub declutter { return $thisfn; } +# ------------------------------------------------------------- Clutter up URLs + +sub clutter { + my $thisfn='/'.&declutter(shift); + unless ($thisfn=~/^\/(uploaded|adm)\//) { $thisfn='/res'.$thisfn; } + return $thisfn; +} + # -------------------------------------------------------- Escape Special Chars sub escape {