[svn:parrot] r40840 - branches/tt509_install_files/lib/Parrot

[jkeenan at svn.parrot.org]

Author: jkeenan
Date: Fri Aug 28 14:55:34 2009
New Revision: 40840
URL: https://trac.parrot.org/parrot/changeset/40840

Log:
Applying patch submitted by wayland++ in https://trac.parrot.org/parrot/attachment/ticket/509/symlink_copier.patch.  Needs testing in non-symlinkable situations.

Modified:
   branches/tt509_install_files/lib/Parrot/Install.pm

Modified: branches/tt509_install_files/lib/Parrot/Install.pm
==============================================================================
--- branches/tt509_install_files/lib/Parrot/Install.pm	Fri Aug 28 08:45:02 2009	(r40839)
+++ branches/tt509_install_files/lib/Parrot/Install.pm	Fri Aug 28 14:55:34 2009	(r40840)
@@ -211,7 +211,7 @@
 
     ref($files) eq 'ARRAY' or die "Error: parameter \$files must be an array\n";
     print("Installing ...\n");
-    foreach my $el ( @$files ) {
+    FILE: foreach my $el ( @$files ) {
         unless(ref($el) eq 'HASH') {
             my($ref) = ref($el);
             warn "Bad reference passed in \$files (want a HASH, got a '$ref')\n";
@@ -226,6 +226,32 @@
         else {
             next unless -e $src;
             next if $^O eq 'cygwin' and -e "$src.exe"; # stat works, copy not
+            SYMLINK: {
+                if (! -l $src) { last SYMLINK; }
+
+                # check if the *system* supports symbolic linking 
+                use Config; 
+                if (! ($Config{d_symlink} && $Config{d_readlink})) { last SYMLINK; }
+
+                # copy as symbolic link;
+                # be extra cautious about existence of symlinks
+                # on a given OS
+                use Errno;
+                if(! exists $!{EPERM}) { last SYMLINK; } # Doesn't seem to support this
+                my $symlink_exists = eval {
+                    symlink(readlink($src), $dest); 1;
+                };
+                $@ and die $@;
+                if (! $symlink_exists) {
+                    if($!{EPERM}) {
+                        warn "Warning: filesystem does not support symbolic links!\n";
+                        last SYMLINK;
+                    }
+                    die "Error copying symlink: $!";
+                }
+                print "$dest\n"; 
+                next FILE; 
+            }
             copy( $src, $dest ) or die "Error: couldn't copy $src to $dest: $!\n";
             print "$dest\n";
         }