Changeset 23362 for main/trunk/greenstone2/perllib/util.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/util.pm (modified) (6 diffs)

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