--- loncom/lonnet/perl/lonnet.pm	2005/03/03 23:21:54	1.605
+++ loncom/lonnet/perl/lonnet.pm	2005/03/21 18:53:51	1.614
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.605 2005/03/03 23:21:54 matthew Exp $
+# $Id: lonnet.pm,v 1.614 2005/03/21 18:53:51 albertel Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -994,27 +994,27 @@ sub subscribe {
 sub repcopy {
     my $filename=shift;
     $filename=~s/\/+/\//g;
-    if ($filename=~m|^/home/httpd/html/adm/|) { return 'OK'; }
-    if ($filename=~m|^/home/httpd/html/lonUsers/|) { return 'OK'; }
+    if ($filename=~m|^/home/httpd/html/adm/|) { return 'ok'; }
+    if ($filename=~m|^/home/httpd/html/lonUsers/|) { return 'ok'; }
     if ($filename=~m|^/home/httpd/html/userfiles/| or
-	$filename=~m|^/*uploaded/|) { 
+	$filename=~m -^/*(uploaded|editupload)/-) { 
 	return &repcopy_userfile($filename);
     }
     $filename=~s/[\n\r]//g;
     my $transname="$filename.in.transfer";
-    if ((-e $filename) || (-e $transname)) { return 'OK'; }
+    if ((-e $filename) || (-e $transname)) { return 'ok'; }
     my $remoteurl=subscribe($filename);
     if ($remoteurl =~ /^con_lost by/) {
 	   &logthis("Subscribe returned $remoteurl: $filename");
-           return 'HTTP_SERVICE_UNAVAILABLE';
+           return 'unavailable';
     } elsif ($remoteurl eq 'not_found') {
 	   #&logthis("Subscribe returned not_found: $filename");
-	   return 'HTTP_NOT_FOUND';
+	   return 'not_found';
     } elsif ($remoteurl =~ /^rejected by/) {
 	   &logthis("Subscribe returned $remoteurl: $filename");
-           return 'FORBIDDEN';
+           return 'forbidden';
     } elsif ($remoteurl eq 'directory') {
-           return 'OK';
+           return 'ok';
     } else {
         my $author=$filename;
         $author=~s/\/home\/httpd\/html\/res\/([^\/]*)\/([^\/]*).*/$1\/$2/;
@@ -1025,7 +1025,7 @@ sub repcopy {
            my $path="/$parts[1]/$parts[2]/$parts[3]/$parts[4]";
            if ($path ne "$perlvar{'lonDocRoot'}/res") {
                &logthis("Malconfiguration for replication: $filename");
-	       return 'HTTP_BAD_REQUEST';
+	       return 'bad_request';
            }
            my $count;
            for ($count=5;$count<$#parts;$count++) {
@@ -1042,7 +1042,7 @@ sub repcopy {
                my $message=$response->status_line;
                &logthis("<font color=blue>WARNING:"
                        ." LWP get: $message: $filename</font>");
-               return 'HTTP_SERVICE_UNAVAILABLE';
+               return 'unavailable';
            } else {
 	       if ($remoteurl!~/\.meta$/) {
                   my $mrequest=new HTTP::Request('GET',$remoteurl.'.meta');
@@ -1054,7 +1054,7 @@ sub repcopy {
                   }
 	       }
                rename($transname,$filename);
-               return 'OK';
+               return 'ok';
            }
        }
     }
@@ -1063,6 +1063,9 @@ sub repcopy {
 # ------------------------------------------------ Get server side include body
 sub ssi_body {
     my ($filelink,%form)=@_;
+    if (! exists($form{'LONCAPA_INTERNAL_no_discussion'})) {
+        $form{'LONCAPA_INTERNAL_no_discussion'}='true';
+    }
     my $output=($filelink=~/^http\:/?&externalssi($filelink):
                                      &ssi($filelink,%form));
     $output=~s|//(\s*<!--)? BEGIN LON-CAPA Internal.+// END LON-CAPA Internal\s*(-->)?\s||gs;
@@ -1196,10 +1199,6 @@ sub process_coursefile {
     return $fetchresult;
 }
 
-# --------------- Take an uploaded file and put it into the userfiles directory
-# input: name of form element, coursedoc=1 means this is for the course
-# output: url of file in userspace
-
 sub clean_filename {
     my ($fname)=@_;
 # Replace Windows backslashes by forward slashes
@@ -1216,6 +1215,11 @@ sub clean_filename {
     return $fname;
 }
 
+# --------------- Take an uploaded file and put it into the userfiles directory
+# input: name of form element, coursedoc=1 means this is for the course
+# output: url of file in userspace
+
+
 sub userfileupload {
     my ($formname,$coursedoc,$subdir)=@_;
     if (!defined($subdir)) { $subdir='unknown'; }
@@ -1289,7 +1293,6 @@ sub finishuserfileupload {
     }
 # Notify homeserver to grep it
 #
-    &Apache::lonnet::logthis("fetching ".$path.$file);
     my $fetchresult= &reply('fetchuserfile:'.$path.$file,$docuhome);
     if ($fetchresult eq 'ok') {
 #
@@ -1305,7 +1308,7 @@ sub finishuserfileupload {
 sub removeuploadedurl {
     my ($url)=@_;
     my (undef,undef,$udom,$uname,$fname)=split('/',$url,5);
-    return &Apache::lonnet::removeuserfile($uname,$udom,$fname);
+    return &removeuserfile($uname,$udom,$fname);
 }
 
 sub removeuserfile {
@@ -2703,7 +2706,7 @@ sub allowed {
 
 # Free bre access to user's own portfolio contents
     my ($space,$domain,$name,$dir)=split('/',$uri);
-    if (('uploaded' eq $space) && ($ENV{'user.name'} eq $name) && 
+    if (($space=~/^(uploaded|ediupload)$/) && ($ENV{'user.name'} eq $name) && 
 	($ENV{'user.domain'} eq $domain) && ('portfolio' eq $dir)) {
         return 'F';
     }
@@ -2772,7 +2775,7 @@ sub allowed {
     }
 
 # URI is an uploaded document for this course
-
+# not allowing 'edit' access (editupload) to uploaded course docs
     if (($priv eq 'bre') && ($uri=~m|^uploaded/|)) {
 	my $refuri=$ENV{'httpref.'.$orguri};
 	if ($refuri) {
@@ -3712,8 +3715,11 @@ sub is_locked {
     my @check;
     my $is_locked;
     push @check, $file_name;
-    my %locked = &Apache::lonnet::get('file_permissions',\@check,
-                                        $ENV{'user.domain'},$ENV{'user.name'});
+    my %locked = &get('file_permissions',\@check,
+		      $ENV{'user.domain'},$ENV{'user.name'});
+#    my ($tmp)=keys(%locked);
+#    if ($tmp=~/^error:/) { undef(%locked); }
+
     if (ref($locked{$file_name}) eq 'ARRAY') {
         $is_locked = 'true';
     } else {
@@ -3725,11 +3731,14 @@ sub is_locked {
 
 sub mark_as_readonly {
     my ($domain,$user,$files,$what) = @_;
-    my %current_permissions = &Apache::lonnet::dump('file_permissions',$domain,$user);
+    my %current_permissions = &dump('file_permissions',$domain,$user);
+#    my ($tmp)=keys(%current_permissions);
+#    if ($tmp=~/^error:/) { undef(%current_permissions); }
+
     foreach my $file (@{$files}) {
         push(@{$current_permissions{$file}},$what);
     }
-    &Apache::lonnet::put('file_permissions',\%current_permissions,$domain,$user);
+    &put('file_permissions',\%current_permissions,$domain,$user);
     return;
 }
 
@@ -3806,7 +3815,10 @@ sub files_not_in_path {
 
 sub get_marked_as_readonly {
     my ($domain,$user,$what) = @_;
-    my %current_permissions = &Apache::lonnet::dump('file_permissions',$domain,$user);
+    my %current_permissions = &dump('file_permissions',$domain,$user);
+#    my ($tmp)=keys(%current_permissions);
+#    if ($tmp=~/^error:/) { undef(%current_permissions); }
+
     my @readonly_files;
     while (my ($file_name,$value) = each(%current_permissions)) {
         if (ref($value) eq "ARRAY"){
@@ -3825,7 +3837,10 @@ sub get_marked_as_readonly {
 
 sub get_marked_as_readonly_hash {
     my ($domain,$user,$what) = @_;
-    my %current_permissions = &Apache::lonnet::dump('file_permissions',$domain,$user);
+    my %current_permissions = &dump('file_permissions',$domain,$user);
+#    my ($tmp)=keys(%current_permissions);
+#    if ($tmp=~/^error:/) { undef(%current_permissions); }
+
     my %readonly_files;
     while (my ($file_name,$value) = each(%current_permissions)) {
         if (ref($value) eq "ARRAY"){
@@ -3846,8 +3861,11 @@ sub unmark_as_readonly {
     # unmarks all files locked by $what 
     # for portfolio submissions, $what contains $crsid and $symb
     my ($domain,$user,$what) = @_;
-    my %current_permissions = &Apache::lonnet::dump('file_permissions',$domain,$user);
-    my @readonly_files = &Apache::lonnet::get_marked_as_readonly($domain,$user,$what);
+    my %current_permissions = &dump('file_permissions',$domain,$user);
+#    my ($tmp)=keys(%current_permissions);
+#    if ($tmp=~/^error:/) { undef(%current_permissions); }
+
+    my @readonly_files = &get_marked_as_readonly($domain,$user,$what);
     foreach my $file(@readonly_files){
         my $current_locks = $current_permissions{$file};
         my @new_locks;
@@ -3862,12 +3880,12 @@ sub unmark_as_readonly {
                 $current_permissions{$file} = \@new_locks;
             } else {
                 push(@del_keys, $file);
-                &Apache::lonnet::del('file_permissions',\@del_keys, $domain, $user);
+                &del('file_permissions',\@del_keys, $domain, $user);
                 delete $current_permissions{$file};
             }
         }
     }
-    &Apache::lonnet::put('file_permissions',\%current_permissions,$domain,$user);
+    &put('file_permissions',\%current_permissions,$domain,$user);
     return;
 }
 
@@ -4442,7 +4460,7 @@ sub metadata {
         my %metathesekeys=();
         unless ($filename=~/\.meta$/) { $filename.='.meta'; }
 	my $metastring;
-	if ($uri !~ m|^uploaded/|) {
+	if ($uri !~ m -^(uploaded|editupload)/-) {
 	    my $file=&filelocation('',&clutter($filename));
 	    #push(@{$metaentry{$uri.'.file'}},$file);
 	    $metastring=&getfile($file);
@@ -4466,7 +4484,7 @@ sub metadata {
 		    } else {
 			$metaentry{':packages'}=$package.$keyroot;
 		    }
-		    foreach (keys %packagetab) {
+		    foreach (sort keys %packagetab) {
 			my $part=$keyroot;
 			$part=~s/^\_//;
 			if ($_=~/^\Q$package\E\&/ || 
@@ -4683,7 +4701,20 @@ sub gettitle {
     if (!$title) { $title=(split('/',$urlsymb))[-1]; }    
     return $title;
 }
-    
+
+sub get_slot {
+    my ($which,$cnum,$cdom)=@_;
+    if (!$cnum || !$cdom) {
+	(undef,my $courseid)=&Apache::lonxml::whichuser();
+	$cdom=$ENV{'course.'.$courseid.'.domain'};
+	$cnum=$ENV{'course.'.$courseid.'.num'};
+    }
+    my %slotinfo=&get('slots',[$which],$cdom,$cnum);
+    &Apache::lonhomework::showhash(%slotinfo);
+    my ($tmp)=keys(%slotinfo);
+    if ($tmp=~/^error:/) { return (); }
+    return %{$slotinfo{$which}};
+}
 # ------------------------------------------------- Update symbolic store links
 
 sub symblist {
@@ -4785,7 +4816,7 @@ sub decode_symb {
 
 sub fixversion {
     my $fn=shift;
-    if ($fn=~/^(adm|uploaded|public)/) { return $fn; }
+    if ($fn=~/^(adm|uploaded|editupload|public)/) { return $fn; }
     my %bighash;
     my $uri=&clutter($fn);
     my $key=$ENV{'request.course.id'}.'_'.$uri;
@@ -4839,7 +4870,7 @@ sub symbread {
     my $syval='';
     if (($ENV{'request.course.fn'}) && ($thisfn)) {
         my $targetfn = $thisfn;
-        if ( ($thisfn =~ m/^uploaded\//) && ($thisfn !~ m/\.(page|sequence)$/) ) {
+        if ( ($thisfn =~ m/^(uploaded|editupload)\//) && ($thisfn !~ m/\.(page|sequence)$/) ) {
             $targetfn = 'adm/wrapper/'.$thisfn;
         }
         if (tie(%hash,'GDBM_File',$ENV{'request.course.fn'}.'_symb.db',
@@ -5247,16 +5278,15 @@ sub receipt {
 
 sub getfile {
     my ($file) = @_;
-
-    if ($file =~ m|^/*uploaded/|) { $file=&filelocation("",$file); }
+    if ($file =~ m -^/*(uploaded|editupload)/-) { $file=&filelocation("",$file); }
     &repcopy($file);
     return &readfile($file);
 }
 
 sub repcopy_userfile {
     my ($file)=@_;
-    if ($file =~ m|^/*uploaded/|) { $file=&filelocation("",$file); }
-    if ($file =~ m|^/home/httpd/html/lonUsers/|) { return 'OK'; }
+    if ($file =~ m -^/*(uploaded|editupload)/-) { $file=&filelocation("",$file); }
+    if ($file =~ m|^/home/httpd/html/lonUsers/|) { return 'ok'; }
     my ($cdom,$cnum,$filename) = 
 	($file=~m|^\Q$perlvar{'lonDocRoot'}\E/+userfiles/+([^/]+)/+([^/]+)/+(.*)|);
     my ($info,$rtncode);
@@ -5279,7 +5309,7 @@ sub repcopy_userfile {
 	    return -1;
 	}
 	if ($info < $fileinfo[9]) {
-	    return 'OK';
+	    return 'ok';
 	}
 	$info = '';
 	$lwpresp = &getuploaded('GET',$uri,$cdom,$cnum,\$info,\$rtncode);
@@ -5313,7 +5343,7 @@ sub repcopy_userfile {
     open(FILE,">$file");
     print FILE $info;
     close(FILE);
-    return 'OK';
+    return 'ok';
 }
 
 sub tokenwrapper {
@@ -5370,9 +5400,9 @@ 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
+    } elsif ($file=~/^\/*(uploaded|editupload)/) { # is an uploaded file
         my ($udom,$uname,$filename)=
-  	    ($file=~m|^/+uploaded/+([^/]+)/+([^/]+)/+(.*)$|);
+  	    ($file=~m -^/+(?:uploaded|editupload)/+([^/]+)/+([^/]+)/+(.*)$-);
         my $home=&homeserver($uname,$udom);
         my $is_me=0;
         my @ids=&current_machine_ids();
@@ -5454,7 +5484,7 @@ sub declutter {
 
 sub clutter {
     my $thisfn='/'.&declutter(shift);
-    unless ($thisfn=~/^\/(uploaded|adm|userfiles|ext|raw|priv|public)\//) { 
+    unless ($thisfn=~/^\/(uploaded|editupload|adm|userfiles|ext|raw|priv|public)\//) { 
        $thisfn='/res'.$thisfn; 
     }
     return $thisfn;
@@ -6130,8 +6160,8 @@ subscribe($fname) : subscribe to a resou
 
 repcopy($filename) : subscribes to the requested file, and attempts to
 replicate from the owning library server, Might return
-'HTTP_SERVICE_UNAVAILABLE', 'HTTP_NOT_FOUND', 'FORBIDDEN', 'OK', or
-'HTTP_BAD_REQUEST', also attempts to grab the metadata for the
+'unavailable', 'not_found', 'forbidden', 'ok', or
+'bad_request', also attempts to grab the metadata for the
 resource. Expects the local filesystem pathname
 (/home/httpd/html/res/....)
 
@@ -6473,6 +6503,91 @@ declutter() : declutters URLs (remove do
 
 =back
 
+=head2 Usererfile file routines (/uploaded*)
+
+=over 4
+
+=item *
+
+userfileupload(): main rotine for putting a file in a user or course's
+                  filespace, arguments are,
+
+ formname - required - this is the name of the element in $ENV where the
+           filename, and the contents of the file to create/modifed exist
+           the filename is in $ENV{'form.'.$formname.'.filename'} and the
+           contents of the file is located in $ENV{'form.'.$formname}
+ coursedoc - if true, store the file in the course of the active role
+             of the current user
+ subdir - required - subdirectory to put the file in under ../userfiles/
+         if undefined, it will be placed in "unknown"
+
+ (This routine calls clean_filename() to remove any dangerous
+ characters from the filename, and then calls finuserfileupload() to
+ complete the transaction)
+
+ returns either the url of the uploaded file (/uploaded/....) if successful
+ and /adm/notfound.html if unsuccessful
+
+=item *
+
+clean_filename(): routine for cleaing a filename up for storage in
+                 userfile space, argument is:
+
+ filename - proposed filename
+
+returns: the new clean filename
+
+=item *
+
+finishuserfileupload(): routine that creaes and sends the file to
+userspace, probably shouldn't be called directly
+
+  docuname: username or courseid of destination for the file
+  docudom: domain of user/course of destination for the file
+  docuhome: loncapa id of the library server that is getting the file
+  formname: same as for userfileupload()
+  fname: filename (inculding subdirectories) for the file
+
+ returns either the url of the uploaded file (/uploaded/....) if successful
+ and /adm/notfound.html if unsuccessful
+
+=item *
+
+renameuserfile(): renames an existing userfile to a new name
+
+  Args:
+   docuname: username or courseid of destination for the file
+   docudom: domain of user/course of destination for the file
+   old: current file name (including any subdirs under userfiles)
+   new: desired file name (including any subdirs under userfiles)
+
+=item *
+
+mkdiruserfile(): creates a directory is a userfiles dir
+
+  Args:
+   docuname: username or courseid of destination for the file
+   docudom: domain of user/course of destination for the file
+   dir: dir to create (including any subdirs under userfiles)
+
+=item *
+
+removeuserfile(): removes a file that exists in userfiles
+
+  Args:
+   docuname: username or courseid of destination for the file
+   docudom: domain of user/course of destination for the file
+   fname: filname to delete (including any subdirs under userfiles)
+
+=item *
+
+removeuploadedurl(): convience function for removeuserfile()
+
+  Args:
+   url:  a full /uploaded/... url to delete
+
+=back
+
 =head2 HTTP Helper Routines
 
 =over 4