Changeset 16632 for gsdl/trunk/perllib/plugins/HTMLPlugin.pm

Timestamp:

2008-08-01T15:42:09+12:00 (16 years ago)

Author:

ak19

Message:

Work on supporting non-utf8 characters in filenames

File:

• gsdl/trunk/perllib/plugins/HTMLPlugin.pm (modified) (3 diffs)

gsdl/trunk/perllib/plugins/HTMLPlugin.pm

@@ -937 +937 @@
     $link =~ s/^.*\\([^\\]+)$/$1/;
     }
-
+    
     my ($href, $hash_part, $rl) = $self->format_link ($link, $base_dir, $file);
 
     my $img_file =  $self->add_file ($href, $rl, $hash_part, $base_dir, $doc_obj, $section);
+
+    print STDERR "**** link = $link\n";
+    print STDERR "**** href = $href\n";
+    print STDERR "**** img_file = $img_file\n";
 
     my $anchor_name = $img_file;
@@ -1020 +1024 @@
     $filename = &util::filename_cat($base_dir, $filename);
     
-    # Replace %20's in URL with a space if required. Note that the filename
-    # may include the %20 in some situations
-    if ($filename =~ /\%20/) {
+    # Replace %XX's in URL with decoded value if required. 
+    # Note that the filename may include the %XX in some situations
+    if ($filename =~ m/\%[A-F0-9]{2}/i) {
     if (!-e $filename) {
-        $filename =~ s/\%20/ /g;
+        $filename =~ s/\%([A-F0-9]{2})/pack('C', hex($1))/ige;
     }
     }
@@ -1055 +1059 @@
     } else {
     ($newname) = $filename =~ /([^\/\\]*)$/;
+    # Make sure this name is a valid utf8 filename
+    ## &unicode::ensure_utf8(\$newname);
+    $newname =~ s/([^A-Za-z0-9])/sprintf("%%%02X", ord($1))/seg;
+
     $doc_obj->associate_file($filename, $newname, undef, $section);
-    return "_httpdocimg_/$newname";
-    }
-}
+
+    my $newname_url = $newname;
+    $newname_url =~ s/%/%25/g;
+    return "_httpdocimg_/$newname_url";
+    }
+}
+