Changeset 14221

Timestamp:

2007-07-07T11:30:17+12:00 (17 years ago)

Author:

qq6

Message:

making hardlink works on windows. Many thanks to Pongtawat Chippimolchai

File:

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

gsdl/trunk/perllib/util.pm

@@ -26 +26 @@
 package util;
 
+BEGIN {                                                             
+    die "GSDLHOME not set\n" unless defined $ENV{'GSDLHOME'};       
+    die "GSDLOS not set\n" unless defined $ENV{'GSDLOS'};           
+    unshift (@INC, "$ENV{'GSDLHOME'}/perllib");                     
+    unshift (@INC, "$ENV{'GSDLHOME'}/perllib/cpan");                
+}                                                                   
 use File::Copy;
 use File::Basename;
-
+#use Win32::Hardlink;
 
 # removes files (but not directories)
@@ -381 +387 @@
     # link not supported on windows 9x
     if (($ENV{'GSDLOS'} =~ /^windows$/i) && (Win32::FsType() !~ /^ntfs$/i)) {
+    print STDERR "util::hard_link: win32: using copy for hard link.\n";
     &File::Copy::copy ($src, $dest);
 
@@ -407 +414 @@
     my $dest_dir = &File::Basename::dirname($dest);
     mk_all_dir($dest_dir) if (!-e $dest_dir);
-
+        
+    # symlink not supported on windows
     if ($ENV{'GSDLOS'} =~ /^windows$/i) {
-    # symlink not supported on windows
-    &File::Copy::copy ($src, $dest);
+      
+        if ( (Win32::FsType() =~ /^ntfs$/i) && 
+            ($src =~ /^.:\\.*/) && ($dest =~ /^.:\\.*/) &&
+            (substr($src,0,3) eq substr($dest,0,3)) ) {
+        
+            # if filesystem is NTFS and both source and destination is on the same local drive,
+            # use hardlink instead of symlink
+            #print STDERR "util::soft_link: win32: using hard link instead of soft ink.\n"; 
+        require Win32::Hardlink;
+        hard_link($src,$dest);
+        } else {
+            #print STDERR "util::soft_link: win32: using copy for soft link.\n ";
+            &File::Copy::copy ($src, $dest);
+        }
 
     } elsif (!eval {symlink($src, $dest)}) {