@@ -6,6 +6,7 @@ use 5.008004;
6
6
use base qw( Exporter ) ;
7
7
use Path::Tiny qw( path ) ;
8
8
use Config;
9
+ use File::chdir ;
9
10
10
11
# ABSTRACT: Private utility functions for Alien::Build
11
12
# VERSION
@@ -28,6 +29,21 @@ L<Alien::Build>
28
29
29
30
our @EXPORT_OK = qw( _mirror _dump _destdir_prefix _perl_config _ssl_reqs _has_ssl ) ;
30
31
32
+ # This helper sub is intended to be called with string argument "MSYS" or "CYGWIN"
33
+ # According to https://cygwin.com/cygwin-ug-net/using-cygwinenv.html :
34
+ # The CYGWIN environment variable is used to configure many global settings for the Cygwin
35
+ # runtime system. It contain options separated by blank characters.
36
+ # TODO: We assume the same format for the MSYS environment variable. Where is it documented?
37
+ sub _check_native_symlink {
38
+ my ($var ) = @_ ;
39
+ if (defined $ENV {$var }) {
40
+ if ($ENV {$var } =~ / (?:^|\s +)\Q winsymlinks:nativestrict\E (?:$| \s +)/ ) {
41
+ return 1;
42
+ }
43
+ }
44
+ return 0;
45
+ }
46
+
31
47
# usage: _mirror $source_directory, $dest_direction, \%options
32
48
#
33
49
# options:
@@ -44,7 +60,6 @@ sub _mirror
44
60
require Alien::Build;
45
61
require File::Find;
46
62
require File::Copy;
47
-
48
63
File::Find::find({
49
64
wanted => sub {
50
65
next unless -e $File::Find::name ;
@@ -66,9 +81,16 @@ sub _mirror
66
81
my $target = readlink " $src " ;
67
82
Alien::Build-> log (" ln -s $target $dst " ) if $opt -> {verbose };
68
83
if (path($target )-> is_relative) {
69
- my $nativesymlink =
70
- (($^O eq " msys" && defined $ENV {MSYS } && $ENV {MSYS } eq " winsymlinks:nativestrict" )
71
- || ($^O eq " cygwin" && defined $ENV {CYGWIN } && $ENV {CYGWIN } eq " winsymlinks:nativestrict" ));
84
+ my $nativesymlink = (($^O eq " msys" && _check_native_symlink(" MSYS" ))
85
+ || ($^O eq " cygwin" && _check_native_symlink(" CYGWIN" )));
86
+ # NOTE: there are two cases to consider here, 1. the target might not
87
+ # exist relative to the source dir, and 2. the target might not exist relative
88
+ # to the destination directory.
89
+ #
90
+ # 1. If the file does not exist relative to the source, it is a broken symlink,
91
+ # 2. If the file does not exist relative to the destination, it means that
92
+ # it has not been copied by this File::Find::find() call yet. So it will only
93
+ # be temporarily broken.
72
94
if (!$src -> parent-> child($target )-> exists ) {
73
95
if ($nativesymlink ) {
74
96
# NOTE: On linux, it is OK to create broken symlinks, but it is not allowed on
@@ -77,14 +99,18 @@ sub _mirror
77
99
}
78
100
}
79
101
if ($nativesymlink ) {
102
+ # If the target does not exist relative to the parent yet (it should be existing at the end of
103
+ # this File::Find::find() call), make a temporary empty file such that the symlink
104
+ # call does not fail.
80
105
$dst -> parent-> child($target )-> touchpath;
81
106
}
82
107
}
83
108
my $curdir = Path::Tiny-> cwd;
84
- # CD into the directory, such that symlink will work on MSYS2
85
- chdir $dst -> parent or die " could not chdir to $src ->parent : $! " ;
86
- symlink ($target , $dst ) || die " unable to symlink $target => $dst " ;
87
- chdir $curdir or die " could not chdir to $curdir : $! " ;
109
+ {
110
+ local $CWD = $dst -> parent;
111
+ # CD into the directory, such that symlink will work on MSYS2
112
+ symlink ($target , $dst ) || die " unable to symlink $target => $dst " ;
113
+ }
88
114
}
89
115
elsif (-d " $src " )
90
116
{
0 commit comments