diff options
author | michel_j <michel_j@ae88bc3d-4319-0410-8dbf-d08b4c9d3795> | 2003-08-30 17:15:23 +0000 |
---|---|---|
committer | michel_j <michel_j@ae88bc3d-4319-0410-8dbf-d08b4c9d3795> | 2003-08-30 17:15:23 +0000 |
commit | ea9284eadb1113437d8413145e9efde3752d8285 (patch) | |
tree | 521ec755df4c4cf518a04e1b479cccedae67c5ac /bin/create_ace_build.pl | |
parent | 8cd81738fc9a2043460ac772657103ede42cf65a (diff) | |
download | ATCD-ea9284eadb1113437d8413145e9efde3752d8285.tar.gz |
Sat Aug 30 12:10:00 2003 Justin Michel <michel_j@ociweb.com>
Diffstat (limited to 'bin/create_ace_build.pl')
-rwxr-xr-x | bin/create_ace_build.pl | 27 |
1 files changed, 23 insertions, 4 deletions
diff --git a/bin/create_ace_build.pl b/bin/create_ace_build.pl index 5d033fc87c2..199f3242ad1 100755 --- a/bin/create_ace_build.pl +++ b/bin/create_ace_build.pl @@ -36,6 +36,8 @@ use File::Find (); use File::Basename; use FileHandle; use File::stat; +use File::Copy; + $usage = "usage: $0 -? | [-a] [-d <directory mode>] [-v] [-nompc] <build name>\n"; $directory_mode = 0777; #### Will be modified by umask, also. @@ -85,10 +87,8 @@ print "Creating or updating builds in $starting_dir\n"; sub backup_and_copy_changed { my($real, $linked) = @_; + my($status_real) = stat($real); - if (! $status_real) { - die "ERROR: is_changed() real $real not exist.\n"; - } my($status_linked) = stat($linked); if ($status_linked->mtime > $status_real->mtime) { @@ -107,7 +107,7 @@ sub backup_and_copy_changed { } return 0; } - + sub cab_link { my($real,$linked,$build_regex) = @_; @@ -118,6 +118,9 @@ sub cab_link { push(@nlinks, $fixed); my($curdir) = "$starting_dir/" . dirname($linked); + if (! -d $curdir) { + die "ERROR: Dir not found: $curdir\n"; + } $status = chdir($curdir); if (! $status) { die "ERROR: cab_link() chdir " . $curdir . " failed.\n"; @@ -125,6 +128,17 @@ sub cab_link { my($base_linked) = basename($linked); + if (! -e $real) { + ## This should never happen, but there appears to be a bug + ## with the underlying win32 apis on Windows Server 2003. + ## Long paths will cause an error which perl will ignore. + ## Unicode versions of the apis seem to work fine. + ## To experiment try Win32 _fullpath() and CreateHardLink with + ## long paths. + print "ERROR : Skipping $real.\n"; + return; + } + if (-e $base_linked) { if (! backup_and_copy_changed($real, $base_linked)) { return; @@ -133,6 +147,11 @@ sub cab_link { print "link $real $linked\n" if $verbose; $status = link ($real, $base_linked); + if (! $status) { + ## Once again, this happens for long paths on Win2003 + print "ERROR: Can't link $real\n"; + return; + } chdir($starting_dir); } else { print "$symlink $real $linked\n" if $verbose; |