--- loncom/lonnet/perl/lonnet.pm	2002/08/09 19:49:30	1.266
+++ loncom/lonnet/perl/lonnet.pm	2002/09/05 19:37:00	1.278
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.266 2002/08/09 19:49:30 albertel Exp $
+# $Id: lonnet.pm,v 1.278 2002/09/05 19:37:00 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);
@@ -1114,7 +1120,7 @@ sub str2hashref {
           }
       } else {
           $string =~ s/^(.*?)=//;
-	  $key=$1
+	  $key=&unescape($1);
       }
       $string =~ s/^=//;
 
@@ -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;
@@ -1563,6 +1569,9 @@ sub get {
 
    my $rep=&reply("get:$udomain:$uname:$namespace:$items",$uhome);
    my @pairs=split(/\&/,$rep);
+   if ( $#pairs==0 && $pairs[0] =~ /^(con_lost|error|no_such_host)/i) {
+     return @pairs;
+   }
    my %returnhash=();
    my $i=0;
    foreach (@$storearr) {
@@ -2137,7 +2146,8 @@ sub modifyuserauth {
     my $uhome=&homeserver($uname,$udom);
     unless (&allowed('mau',$udom)) { return 'refused'; }
     &logthis('Call to modify user authentication '.$udom.', '.$uname.', '.
-             $umode.' by '.$ENV{'user.name'}.' at '.$ENV{'user.domain'});  
+             $umode.' by '.$ENV{'user.name'}.' at '.$ENV{'user.domain'}.
+             ' in domain '.$ENV{'request.role.domain'});  
     my $reply=&reply('encrypt:changeuserauth:'.$udom.':'.$uname.':'.$umode.':'.
 		     &escape($upass),$uhome);
     &log($ENV{'user.domain'},$ENV{'user.name'},$ENV{'user.home'},
@@ -2168,7 +2178,8 @@ sub modifyuser {
 	     $last.', '.$gene.'(forceid: '.$forceid.')'.
              (defined($desiredhome) ? ' desiredhome = '.$desiredhome :
                                      ' desiredhome not specified'). 
-             ' by '.$ENV{'user.name'}.' at '.$ENV{'user.domain'});
+             ' by '.$ENV{'user.name'}.' at '.$ENV{'user.domain'}.
+             ' in domain '.$ENV{'request.role.domain'});
     my $uhome=&homeserver($uname,$udom,'true');
 # ----------------------------------------------------------------- Create User
     if (($uhome eq 'no_host') && ($umode) && ($upass)) {
@@ -2293,7 +2304,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 +2336,29 @@ 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);
+        if ($mapurl eq '/res/') { $mapurl=''; }
+        $ENV{'form.initmap'}=(<<ENDINITMAP);
+<map>
+<resource id="1" type="start"></resource>
+<resource id="2" src="$mapurl"></resource>
+<resource id="3" type="finish"></resource>
+<link index="1" from="1" to="2"></link>
+<link index="2" from="2" to="3"></link>
+</map>
+ENDINITMAP
+        $topurl=&declutter(
+        &finishuserfileupload($uname,$udom,$uhome,'initmap','default.sequence')
+                          );
+    }
+# ----------------------------------------------------------- Write preferences
     &writecoursepref($udom.'_'.$uname,
                      ('description' => $description,
-                      'url'         => $url));
+                      'url'         => $topurl));
     return '/'.$udom.'/'.$uname;
 }
 
@@ -2428,6 +2459,30 @@ sub dirlist {
     }
 }
 
+# --------------------------------------------- GetFileTimestamp
+# This function utilizes dirlist and returns the date stamp for
+# when it was last modified.  It will also return an error of -1
+# if an error occurs
+
+sub GetFileTimestamp {
+    my ($studentDomain,$studentName,$filename,$root)=@_;
+    $studentDomain=~s/\W//g;
+    $studentName=~s/\W//g;
+    my $subdir=$studentName.'__';
+    $subdir =~ s/(.)(.)(.).*/$1\/$2\/$3/;
+    my $proname="$studentDomain/$subdir/$studentName";
+    $proname .= '/'.$filename;
+    my @dir = &Apache::lonnet::dirlist($proname, $studentDomain, $studentName,
+                                       $root);
+    my $fileStat = $dir[0];
+    my @stats = split('&', $fileStat);
+    if($stats[0] ne 'empty' && $stats[0] ne 'no_such_dir') {
+        return $stats[9];
+    } else {
+        return -1;
+    }
+}
+
 # -------------------------------------------------------- Value of a Condition
 
 sub directcondval {
@@ -2720,7 +2775,7 @@ sub metadata {
 # Look at timestamp of caching
 # Everything is cached by the main uri, libraries are never directly cached
 #
-    unless (abs($metacache{$uri.':cachedtimestamp'}-time)<600) {
+    unless (abs($metacache{$uri.':cachedtimestamp'}-time)<600 && !defined($liburi)) {
 #
 # Is this a recursive call for a library?
 #
@@ -2743,7 +2798,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,12 +2856,14 @@ sub metadata {
 #
 # Importing a library here
 #                
-		 if (defined($depthcount)) { $depthcount++; } else 
-                                           { $depthcount=0; }
                  if ($depthcount<20) {
-		     foreach (split(/\,/,&metadata($uri,'keys',
-                                  $parser->get_text('/import'),$unikey,
-                                  $depthcount))) {
+		     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)))) {
                          $metathesekeys{$_}=1;
 		     }
 		 }
@@ -2831,8 +2888,9 @@ sub metadata {
 # the next is the end of "start tag"
 	 }
        }
-	&metadata_generate_part0(\%metathesekeys,\%metacache,$uri);
        $metacache{$uri.':keys'}=join(',',keys %metathesekeys);
+	&metadata_generate_part0(\%metathesekeys,\%metacache,$uri);
+       $metacache{$uri.':allpossiblekeys'}=join(',',keys %metathesekeys);
        $metacache{$uri.':cachedtimestamp'}=time;
 # this is the end of "was not already recently cached
     }
@@ -3082,13 +3140,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 +3167,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 +3206,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 {