[LON-CAPA-cvs] cvs: loncom /lonnet/perl lonnet.pm

[raeburn]

raeburn		Tue Mar 16 15:15:09 2004 EDT

  Modified files:              
    /loncom/lonnet/perl	lonnet.pm 
  Log:
  Method used by lonnet to support upload of structure into userfiles directory changed.
  lonnet::userfileupload() and lonnet::finishuserfileupload() revert to versions in 1.475.
  
  New lonnet::process_coursefile routine added.
  
  
Index: loncom/lonnet/perl/lonnet.pm
diff -u loncom/lonnet/perl/lonnet.pm:1.476 loncom/lonnet/perl/lonnet.pm:1.477
--- loncom/lonnet/perl/lonnet.pm:1.476	Tue Mar  9 11:25:19 2004
+++ loncom/lonnet/perl/lonnet.pm	Tue Mar 16 15:15:08 2004
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.476 2004/03/09 16:25:19 raeburn Exp $
+# $Id: lonnet.pm,v 1.477 2004/03/16 20:15:08 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -1171,7 +1171,8 @@
     $uri=~s/^\///;
     $ENV{'user.environment'}=~/\/([^\/]+)\.id/;
     my $token=$1;
-    if ($uri=~/^uploaded\/([^\/]+)\/([^\/]+)\/([^\/]+)(\?\.*)*$/) {
+#    if ($uri=~/^uploaded\/([^\/]+)\/([^\/]+)\/([^\/]+)(\?\.*)*$/) {
+    if ($uri=~/^uploaded\/([^\/]+)\/([^\/]+)\/(.+)(\?\.*)*$/) {
 	&appenv('userfile.'.$1.'/'.$2.'/'.$3 => $ENV{'request.course.id'});
         return 'http://'.$hostname{ &homeserver($2,$1)}.'/'.$uri.
                (($uri=~/\?/)?'&':'?').'token='.$token.
@@ -1180,19 +1181,68 @@
 	return '/adm/notfound.html';
     }
 }
-    
+
+# --------------- File operations in /home/httpd/html/userfiles/$domain/1/2/3/$course
+# input: action, courseID, current domain, home server for course, intended path to file,
+# source of file.
+# output: ok if successful, diagnostic message otherwise
+#
+# Allows directory structure to be used within lonUsers/../userfiles/ for a course.
+#
+# action = propagate - /home/httpd/html/userfiles/$domain/1/2/3/$course/$file will
+# be copied to /home/httpd/lonUsers/1/2/3/$course/userfiles in course's home server.
+#
+# action = copy - /home/httpd/html/userfiles/$domain/1/2/3/$course/$file will be copied
+# from $source (current location) to /home/httpd/html/userfiles/$domain/1/2/3/$course/$file
+# and will then be copied to /home/httpd/lonUsers/1/2/3/$course/userfiles/$file in
+# course's home server.
+
+sub process_coursefile {
+    my ($action,$docuname,$docudom,$docuhome,$file,$source)=@_;
+    my $fetchresult;
+    if ($action eq 'propagate') {
+        $fetchresult= &reply('fetchuserfile:'.$docudom.'/'.$docuname.'/'.$file
+                            ,$docuhome);
+    } elsif ($action eq 'copy') {
+        my $fetchresult = '';
+        my $fpath = '';
+        my $fname = $file;
+        ($fpath,$fname) = ($file =~ m/^(.*)\/([^\/]+)$/);
+        $fpath=$docudom.'/'.$docuname.'/'.$fpath;
+        my $filepath=$perlvar{'lonDocRoot'}.'/userfiles';
+        unless ($fpath eq '') {
+            my @parts=split(/\//,$fpath);
+            foreach my $part (@parts) {
+                $filepath.= '/'.$part;
+                if ((-e $filepath)!=1) {
+                    mkdir($filepath,0777);
+                }
+            }
+        }
+        if ($source eq '') {
+            $fetchresult = 'no source file';
+        } else {
+            my $destination = $filepath.'/'.$fname;
+            print STDERR "Getting ready to rename $source to $destination\n";
+            rename($source,$destination);
+            $fetchresult= &reply('fetchuserfile:'.$docudom.'/'.$docuname.'/'.$file,
+                                 $docuhome);
+        }
+    }
+    unless ( ($fetchresult eq 'ok') || ($fetchresult eq 'no source file') ) {
+        &logthis('Failed to transfer '.$docudom.'/'.$docuname.'/'.$file.
+             ' to host '.$docuhome.': '.$fetchresult);
+    }
+    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 userfileupload {
-    my ($formname,$coursedoc,$filename,$fpath,$source)=@_;
-    my $fname;
-    if (defined($filename)) {
-        $fname = $filename;
-    } else {
-        $fname=$ENV{'form.'.$formname.'.filename'};
-    }
+    my ($formname,$coursedoc)=@_;
+    my $fname=$ENV{'form.'.$formname.'.filename'};
 # Replace Windows backslashes by forward slashes
     $fname=~s/\\/\//g;
 # Get rid of everything but the actual filename
@@ -1203,11 +1253,7 @@
     $fname=~s/[^\w\.\-]//g;
 # See if there is anything left
     unless ($fname) { return 'error: no uploaded file'; }
-    if ( defined($formname) ) {
-        if ( defined($ENV{'form.'.$formname}) ) {
-            chop($ENV{'form.'.$formname});
-        }
-    }
+    chop($ENV{'form.'.$formname});
 # Create the directory if not present
     my $docuname='';
     my $docudom='';
@@ -1222,12 +1268,12 @@
         $docuhome=$ENV{'user.home'};
     }
     return 
-        &finishuserfileupload($docuname,$docudom,$docuhome,$formname,$fname,$fpath,$source);
+        &finishuserfileupload($docuname,$docudom,$docuhome,$formname,$fname);
 }
 
 sub finishuserfileupload {
-    my ($docuname,$docudom,$docuhome,$formname,$fname,$fpath,$source)=@_;
-    my $path=$docudom.'/'.$docuname.'/'.$fpath;
+    my ($docuname,$docudom,$docuhome,$formname,$fname)=@_;
+    my $path=$docudom.'/'.$docuname.'/';
     my $filepath=$perlvar{'lonDocRoot'};
     my @parts=split(/\//,$filepath.'/userfiles/'.$path);
     my $count;
@@ -1239,20 +1285,14 @@
     }
 # Save the file
     {
-       if ($source eq '') {
-           open(my $fh,'>'.$filepath.'/'.$fname);
-           print $fh $ENV{'form.'.$formname};
-           close($fh);
-       } else {
-           my $destination = $filepath.'/'.$fname;
-           rename($source,$destination);
-       }
+       open(my $fh,'>'.$filepath.'/'.$fname);
+       print $fh $ENV{'form.'.$formname};
+       close($fh);
     }
 # Notify homeserver to grep it
 #
-    
-    my $fetchresult= &reply('fetchuserfile:'.$docudom.'/'.$docuname.'/'.$fname.
-			    ':'.$fpath,$docuhome);
+    my $fetchresult= &reply('fetchuserfile:'.$docudom.'/'.$docuname.'/'.$fname,
+			    $docuhome);
     if ($fetchresult eq 'ok') {
 #
 # Return the URL to it