Changeset 23362 for main/trunk/greenstone2/perllib/unicode.pm

Timestamp:

2010-12-01T11:40:36+13:00 (13 years ago)

Author:

davidb

Message:

Additional routines (and few upgraded) to help support Greenstone working with filenames under Windows when then go beyond Latin-1 and start turning up in their DOS abbreviated form (e.g. Test~1.txt)

File:

• main/trunk/greenstone2/perllib/unicode.pm (modified) (5 diffs)

main/trunk/greenstone2/perllib/unicode.pm

@@ -619 +619 @@
     
     if (!&is_url_encoded($text)) {
-    $text =~ s/([^A-Z0-9\ \.\-\_])/sprintf("%%%02X", ord($1))/iseg;
+    $text =~ s/([^0-9A-Z\ \.\-\_])/sprintf("%%%02X", ord($1))/iseg;
     # return the url-encoded character entity for underscore back to the entity
     $text =~ s/%26%23095%3B/&\#095;/g;
@@ -629 +629 @@
     my ($text) = @_;
 
-    $text =~ s/\%([A-F0-9]{2})/pack('C', hex($1))/ige;
+    $text =~ s/\%([0-9A-F]{2})/pack('C', hex($1))/ige;
+    $text =~ s/\&\#x([0-9A-F]+);/pack('C', hex($1))/ige;
+    $text =~ s/\&\#([0-9]+);/pack('C', $1)/ige;
+
     return $text;
 }
@@ -635 +638 @@
 sub is_url_encoded {
     my ($text) = @_;
-    return ($text =~ m/\%([A-F0-9]{2})/);
+    return ($text =~ m/\%([0-9A-F]{2})/i) || ($text =~ m/\&\#x([0-9A-F]+;)/i) || ($text =~ m/\&\#([0-9]+;)/i);
 }
 
@@ -756 +759 @@
 
     my @url_encoded_chars
-    = map { $_ > 128 ?                      # if wide character...
-            sprintf("%%%2X", $_) :  # \x{...}
-            chr($_)          
-        } unpack("U*", $str_in);        # unpack Unicode characters
+    = map { $_ > 255 ?                  # Needs to be represent in entity form
+            sprintf("&#x%X;",$_) :  
+            $_ > 128 ?              # Representable in %XX form
+            sprintf("%%%2X", $_) :  
+            chr($_)                 # otherwise, Ascii char
+        } unpack("U*", $str_in); # Unpack Unicode characters
 
     
@@ -775 +780 @@
     my $str_out = $str_in;
 
-    $str_out =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg;
+    $str_out =~ s/&#x([0-9A-F]+);/chr(hex($1))/eig;
+    $str_out =~ s/&#([0-9]+);/chr($1)/eig;
+    $str_out =~ s/%([0-9A-F]{2})/chr(hex($1))/eig;
 
     return $str_out;