[LON-CAPA-cvs] cvs: loncom /interface loncommon.pm

[raeburn]

raeburn		Mon Aug 19 00:31:55 2013 EDT

  Modified files:              
    /loncom/interface	loncommon.pm 
  Log:
  - For uploaded HTML files with embedded objects, clean out unwanted characters
    (e.g., spaces etc. from directory and/or file names) of referenced items,
    and prompt user to agree to update the corresponding entries in the HTML file. 
  
  
Index: loncom/interface/loncommon.pm
diff -u loncom/interface/loncommon.pm:1.1146 loncom/interface/loncommon.pm:1.1147
--- loncom/interface/loncommon.pm:1.1146	Sun Aug 18 17:31:26 2013
+++ loncom/interface/loncommon.pm	Mon Aug 19 00:31:54 2013
@@ -1,7 +1,7 @@
 # The LearningOnline Network with CAPA
 # a pile of common routines
 #
-# $Id: loncommon.pm,v 1.1146 2013/08/18 17:31:26 raeburn Exp $
+# $Id: loncommon.pm,v 1.1147 2013/08/19 00:31:54 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -9861,16 +9861,16 @@
             $embed_file = $file;
         }
         my $absolutepath;
-        if ($embed_file =~ m{^\w+://}) {
-            $newfiles{$embed_file} = 1;
-            $mapping{$embed_file} = $embed_file;
+        my $cleaned_file = &clean_path($embed_file);
+        if ($cleaned_file =~ m{^\w+://}) {
+            $newfiles{$cleaned_file} = 1;
+            $mapping{$cleaned_file} = $embed_file;
         } else {
             if ($embed_file =~ m{^/}) {
                 $absolutepath = $embed_file;
-                $embed_file =~ s{^(/+)}{};
             }
-            if ($embed_file =~ m{/}) {
-                my ($path,$fname) = ($embed_file =~ m{^(.+)/([^/]*)$});
+            if ($cleaned_file =~ m{/}) {
+                my ($path,$fname) = ($cleaned_file =~ m{^(.+)/([^/]*)$});
                 $path = &check_for_traversal($path,$url,$toplevel);
                 my $item = $fname;
                 if ($path ne '') {
@@ -9887,9 +9887,9 @@
             } else {
                 $dependencies{$embed_file} = 1;
                 if ($absolutepath) {
-                    $mapping{$embed_file} = $absolutepath;
+                    $mapping{$cleaned_file} = $absolutepath;
                 } else {
-                    $mapping{$embed_file} = $embed_file;
+                    $mapping{$cleaned_file} = $embed_file;
                 }
             }
         }
@@ -10263,6 +10263,46 @@
     return ($output,$counter,$numpathchg);
 }
 
+=pod
+
+=item * clean_path($name)
+
+Performs clean-up of directories, subdirectories and filename in an
+embedded object, referenced in an HTML file which is being uploaded
+to a course or portfolio, where 
+"Upload embedded images/multimedia files if HTML file" checkbox was
+checked.
+
+Clean-up is similar to replacements in lonnet::clean_filename()
+except each / between sub-directory and next level is preserved.
+
+=cut
+
+sub clean_path {
+    my ($embed_file) = @_;
+    $embed_file =~s{^/+}{};
+    my @contents;
+    if ($embed_file =~ m{/}) {
+        @contents = split(/\//,$embed_file);
+    } else {
+        @contents = ($embed_file);
+    }
+    my $lastidx = scalar(@contents)-1;
+    for (my $i=0; $i<=$lastidx; $i++) { 
+        $contents[$i]=~s{\\}{/}g;
+        $contents[$i]=~s/\s+/\_/g;
+        $contents[$i]=~s{[^/\w\.\-]}{}g;
+        if ($i == $lastidx) {
+            $contents[$i]=~s/\.(\d+)(?=\.)/_$1/g;
+        }
+    }
+    if ($lastidx > 0) {
+        return join('/', at contents);
+    } else {
+        return $contents[0];
+    }
+}
+
 sub embedded_file_element {
     my ($context,$num,$embed_file,$mapping,$allfiles,$codebase,$type) = @_;
     return unless ((ref($mapping) eq 'HASH') && (ref($allfiles) eq 'HASH') &&