1 eval '(exit $?0)' && eval 'exec perl -S $0 ${1+"$@"}'
2 & eval 'exec perl -S $0 $argv:q'
6 # Creates an ACE build tree in directory "build/<build name>" below the $ACE_ROOT
7 # directory. The build tree directory structure mirrors that of the ACE
8 # top level directory structure, except that instead of containing any plain
9 # files, it contains only links to the files in the ACE top level structure.
10 # Symbolic links will be used instead of hard links if available.
12 # Makefiles, projects, and other build files are not linked. This allows
13 # use of MPC to generate the correct project types as needed. Use the
14 # -nompc option to disable this.
16 # This program has a similar purpose to "clone", but in addition to
17 # only creating symlinks (clone creates hard links, by default), this
19 # 1) uses relative rather than absolute symlinks,
20 # 2) tries not to put junk files into the build tree,
21 # 3) only creates a new tree in a build/ directory below the current,
22 # top level ACE directory (it's a feature :-), but it does enforce
25 # This program can be re-run on a build tree at any time in order to
26 # update it. It will add links for newly added files, and remove
27 # any that are no longer valid.
28 # Specifying no command line options will cause all current builds
31 # If the <build name> starts with "build/", that part will be removed
41 print "You should consider using clone_build_tree.pl found with MPC\n";
43 $usage = "usage: $0 -? | [-a] [-d <directory mode>] [-v] [-nompc] <build name>\n";
44 $directory_mode = 0777; #### Will be modified by umask, also.
46 $mpc = 1; #### When using mpc, we don't want links created for mpc-generated files.
52 #### Check that we're in an ACE "top level" directory.
54 unless (-d
'ace' && -d
'include') {
55 die "Must be in an ACE top level (ACE_ROOT) directory!\n";
57 if (-e
'create_ace_build.links') {
58 die "Must be in an ACE top level (ACE_ROOT) directory!\n";
61 $perl_version = $] + 0;
62 if ($perl_version >= 5) {
63 #### Use an eval so that this script will compile with perl4.
79 my($starting_dir) = cwd ();
83 print "Creating or updating builds in $starting_dir\n";
85 #### If the $linked file is newer than the real file then
86 #### backup the real file, and replace it with the linked
89 sub backup_and_copy_changed {
90 my($real, $linked) = @_;
91 my($status_real) = stat($real);
94 die "ERROR: cannot access $real.\n";
97 my($status_linked) = stat($linked);
98 if ($status_linked->mtime > $status_real->mtime) {
99 rename($real, $real . '.bak');
100 rename($linked, $real);
104 if ($status_real->mtime != $status_linked->mtime) {
108 if ($status_real->size != $status_linked->size) {
116 my($real,$linked,$build_regex) = @_;
119 if ($^O eq 'MSWin32') {
120 my($fixed) = $linked;
121 $fixed =~ s/$build_regex//;
122 push(@nlinks, $fixed);
124 my($curdir) = "$starting_dir/" . dirname($linked);
126 die "ERROR: Dir not found: $curdir\n";
128 $status = chdir($curdir);
130 die "ERROR: cab_link() chdir " . $curdir . " failed.\n";
133 my($base_linked) = basename($linked);
136 ## If the real file "doesn't exist", then we need to change back to
137 ## the starting directory and look up the short file name.
138 chdir($starting_dir);
139 my($short) = Win32::GetShortPathName($fixed);
141 ## If we were able to find the short file name, then we need to
142 ## modyfy $real. Note, we don't need to change back to $curdir
143 ## unless the short name lookup was successful.
144 if (defined $short) {
145 ## Replace a section of $real (the part that isn't a relative
146 ## path) with the short file name. The hard link will still have
147 ## the right name, it's just pointing to the short name.
148 substr($real, length($real) - length($fixed)) = $short;
150 ## Get back to the right directory for when we make the hard link
154 ## This should never happen, but there appears to be a bug
155 ## with the underlying win32 apis on Windows Server 2003.
156 ## Long paths will cause an error which perl will ignore.
157 ## Unicode versions of the apis seem to work fine.
158 ## To experiment try Win32 _fullpath() and CreateHardLink with
160 print "ERROR : Skipping $real.\n";
165 if (-e $base_linked) {
166 if (! backup_and_copy_changed($real, $base_linked)) {
171 print "link $real $linked\n" if $verbose;
172 $status = link ($real, $base_linked);
174 ## Once again, this happens for long paths on Win2003
175 print "ERROR: Can't link $real\n";
178 chdir($starting_dir);
180 print "$symlink $real $linked\n" if $verbose;
181 $status = symlink ($real, $linked);
184 die "$0: $real -> $linked failed\n";
189 #### Process command line args.
191 while ($#ARGV >= 0 && $ARGV[0] =~ /^-/) {
192 if ($ARGV[0] eq '-v') {
194 } elsif ($ARGV[0] eq '-d') {
195 if ($ARGV[1] =~ /^\d+$/) {
196 $directory_mode = eval ($ARGV[1]); shift;
198 warn "$0: must provide argument for -d option\n";
201 } elsif ($ARGV[0] eq '-a' && ! ($^O eq 'MSWin32')) {
204 } elsif ($ARGV[0] =~ /-[?hH]$/) {
206 } elsif ($ARGV[0] eq '-nompc') {
209 warn "$0: unknown option $ARGV[0]\n";
219 $builds[0] = $ARGV[0];
220 $builds[0] =~ s%^build[/\\]%%; #### remove leading "build/", if any
221 $builds[0] = "build/$builds[0]";
223 @builds = glob "build/*";
226 sub create_build_regex {
227 if ($^O eq 'MSWin32') {
228 for ($idx = 0; $idx <= $#builds; $idx++) {
229 ## Get the original build name
230 $build_re[$idx] = $builds[idx];
232 ## Remove any trailing slashes
233 $build_re[$idx] =~ s/[\\\/]+$//;
235 ## Add a single trailing slash
236 $build_re[$idx] .= '/';
238 ## Escape any special characters
239 $build_re[$idx] =~ s/([\\\$\[\]\(\)\.])/\\$1/g;
244 create_build_regex();
246 # all builds go in ACE_wrappers\build
247 unless (-d "$starting_dir/build") {
248 print "Creating $starting_dir/build\n";
249 mkdir ("$starting_dir/build", $directory_mode);
251 foreach $build (@builds) {
252 unless (-d "$starting_dir/$build") {
253 print "Creating $starting_dir/$build\n";
254 mkpath ("$starting_dir/$build", 0, $directory_mode);
259 #### Get all ACE plain file and directory names.
264 my ($dev,$ino,$mode,$nlink,$uid,$gid);
267 /^CVS\z/s && ($File::Find::prune = 1)
269 /^build\z/s && ($File::Find::prune = 1)
271 /^\..*obj\z/s && ($File::Find::prune = 1)
273 /^Templates\.DB\z/s && ($File::Find::prune = 1)
275 /^Debug\z/s && ($File::Find::prune = 1)
277 /^Release\z/s && ($File::Find::prune = 1)
279 /^Static_Debug\z/s && ($File::Find::prune = 1)
281 /^Static_Release\z/s && ($File::Find::prune = 1)
283 /^\.svn\z/s && ($File::Find::prune = 1)
286 $matches = $matches &&
288 ($nlink || (($dev,$ino,$mode,$nlink,$uid,$gid) = lstat($_))) &&
303 if ($mpc && $matches) {
305 ($File::Find::dir =~ /include\/makeinclude*/) ||
308 ! /^.*\.vcproj\z/s &&
325 ! /^\.cvsignore\z/s &&
327 ! /^GNUmakefile.*\z/s
332 push(@files, $File::Find::name);
336 File::Find::find({wanted => \&wanted}, '.');
338 print "Found $#files files and directories.\n";
341 #### Create directories and symlinks to files.
343 foreach $file (@files) {
344 $file =~ s%^./%%g; #### excise leading ./ directory component
345 my($fullname) = "$starting_dir/$file";
346 for ($idx = 0; $idx <= $#builds; $idx++) {
347 my($build) = $builds[$idx];
349 unless (-d "$starting_dir/$build/$file") {
350 print "Creating $build/$file\n" if $verbose;
351 mkdir ("$starting_dir/$build/$file", $directory_mode);
354 unless (($^O ne 'MSWin32') && (-e "$build/$file")) {
357 while ($build =~ m%/%g) {
360 while ($file =~ m%/%g) {
363 cab_link("$up/$file", "$build/$file", $build_re[$idx]);
365 $path = $source . '/' . $file;
366 cab_link("$path", "$build/$file", $build_re[$idx]);
374 print "Finished creating and updating links.\n";
376 foreach $build (@builds) {
378 #### Find all the symlinks in the build directory, and remove ones
379 #### that are no longer actually linked to a file.
382 if ($^O eq 'MSWin32') {
383 my($lfh) = new FileHandle();
384 my($links_file) = "$starting_dir/$build/create_ace_build.links";
385 if (-e $links_file) {
386 if (open($lfh, $links_file)) {
390 if (-e "$starting_dir/$line") {
391 ## The links were already added in cab_link when they
392 ## were checked for changes.
394 print "Removing $build/$line \n" if $verbose;
395 unlink("$starting_dir/$build/$line") || warn "$0: unlink of $build/$line failed\n";
400 unless (unlink($links_file)) {
401 die "Couldn't delete links file.\n";
404 print "Writing $#nlinks links to link file.\n";
405 if (open($lfh, ">$links_file")) {
406 foreach my $lnk (@nlinks) {
411 die "Couldn't open links file.\n";
418 ## There's no way to know if we have hard linked back to a now
419 ## non-existent file. So, just do the normal -l on the file
420 ## which will cause no files to be pushed on Windows.
422 push(@lfiles, $File::Find::name);
426 File::Find::find({wanted => \&lcheck}, $build);
431 print "Removing $_ \n" if $verbose;
432 unlink $_ || warn "$0: unlink of $_ failed\n";
438 #### Done: print message.
440 print "\nCompleted creation of $build/.\n";
442 foreach $build (@builds) {
443 unless (-d "$starting_dir/$build") {
444 print "Creating $starting_dir/$build\n";
445 mkdir ("$starting_dir/$build", $directory_mode);
449 if (! -e "$starting_dir/$build/ace/config.h") {
450 print "Be sure to setup $build/ace/config.h";
453 if ($^O ne 'MSWin32' &&
454 ! -e "$starting_dir/$build/include/makeinclude/platform_macros.GNU") {
455 print " and\n$build/include/makeinclude/platform_macros.GNU";