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

[raeburn]

raeburn		Mon Aug 19 07:44:33 2013 EDT

  Modified files:              (Branch: version_2_11_X)
    /loncom/interface	loncommon.pm 
  Log:
  - For 2.11
    - Backport 1.1147.
  
  
Index: loncom/interface/loncommon.pm
diff -u loncom/interface/loncommon.pm:1.1075.2.46 loncom/interface/loncommon.pm:1.1075.2.47
--- loncom/interface/loncommon.pm:1.1075.2.46	Sun Aug 18 17:32:57 2013
+++ loncom/interface/loncommon.pm	Mon Aug 19 07:44:32 2013
@@ -1,7 +1,7 @@
 # The LearningOnline Network with CAPA
 # a pile of common routines
 #
-# $Id: loncommon.pm,v 1.1075.2.46 2013/08/18 17:32:57 raeburn Exp $
+# $Id: loncommon.pm,v 1.1075.2.47 2013/08/19 07:44:32 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -9850,16 +9850,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 '') {
@@ -9876,9 +9876,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;
                 }
             }
         }
@@ -10252,6 +10252,47 @@
     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') &&