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

Timestamp:

2010-11-09T14:48:28+13:00 (13 years ago)

Author:

davidb

Message:

Routines added that support converting raw filenames (i.e. byte-code strings) to %xx for any non-ASCII characters. Some extra routines for debugging UTF8/Unicode strings added also

File:

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

main/trunk/greenstone2/perllib/unicode.pm

@@ -39 +39 @@
 
 no strict 'refs';
+
+
+
+sub utf8decomp
+{   
+    my ($str) = @_;
+
+    return if (!defined $str);
+    return "" if ($str eq "");
+    
+    my @unpacked_chars = unpack("C*", $str); # unpack Unicode characters
+
+    my @each_char
+    = map { ($_ > 255 )
+           ? # if wide character...
+             sprintf("\\x{%04X}", $_) 
+           : # \x{...}
+             (chr($_) =~ m/[[:cntrl:]]/ )
+             ? # else if control character ...
+               sprintf("\\x%02X", $_) 
+             : # \x..
+               quotemeta(chr($_)) # else quoted or as themselves
+           } @unpacked_chars;
+    
+    return join("",@each_char);
+}
+
+
+sub hex_codepoint {
+    if (my $char = shift) {
+        return sprintf '%2.2x', unpack('U0U*', $char);
+    }
+}
+
+
+
 
 # ascii2unicode takes an (extended) ascii string (ISO-8859-1)
@@ -714 +750 @@
 }
 
+
+sub raw_filename_to_url_encoded
+{
+    my ($str_in) = @_;
+
+    my @url_encoded_chars
+    = map { $_ > 128 ?                      # if wide character...
+            sprintf("%%%2X", $_) :  # \x{...}
+            chr($_)          
+        } unpack("U*", $str_in);        # unpack Unicode characters
+
+    
+    my $str_out = join("", @url_encoded_chars);
+
+    return $str_out;
+
+}
+
+
+sub url_encoded_to_raw_filename
+{
+    my ($str_in) = @_;
+
+    my $str_out = $str_in;
+
+    $str_out =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg;
+
+    return $str_out;
+}
+
 1;