Changeset 23362

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)

Location:

main/trunk/greenstone2/perllib

Files:

• doc.pm (modified) (3 diffs)
• ghtml.pm (modified) (1 diff)
• unicode.pm (modified) (5 diffs)
• util.pm (modified) (6 diffs)

main/trunk/greenstone2/perllib/doc.pm

@@ -64 +64 @@
     # the docsave processor now calls set_lastmodified
 
-    $self->{'source_path'} = $source_filename;
+    $self->set_source_path($source_filename);
     
     if (defined $source_filename) {
@@ -76 +76 @@
     return $self;
 }
+
+
+sub set_source_path
+{
+    my $self = shift @_;
+    my ($source_filename) = @_;
+
+    if (defined $source_filename) {
+    # On Windows the source_filename can be in terse DOS format
+    # e.g. test~1.txt
+
+    $self->{'terse_source_path'} = $source_filename;
+
+    if (-e $source_filename) {
+        # See if we can do better for Windows with a filename
+        if ($ENV{'GSDLOS'} =~ /^windows$/i) {
+        require Win32;
+        $self->{'source_path'} = Win32::GetLongPathName($source_filename);
+        }
+        else {
+        # For Unix-based systems, there is no difference between the two
+        $self->{'source_path'} = $source_filename;
+        }
+    }
+    else {
+        print STDERR "Warning: In doc::set_source_path(), file\n";
+        print STDERR "           $source_filename\n";
+        print STDERR "         does not exist\n";
+        
+        # (default) Set it to whatever we were given
+        $self->{'source_path'} = $source_filename;
+    }   
+    }
+    else {
+    # Previous code for setting source_path allowed for
+    # it to be undefined, so continue this practice
+    $self->{'terse_source_path'} = undef;
+    $self->{'source_path'} = undef;
+    }
+}
+
+
+sub get_source_path
+{
+    my $self = shift @_;
+
+    return $self->{'terse_source_path'};
+}
+
 # set lastmodified for OAI purposes, added by GRB, moved by kjdon
 sub set_lastmodified {
     my $self = shift (@_);
 
-    my $source_path = $self->{'source_path'};
+    my $source_path = $self->{'terse_source_path'};
    
     if (defined $source_path && (-e $source_path)) {
@@ -207 +256 @@
     my $self = shift (@_);
 
-    return $self->{'source_path'};
+    return $self->{'terse_source_path'};
 }
 

main/trunk/greenstone2/perllib/ghtml.pm

@@ -207 +207 @@
 
     # a numeric entity
-    if ($entity =~ /^\#0*(\d+)/) {
-    my $code=$1;
+    my $code = undef;
+    if ($entity =~ m/^\#0*(\d+)$/) {
+    $code=$1;
+    }
+    elsif ($entity =~ m/^\#x([0-9A-F]+)$/i) {
+    $code=hex($1);
+    }
+
+    if (defined $code) {
     # non-standard Microsoft breakage, as usual
     if ($code < 0x9f) { # code page 1252 uses reserved bytes

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;

main/trunk/greenstone2/perllib/util.pm

@@ -26 +26 @@
 package util;
 
+use strict;
+
+use Encode;
 use File::Copy;
 use File::Basename;
-
-use strict;
-
 
 # removes files (but not directories)
@@ -513 +513 @@
 }
 
+# Primarily for filenames generated by processing
+# content of HTML files (which are mapped to UTF-8 internally)
+#
+# To turn this into an octet string that really exists on the file
+# system:
+# 1. don't need to do anything special for Unix-based systems
+#   (as underlying file system is byte-code)
+# 2. need to map to short DOS filenames for Windows
+
+sub utf8_to_real_filename
+{
+    my ($utf8_filename) = @_;
+
+    my $real_filename;
+
+    if ($ENV{'GSDLOS'} =~ m/^windows$/i) {
+    require Win32;
+    my $unicode_filename = decode("utf8",$utf8_filename);
+    $real_filename = Win32::GetShortPathName($unicode_filename);
+    }
+    else {
+    $real_filename = $utf8_filename;
+    }
+
+    return $real_filename;
+}
+
+
+sub fd_exists
+{
+    my $filename_full_path = shift @_;
+    my $test_op = shift @_ || "-e";
+
+    # By default tests for existance of file or directory (-e)
+    # Can be made more specific by providing second parameter (e.g. -f or -d)
+
+    my $exists = 0;
+
+    if ($ENV{'GSDLOS'} =~ m/^windows$/i) {
+    require Win32;
+    my $filename_short_path = Win32::GetShortPathName($filename_full_path); 
+    if (!defined $filename_short_path) {
+        # Was probably still in UTF8 form (not what is needed on Windows)
+        my $unicode_filename_full_path = eval "decode(\"utf8\",\$filename_full_path)";
+        if (defined $unicode_filename_full_path) {
+        $filename_short_path = Win32::GetShortPathName($unicode_filename_full_path);
+        }
+    }
+    $filename_full_path = $filename_short_path;
+    }
+
+    if (defined $filename_full_path) {
+    $exists = eval "($test_op \$filename_full_path)";
+    }
+
+    return $exists;
+}
+
+sub file_exists
+{
+    my ($filename_full_path) = @_;
+
+    return fd_exists($filename_full_path,"-f");
+}
+
+sub dir_exists
+{
+    my ($filename_full_path) = @_;
+
+    return fd_exists($filename_full_path,"-d");
+}
 
 
@@ -934 +1005 @@
 
 
+
 # returns 1 if filename1 and filename2 point to the same
 # file or directory
@@ -953 +1025 @@
 }
 
+
+sub filename_within_directory
+{
+    my ($filename,$within_dir) = @_;
+    
+    my $dirsep = &util::get_dirsep();
+    if ($within_dir !~ m/$dirsep$/) {
+    $within_dir .= $dirsep;
+    }
+    
+    $within_dir =~ s/\\/\\\\/g; # escape DOS style file separator
+    
+    if ($filename =~ m/^$within_dir(.*)$/) {
+    $filename = $1;
+    }
+    
+    return $filename;
+}
+
 sub filename_within_collection
 {
@@ -960 +1051 @@
     
     if (defined $collect_dir) {
-    my $dirsep = &util::get_dirsep();
-    if ($collect_dir !~ m/$dirsep$/) {
-        $collect_dir .= $dirsep;
-    }
-    
-    $collect_dir =~ s/\\/\\\\/g; # escape DOS style file separator
-    
+
     # if from within GSDLCOLLECTDIR, then remove directory prefix
     # so source_filename is realative to it.  This is done to aid
@@ -976 +1061 @@
     # GSDLCOLLECTDIR subsequently needs to be put back on to turn
     # it back into a full pathname.
-    
-    if ($filename =~ /^$collect_dir(.*)$/) {
-        $filename = $1;
-    }
+
+    $filename = filename_within_directory($filename,$collect_dir);
     }
     
     return $filename;
 }
+
+sub prettyprint_file
+{
+    my ($base_dir,$file) = @_;
+
+    my $filename_full_path = &util::filename_cat($base_dir,$file);
+
+    if ($ENV{'GSDLOS'} =~ m/^windows$/i) {
+    require Win32;
+
+    # For some reason base_dir in the form c:/a/b/c
+    # This leads to confusion later on, so turn it back into
+    # the more usual Windows form
+    $base_dir =~ s/\//\\/g; 
+    my $long_base_dir = Win32::GetLongPathName($base_dir);
+    my $long_full_path = Win32::GetLongPathName($filename_full_path);
+
+    $file = filename_within_directory($long_full_path,$long_base_dir);
+    }
+
+    return $file;
+}
+
+
+sub upgrade_if_dos_filename
+{
+    my ($filename_full_path) = @_;
+
+    if ($ENV{'GSDLOS'} =~ m/^windows$/i) {
+    require Win32;
+    # Ensure any DOS-like filename, such as test~1.txt, has been upgraded
+    # to its long (Windows) version
+    $filename_full_path = Win32::GetLongPathName($filename_full_path);
+    # Make sure initial drive letter is lower-case (to fit in with rest of Greenstone)
+    $filename_full_path =~ s/^(.)/\l$1/;
+    }
+
+    return $filename_full_path;
+}
+
 
 sub filename_is_absolute