1# Copyright (C) 2007, 2008, 2009 Apple Inc. All rights reserved. 2# 3# Redistribution and use in source and binary forms, with or without 4# modification, are permitted provided that the following conditions 5# are met: 6# 7# 1. Redistributions of source code must retain the above copyright 8# notice, this list of conditions and the following disclaimer. 9# 2. Redistributions in binary form must reproduce the above copyright 10# notice, this list of conditions and the following disclaimer in the 11# documentation and/or other materials provided with the distribution. 12# 3. Neither the name of Apple Computer, Inc. ("Apple") nor the names of 13# its contributors may be used to endorse or promote products derived 14# from this software without specific prior written permission. 15# 16# THIS SOFTWARE IS PROVIDED BY APPLE AND ITS CONTRIBUTORS "AS IS" AND ANY 17# EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 18# WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 19# DISCLAIMED. IN NO EVENT SHALL APPLE OR ITS CONTRIBUTORS BE LIABLE FOR ANY 20# DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES 21# (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 22# LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND 23# ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 24# (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF 25# THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 26 27# Module to share code to work with various version control systems. 28 29use strict; 30use warnings; 31 32use Cwd qw(); # "qw()" prevents warnings about redefining getcwd() with "use POSIX;" 33use File::Basename; 34use File::Spec; 35 36BEGIN { 37 use Exporter (); 38 our ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS); 39 $VERSION = 1.00; 40 @ISA = qw(Exporter); 41 @EXPORT = qw(&chdirReturningRelativePath &determineSVNRoot &determineVCSRoot &isGit &isGitDirectory &isSVN &isSVNDirectory &makeFilePathRelative); 42 %EXPORT_TAGS = ( ); 43 @EXPORT_OK = (); 44} 45 46our @EXPORT_OK; 47 48my $isGit; 49my $isSVN; 50my $gitBranch; 51my $isGitBranchBuild; 52 53sub isGitDirectory($) 54{ 55 my ($dir) = @_; 56 return system("cd $dir && git rev-parse > /dev/null 2>&1") == 0; 57} 58 59sub isGit() 60{ 61 return $isGit if defined $isGit; 62 63 $isGit = isGitDirectory("."); 64 return $isGit; 65} 66 67sub gitBranch() 68{ 69 unless (defined $gitBranch) { 70 chomp($gitBranch = `git symbolic-ref -q HEAD`); 71 $gitBranch = "" if exitStatus($?); 72 $gitBranch =~ s#^refs/heads/##; 73 $gitBranch = "" if $gitBranch eq "master"; 74 } 75 76 return $gitBranch; 77} 78 79sub isGitBranchBuild() 80{ 81 my $branch = gitBranch(); 82 chomp(my $override = `git config --bool branch.$branch.webKitBranchBuild`); 83 return 1 if $override eq "true"; 84 return 0 if $override eq "false"; 85 86 unless (defined $isGitBranchBuild) { 87 chomp(my $gitBranchBuild = `git config --bool core.webKitBranchBuild`); 88 $isGitBranchBuild = $gitBranchBuild eq "true"; 89 } 90 91 return $isGitBranchBuild; 92} 93 94sub isSVNDirectory($) 95{ 96 my ($dir) = @_; 97 98 return -d File::Spec->catdir($dir, ".svn"); 99} 100 101sub isSVN() 102{ 103 return $isSVN if defined $isSVN; 104 105 $isSVN = isSVNDirectory("."); 106 return $isSVN; 107} 108 109sub chdirReturningRelativePath($) 110{ 111 my ($directory) = @_; 112 my $previousDirectory = Cwd::getcwd(); 113 chdir $directory; 114 my $newDirectory = Cwd::getcwd(); 115 return "." if $newDirectory eq $previousDirectory; 116 return File::Spec->abs2rel($previousDirectory, $newDirectory); 117} 118 119sub determineGitRoot() 120{ 121 chomp(my $gitDir = `git rev-parse --git-dir`); 122 return dirname($gitDir); 123} 124 125sub determineSVNRoot() 126{ 127 my $devNull = File::Spec->devnull(); 128 my $last = ''; 129 my $path = '.'; 130 my $parent = '..'; 131 my $repositoryUUID; 132 while (1) { 133 my $thisUUID; 134 # Ignore error messages in case we've run past the root of the checkout. 135 open INFO, "svn info '$path' 2> $devNull |" or die; 136 while (<INFO>) { 137 if (/^Repository UUID: (.+)/) { 138 $thisUUID = $1; 139 { local $/ = undef; <INFO>; } # Consume the rest of the input. 140 } 141 } 142 close INFO; 143 144 # It's possible (e.g. for developers of some ports) to have a WebKit 145 # checkout in a subdirectory of another checkout. So abort if the 146 # repository UUID suddenly changes. 147 last if !$thisUUID; 148 if (!$repositoryUUID) { 149 $repositoryUUID = $thisUUID; 150 } 151 last if $thisUUID ne $repositoryUUID; 152 153 $last = $path; 154 $path = File::Spec->catdir($parent, $path); 155 } 156 157 return File::Spec->rel2abs($last); 158} 159 160sub determineVCSRoot() 161{ 162 if (isGit()) { 163 return determineGitRoot(); 164 } 165 if (isSVN()) { 166 return determineSVNRoot(); 167 } 168 die "Unable to determine VCS root"; 169} 170 171sub svnRevisionForDirectory($) 172{ 173 my ($dir) = @_; 174 my $revision; 175 176 if (isSVNDirectory($dir)) { 177 my $svnInfo = `LC_ALL=C svn info $dir | grep Revision:`; 178 ($revision) = ($svnInfo =~ m/Revision: (\d+).*/g); 179 } elsif (isGitDirectory($dir)) { 180 my $gitLog = `cd $dir && LC_ALL=C git log --grep='git-svn-id: ' -n 1 | grep git-svn-id:`; 181 ($revision) = ($gitLog =~ m/ +git-svn-id: .+@(\d+) /g); 182 } 183 die "Unable to determine current SVN revision in $dir" unless (defined $revision); 184 return $revision; 185} 186 187sub pathRelativeToSVNRepositoryRootForPath($) 188{ 189 my ($file) = @_; 190 my $relativePath = File::Spec->abs2rel($file); 191 192 my $svnInfo; 193 if (isSVN()) { 194 $svnInfo = `LC_ALL=C svn info $relativePath`; 195 } elsif (isGit()) { 196 $svnInfo = `LC_ALL=C git svn info $relativePath`; 197 } 198 199 $svnInfo =~ /.*^URL: (.*?)$/m; 200 my $svnURL = $1; 201 202 $svnInfo =~ /.*^Repository Root: (.*?)$/m; 203 my $repositoryRoot = $1; 204 205 $svnURL =~ s/$repositoryRoot\///; 206 return $svnURL; 207} 208 209 210my $gitRoot; 211sub makeFilePathRelative($) 212{ 213 my ($path) = @_; 214 return $path unless isGit(); 215 216 unless (defined $gitRoot) { 217 chomp($gitRoot = `git rev-parse --show-cdup`); 218 } 219 return $gitRoot . $path; 220} 221 2221; 223