--- loncom/lonnet/perl/lonnet.pm 2002/08/13 14:37:52 1.267 +++ loncom/lonnet/perl/lonnet.pm 2002/08/18 21:42:34 1.271 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.267 2002/08/13 14:37:52 albertel Exp $ +# $Id: lonnet.pm,v 1.271 2002/08/18 21:42:34 www Exp $ # # Copyright Michigan State University Board of Trustees # @@ -761,6 +761,12 @@ sub userfileupload { $docudom=$ENV{'user.domain'}; $docuhome=$ENV{'user.home'}; } + return + &finishuserfileupload($docuname,$docudom,$docuhome,$formname,$fname); +} + +sub finishuserfileupload { + my ($docuname,$docudom,$docuhome,$formname,$fname)=@_; my $path=$docudom.'/'.$docuname.'/'; my $filepath=$perlvar{'lonDocRoot'}; my @parts=split(/\//,$filepath.'/userfiles/'.$path); @@ -1435,7 +1441,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; @@ -2293,7 +2299,7 @@ sub writecoursepref { # ---------------------------------------------------------- Make/modify course sub createcourse { - my ($udom,$description,$url,$course_server)=@_; + my ($udom,$description,$url,$course_server,$nonstandard)=@_; $url=&declutter($url); my $cid=''; unless (&allowed('ccc',$udom)) { @@ -2325,9 +2331,28 @@ sub createcourse { if (($uhome eq '') || ($uhome eq 'no_host')) { return 'error: no such course'; } +# ----------------------------------------------------------------- Course made + my $topurl=$url; + unless ($nonstandard) { +# ------------------------------------------ For standard courses, make top url + my $mapurl=&clutter($url); + $ENV{'form.initmap'}=(< + + + + + + +ENDINITMAP + $topurl=&declutter( + &finishuserfileupload($uname,$udom,$uhome,'initmap','default.sequence') + ); + } +# ----------------------------------------------------------- Write preferences &writecoursepref($udom.'_'.$uname, ('description' => $description, - 'url' => $url)); + 'url' => $topurl)); return '/'.$udom.'/'.$uname; } @@ -3082,13 +3107,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 { @@ -3098,6 +3134,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::; @@ -3135,6 +3173,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 {