Ticket #509: symlink_copier.patch

File symlink_copier.patch, 1.8 KB (added by wayland, 5 years ago)

Updated patch

  • lib/Parrot/Install.pm

     
    211211 
    212212    ref($files) eq 'ARRAY' or die "Error: parameter \$files must be an array\n"; 
    213213    print("Installing ...\n"); 
    214     foreach my $el ( @$files ) { 
     214    FILE: foreach my $el ( @$files ) { 
    215215        unless(ref($el) eq 'HASH') { 
    216216            my($ref) = ref($el); 
    217217            warn "Bad reference passed in \$files (want a HASH, got a '$ref')\n"; 
     
    226226        else { 
    227227            next unless -e $src; 
    228228            next if $^O eq 'cygwin' and -e "$src.exe"; # stat works, copy not 
     229            SYMLINK: { 
     230                if (! -l $src) { last SYMLINK; } 
     231 
     232                # check if the *system* supports symbolic linking  
     233                use Config;  
     234                if (! ($Config{d_symlink} && $Config{d_readlink})) { last SYMLINK; } 
     235 
     236                # copy as symbolic link; 
     237                # be extra cautious about existence of symlinks 
     238                # on a given OS 
     239                use Errno; 
     240                if(! exists $!{EPERM}) { last SYMLINK; } # Doesn't seem to support this 
     241                my $symlink_exists = eval { 
     242                    symlink(readlink($src), $dest); 1; 
     243                }; 
     244                $@ and die $@; 
     245                if (! $symlink_exists) { 
     246                    if($!{EPERM}) { 
     247                        warn "Warning: filesystem does not support symbolic links!\n"; 
     248                        last SYMLINK; 
     249                    } 
     250                    die "Error copying symlink: $!"; 
     251                } 
     252                print "$dest\n";  
     253                next FILE;  
     254            } 
    229255            copy( $src, $dest ) or die "Error: couldn't copy $src to $dest: $!\n"; 
    230256            print "$dest\n"; 
    231257        }