--- loncom/lonnet/perl/lonnet.pm	2002/08/08 20:33:50	1.264
+++ loncom/lonnet/perl/lonnet.pm	2002/08/23 13:21:36	1.272
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.264 2002/08/08 20:33:50 matthew Exp $
+# $Id: lonnet.pm,v 1.272 2002/08/23 13:21:36 matthew 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);
@@ -820,7 +826,7 @@ sub flushcourselogs {
         my $entry=$_;
         $entry=~/\_\_\_(\w+)\/(\w+)\/(.*)\_\_\_(\w+)$/;
         my %temphash=($entry => $accesshash{$entry});
-        if (&Apache::lonnet::put('resevaldata',\%temphash,$1,$2) eq 'ok') {
+        if (&Apache::lonnet::put('nohist_resevaldata',\%temphash,$1,$2) eq 'ok') {
 	    delete $accesshash{$entry};
         }
     }
@@ -1000,97 +1006,195 @@ sub devalidate {
     }
 }
 
+sub get_scalar {
+    my ($string,$end) = @_;
+    my $value;
+    if ($$string =~ s/^([^&]*?)($end)/$2/) {
+	$value = $1;
+    } elsif ($$string =~ s/^([^&]*?)&//) {
+	$value = $1;
+    }
+    return &unescape($value);
+}
+
+sub array2str {
+  my (@array) = @_;
+  my $result=&arrayref2str(\@array);
+  $result=~s/^__ARRAY_REF__//;
+  $result=~s/__END_ARRAY_REF__$//;
+  return $result;
+}
+
 sub arrayref2str {
   my ($arrayref) = @_;
-  my $result='_ARRAY_REF__';
+  my $result='__ARRAY_REF__';
   foreach my $elem (@$arrayref) {
-    if (ref($elem) eq 'ARRAY') {
-      $result.=&escape(&arrayref2str($elem)).'&';
-    } elsif (ref($elem) eq 'HASH') {
-      $result.=&escape(&hashref2str($elem)).'&';
-    } elsif (ref($elem)) {
-      &logthis("Got a ref of ".(ref($elem))." skipping.");
+    if(ref($elem) eq 'ARRAY') {
+      $result.=&arrayref2str($elem).'&';
+    } elsif(ref($elem) eq 'HASH') {
+      $result.=&hashref2str($elem).'&';
+    } elsif(ref($elem)) {
+      #print("Got a ref of ".(ref($elem))." skipping.");
     } else {
       $result.=&escape($elem).'&';
     }
   }
   $result=~s/\&$//;
+  $result .= '__END_ARRAY_REF__';
   return $result;
 }
 
 sub hash2str {
   my (%hash) = @_;
   my $result=&hashref2str(\%hash);
-  $result=~s/^_HASH_REF__//;
+  $result=~s/^__HASH_REF__//;
+  $result=~s/__END_HASH_REF__$//;
   return $result;
 }
 
 sub hashref2str {
   my ($hashref)=@_;
-  my $result='_HASH_REF__';
+  my $result='__HASH_REF__';
   foreach (keys(%$hashref)) {
     if (ref($_) eq 'ARRAY') {
-      $result.=&escape(&arrayref2str($_)).'=';
+      $result.=&arrayref2str($_).'=';
     } elsif (ref($_) eq 'HASH') {
-      $result.=&escape(&hashref2str($_)).'=';
+      $result.=&hashref2str($_).'=';
     } elsif (ref($_)) {
-      &logthis("Got a ref of ".(ref($_))." skipping.");
+      $result.='=';
+      #print("Got a ref of ".(ref($_))." skipping.");
     } else {
-      $result.=&escape($_).'=';
+	if ($_) {$result.=&escape($_).'=';} else { last; }
     }
 
-    if (ref($$hashref{$_}) eq 'ARRAY') {
-      $result.=&escape(&arrayref2str($$hashref{$_})).'&';
-    } elsif (ref($$hashref{$_}) eq 'HASH') {
-      $result.=&escape(&hashref2str($$hashref{$_})).'&';
-    } elsif (ref($$hashref{$_})) {
-      &logthis("Got a ref of ".(ref($$hashref{$_}))." skipping.");
+    if(ref($hashref->{$_}) eq 'ARRAY') {
+      $result.=&arrayref2str($hashref->{$_}).'&';
+    } elsif(ref($hashref->{$_}) eq 'HASH') {
+      $result.=&hashref2str($hashref->{$_}).'&';
+    } elsif(ref($hashref->{$_})) {
+       $result.='&';
+      #print("Got a ref of ".(ref($hashref->{$_}))." skipping.");
     } else {
-      $result.=&escape($$hashref{$_}).'&';
+      $result.=&escape($hashref->{$_}).'&';
     }
   }
   $result=~s/\&$//;
+  $result .= '__END_HASH_REF__';
   return $result;
 }
 
 sub str2hash {
+    my ($string)=@_;
+    my ($hash)=&str2hashref('__HASH_REF__'.$string.'__END_HASH_REF__');
+    return %$hash;
+}
+
+sub str2hashref {
   my ($string) = @_;
-  my %returnhash;
-  foreach (split(/\&/,$string)) {
-    my ($name,$value)=split(/\=/,$_);
-    $name=&unescape($name);
-    $value=&unescape($value);
-    if ($value =~ /^_HASH_REF__/) {
-      $value =~ s/^_HASH_REF__//;
-      my %hash=&str2hash($value);
-      $value=\%hash;
-    } elsif ($value =~ /^_ARRAY_REF__/) {
-      $value =~ s/^_ARRAY_REF__//;
-      my @array=&str2array($value);
-      $value=\@array;
-    }
-    $returnhash{$name}=$value;
+
+  my %hash;
+
+  if($string !~ /^__HASH_REF__/) {
+      if (! ($string eq '' || !defined($string))) {
+	  $hash{'error'}='Not hash reference';
+      }
+      return (\%hash, $string);
+  }
+
+  $string =~ s/^__HASH_REF__//;
+
+  while($string !~ /^__END_HASH_REF__/) {
+      #key
+      my $key='';
+      if($string =~ /^__HASH_REF__/) {
+          ($key, $string)=&str2hashref($string);
+          if(defined($key->{'error'})) {
+              $hash{'error'}='Bad data';
+              return (\%hash, $string);
+          }
+      } elsif($string =~ /^__ARRAY_REF__/) {
+          ($key, $string)=&str2arrayref($string);
+          if($key->[0] eq 'Array reference error') {
+              $hash{'error'}='Bad data';
+              return (\%hash, $string);
+          }
+      } else {
+          $string =~ s/^(.*?)=//;
+	  $key=&unescape($1);
+      }
+      $string =~ s/^=//;
+
+      #value
+      my $value='';
+      if($string =~ /^__HASH_REF__/) {
+          ($value, $string)=&str2hashref($string);
+          if(defined($value->{'error'})) {
+              $hash{'error'}='Bad data';
+              return (\%hash, $string);
+          }
+      } elsif($string =~ /^__ARRAY_REF__/) {
+          ($value, $string)=&str2arrayref($string);
+          if($value->[0] eq 'Array reference error') {
+              $hash{'error'}='Bad data';
+              return (\%hash, $string);
+          }
+      } else {
+	  $value=&get_scalar(\$string,'__END_HASH_REF__');
+      }
+      $string =~ s/^&//;
+
+      $hash{$key}=$value;
   }
-  return (%returnhash);
+
+  $string =~ s/^__END_HASH_REF__//;
+
+  return (\%hash, $string);
 }
 
 sub str2array {
+    my ($string)=@_;
+    my ($array)=&str2arrayref('__ARRAY_REF__'.$string.'__END_ARRAY_REF__');
+    return @$array;
+}
+
+sub str2arrayref {
   my ($string) = @_;
-  my @returnarray;
-  foreach my $value (split(/\&/,$string)) {
-    $value=&unescape($value);
-    if ($value =~ /^_HASH_REF__/) {
-      $value =~ s/^_HASH_REF__//;
-      my %hash=&str2hash($value);
-      $value=\%hash;
-    } elsif ($value =~ /^_ARRAY_REF__/) {
-      $value =~ s/^_ARRAY_REF__//;
-      my @array=&str2array($value);
-      $value=\@array;
-    }
-    push(@returnarray,$value);
+  my @array;
+
+  if($string !~ /^__ARRAY_REF__/) {
+      if (! ($string eq '' || !defined($string))) {
+	  $array[0]='Array reference error';
+      }
+      return (\@array, $string);
+  }
+
+  $string =~ s/^__ARRAY_REF__//;
+
+  while($string !~ /^__END_ARRAY_REF__/) {
+      my $value='';
+      if($string =~ /^__HASH_REF__/) {
+          ($value, $string)=&str2hashref($string);
+          if(defined($value->{'error'})) {
+              $array[0] ='Array reference error';
+              return (\@array, $string);
+          }
+      } elsif($string =~ /^__ARRAY_REF__/) {
+          ($value, $string)=&str2arrayref($string);
+          if($value->[0] eq 'Array reference error') {
+              $array[0] ='Array reference error';
+              return (\@array, $string);
+          }
+      } else {
+	  $value=&get_scalar(\$string,'__END_ARRAY_REF__');
+      }
+      $string =~ s/^&//;
+
+      push(@array, $value);
   }
-  return (@returnarray);
+
+  $string =~ s/^__END_ARRAY_REF__//;
+
+  return (\@array, $string);
 }
 
 # -------------------------------------------------------------------Temp Store
@@ -1337,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;
@@ -2039,7 +2143,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'},
@@ -2070,7 +2175,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)) {
@@ -2195,7 +2301,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)) {
@@ -2227,9 +2333,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);
+<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;
 }
 
@@ -2984,13 +3109,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 {
@@ -3000,6 +3136,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::;
@@ -3037,6 +3175,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 {