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

[raeburn]

raeburn		Sat Dec 25 03:27:07 2010 EDT

  Modified files:              (Branch: version_2_10_X)
    /loncom/lonnet/perl	lonnet.pm 
  Log:
  - Backport 1.1095.
  
  
Index: loncom/lonnet/perl/lonnet.pm
diff -u loncom/lonnet/perl/lonnet.pm:1.1056.4.15 loncom/lonnet/perl/lonnet.pm:1.1056.4.16
--- loncom/lonnet/perl/lonnet.pm:1.1056.4.15	Fri Dec 24 21:59:08 2010
+++ loncom/lonnet/perl/lonnet.pm	Sat Dec 25 03:27:06 2010
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.1056.4.15 2010/12/24 21:59:08 raeburn Exp $
+# $Id: lonnet.pm,v 1.1056.4.16 2010/12/25 03:27:06 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -2200,6 +2200,8 @@
 #        path to file, source of file, instruction to parse file for objects,
 #        ref to hash for embedded objects,
 #        ref to hash for codebase of java objects.
+#        reference to scalar to accommodate mime type determined
+#          from File::MMagic if $parser = parse.
 #
 # output: url to file (if action was uploaddoc), 
 #         ok if successful, or diagnostic message otherwise (if action was propagate or copy)
@@ -2226,7 +2228,8 @@
 #
 
 sub process_coursefile {
-    my ($action,$docuname,$docudom,$file,$source,$parser,$allfiles,$codebase)=@_;
+    my ($action,$docuname,$docudom,$file,$source,$parser,$allfiles,$codebase,
+        $mimetype)=@_;
     my $fetchresult;
     my $home=&homeserver($docuname,$docudom);
     if ($action eq 'propagate') {
@@ -2254,13 +2257,16 @@
             close($fh);
             if ($parser eq 'parse') {
                 my $mm = new File::MMagic;
-                my $mime_type = $mm->checktype_filename($filepath.'/'.$fname);
-                if ($mime_type eq 'text/html') {
+                my $type = $mm->checktype_filename($filepath.'/'.$fname);
+                if ($type eq 'text/html') {
                     my $parse_result = &extract_embedded_items($filepath.'/'.$fname,$allfiles,$codebase);
                     unless ($parse_result eq 'ok') {
                         &logthis('Failed to parse '.$filepath.'/'.$fname.' for embedded media: '.$parse_result);
                     }
                 }
+                if (ref($mimetype)) {
+                    $$mimetype = $type;
+                }
             }
             $fetchresult= &reply('fetchuserfile:'.$docudom.'/'.$docuname.'/'.$file,
                                  $home);
@@ -2393,13 +2399,15 @@
 #        $thumbheight - height (pixels) of thumbnail to make for uploaded image
 #        $resizewidth - width (pixels) to which to resize uploaded image
 #        $resizeheight - height (pixels) to which to resize uploaded image
+#        $mimetype - reference to scalar to accommodate mime type determined
+#                    from File::MMagic if $parser = parse.
 # 
 # output: url of file in userspace, or error: <message> 
 #             or /adm/notfound.html if failure to upload occurse
 
 sub userfileupload {
     my ($formname,$context,$subdir,$parser,$allfiles,$codebase,$destuname,
-        $destudom,$thumbwidth,$thumbheight,$resizewidth,$resizeheight)=@_;
+        $destudom,$thumbwidth,$thumbheight,$resizewidth,$resizeheight,$mimetype)=@_;
     if (!defined($subdir)) { $subdir='unknown'; }
     my $fname=$env{'form.'.$formname.'.filename'};
     $fname=&clean_filename($fname);
@@ -2475,12 +2483,12 @@
             return &finishuserfileupload($docuname,$docudom,
 					 $formname,$fname,$parser,$allfiles,
 					 $codebase,$thumbwidth,$thumbheight,
-                                         $resizewidth,$resizeheight,$context);
+                                         $resizewidth,$resizeheight,$context,$mimetype);
         } else {
             $fname=$env{'form.folder'}.'/'.$fname;
             return &process_coursefile('uploaddoc',$docuname,$docudom,
 				       $fname,$formname,$parser,
-				       $allfiles,$codebase);
+				       $allfiles,$codebase,$mimetype);
         }
     } elsif (defined($destuname)) {
         my $docuname=$destuname;
@@ -2488,7 +2496,7 @@
 	return &finishuserfileupload($docuname,$docudom,$formname,$fname,
 				     $parser,$allfiles,$codebase,
                                      $thumbwidth,$thumbheight,
-                                     $resizewidth,$resizeheight,$context);
+                                     $resizewidth,$resizeheight,$context,$mimetype);
     } else {
         my $docuname=$env{'user.name'};
         my $docudom=$env{'user.domain'};
@@ -2499,13 +2507,13 @@
 	return &finishuserfileupload($docuname,$docudom,$formname,$fname,
 				     $parser,$allfiles,$codebase,
                                      $thumbwidth,$thumbheight,
-                                     $resizewidth,$resizeheight,$context);
+                                     $resizewidth,$resizeheight,$context,$mimetype);
     }
 }
 
 sub finishuserfileupload {
     my ($docuname,$docudom,$formname,$fname,$parser,$allfiles,$codebase,
-        $thumbwidth,$thumbheight,$resizewidth,$resizeheight,$context) = @_;
+        $thumbwidth,$thumbheight,$resizewidth,$resizeheight,$context,$mimetype) = @_;
     my $path=$docudom.'/'.$docuname.'/';
     my $filepath=$perlvar{'lonDocRoot'};
   
@@ -2563,8 +2571,8 @@
     }
     if ($parser eq 'parse') {
         my $mm = new File::MMagic;
-        my $mime_type = $mm->checktype_filename($filepath.'/'.$file);
-        if ($mime_type eq 'text/html') {
+        my $type = $mm->checktype_filename($filepath.'/'.$file);
+        if ($type eq 'text/html') {
             my $parse_result = &extract_embedded_items($filepath.'/'.$file,
                                                        $allfiles,$codebase);
             unless ($parse_result eq 'ok') {
@@ -2572,6 +2580,9 @@
 	   	         ' for embedded media: '.$parse_result); 
             }
         }
+        if (ref($mimetype)) {
+            $$mimetype = $type;
+        }
     }
     if (($thumbwidth =~ /^\d+$/) && ($thumbheight =~ /^\d+$/)) {
         my $input = $filepath.'/'.$file;
@@ -11489,6 +11500,8 @@
   resizeheight: height to be used to resize image using resizeImage from ImageMagick
   context: if 'overwrite', will move the uploaded file from its temporary location to
             userfiles to facilitate overwriting a previously uploaded file with same name.
+  mimetype: reference to scalar to accommodate mime type determined
+            from File::MMagic if $parser = parse.
 
  returns either the url of the uploaded file (/uploaded/....) if successful
  and /adm/notfound.html if unsuccessful (or an error message if context