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

[raeburn]

raeburn		Tue Mar  9 11:25:19 2004 EDT

  Modified files:              
    /loncom/lonnet/perl	lonnet.pm 
  Log:
  lonnet::userfileupload now allows files to be uploaded into a sub-directory structure within the userfiles directory, using optional $fpath argument.  Modifications also allow files to be copied from a directory on the server (e.g., /home/httpd/perl/tmp) instead of directly from a web-form file upload, by supplying an optional $source argument in the call to lonnet::userfileupload().
  Previous arguments:
  sub userfileupload {
      my ($formname,$coursedoc,$filename)=@_;
  
  New arguments:
  sub userfileupload {
      my ($formname,$coursedoc,$filename,$fpath,$source)=@_;
     
     This allows files to be placed in lonUsers within a subdirectory structure,
  e.g., in lonUsers/a/b/c/abc1421y123ioip113/userfiles/102903232/sequences/newfile.sequence (where $fpath = '/102903232/sequences/).
                                                                                   
  requires lond v. 1.182
  
  
  
Index: loncom/lonnet/perl/lonnet.pm
diff -u loncom/lonnet/perl/lonnet.pm:1.475 loncom/lonnet/perl/lonnet.pm:1.476
--- loncom/lonnet/perl/lonnet.pm:1.475	Mon Mar  8 18:04:00 2004
+++ loncom/lonnet/perl/lonnet.pm	Tue Mar  9 11:25:19 2004
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.475 2004/03/08 23:04:00 albertel Exp $
+# $Id: lonnet.pm,v 1.476 2004/03/09 16:25:19 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -1186,8 +1186,13 @@
 # output: url of file in userspace
 
 sub userfileupload {
-    my ($formname,$coursedoc)=@_;
-    my $fname=$ENV{'form.'.$formname.'.filename'};
+    my ($formname,$coursedoc,$filename,$fpath,$source)=@_;
+    my $fname;
+    if (defined($filename)) {
+        $fname = $filename;
+    } else {
+        $fname=$ENV{'form.'.$formname.'.filename'};
+    }
 # Replace Windows backslashes by forward slashes
     $fname=~s/\\/\//g;
 # Get rid of everything but the actual filename
@@ -1198,7 +1203,11 @@
     $fname=~s/[^\w\.\-]//g;
 # See if there is anything left
     unless ($fname) { return 'error: no uploaded file'; }
-    chop($ENV{'form.'.$formname});
+    if ( defined($formname) ) {
+        if ( defined($ENV{'form.'.$formname}) ) {
+            chop($ENV{'form.'.$formname});
+        }
+    }
 # Create the directory if not present
     my $docuname='';
     my $docudom='';
@@ -1213,12 +1222,12 @@
         $docuhome=$ENV{'user.home'};
     }
     return 
-        &finishuserfileupload($docuname,$docudom,$docuhome,$formname,$fname);
+        &finishuserfileupload($docuname,$docudom,$docuhome,$formname,$fname,$fpath,$source);
 }
 
 sub finishuserfileupload {
-    my ($docuname,$docudom,$docuhome,$formname,$fname)=@_;
-    my $path=$docudom.'/'.$docuname.'/';
+    my ($docuname,$docudom,$docuhome,$formname,$fname,$fpath,$source)=@_;
+    my $path=$docudom.'/'.$docuname.'/'.$fpath;
     my $filepath=$perlvar{'lonDocRoot'};
     my @parts=split(/\//,$filepath.'/userfiles/'.$path);
     my $count;
@@ -1230,15 +1239,20 @@
     }
 # Save the file
     {
-       open(my $fh,'>'.$filepath.'/'.$fname);
-       print $fh $ENV{'form.'.$formname};
-       close($fh);
+       if ($source eq '') {
+           open(my $fh,'>'.$filepath.'/'.$fname);
+           print $fh $ENV{'form.'.$formname};
+           close($fh);
+       } else {
+           my $destination = $filepath.'/'.$fname;
+           rename($source,$destination);
+       }
     }
 # Notify homeserver to grep it
 #
     
-    my $fetchresult= &reply('fetchuserfile:'.$docudom.'/'.$docuname.'/'.$fname,
-			    $docuhome);
+    my $fetchresult= &reply('fetchuserfile:'.$docudom.'/'.$docuname.'/'.$fname.
+			    ':'.$fpath,$docuhome);
     if ($fetchresult eq 'ok') {
 #
 # Return the URL to it