# Copyright (C) 2007, 2008, 2009 Apple Inc. All rights reserved. # # Redistribution and use in source and binary forms, with or without # modification, are permitted provided that the following conditions # are met: # # 1. Redistributions of source code must retain the above copyright # notice, this list of conditions and the following disclaimer. # 2. Redistributions in binary form must reproduce the above copyright # notice, this list of conditions and the following disclaimer in the # documentation and/or other materials provided with the distribution. # 3. Neither the name of Apple Computer, Inc. ("Apple") nor the names of # its contributors may be used to endorse or promote products derived # from this software without specific prior written permission. # # THIS SOFTWARE IS PROVIDED BY APPLE AND ITS CONTRIBUTORS "AS IS" AND ANY # EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED # WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE # DISCLAIMED. IN NO EVENT SHALL APPLE OR ITS CONTRIBUTORS BE LIABLE FOR ANY # DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES # (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; # LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND # ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT # (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF # THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. # Module to share code to work with various version control systems. use strict; use warnings; use Cwd qw(); # "qw()" prevents warnings about redefining getcwd() with "use POSIX;" use File::Basename; use File::Spec; BEGIN { use Exporter (); our ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS); $VERSION = 1.00; @ISA = qw(Exporter); @EXPORT = qw(&chdirReturningRelativePath &determineSVNRoot &determineVCSRoot &isGit &isGitDirectory &isSVN &isSVNDirectory &makeFilePathRelative); %EXPORT_TAGS = ( ); @EXPORT_OK = (); } our @EXPORT_OK; my $isGit; my $isSVN; my $gitBranch; my $isGitBranchBuild; sub isGitDirectory($) { my ($dir) = @_; return system("cd $dir && git rev-parse > /dev/null 2>&1") == 0; } sub isGit() { return $isGit if defined $isGit; $isGit = isGitDirectory("."); return $isGit; } sub gitBranch() { unless (defined $gitBranch) { chomp($gitBranch = `git symbolic-ref -q HEAD`); $gitBranch = "" if exitStatus($?); $gitBranch =~ s#^refs/heads/##; $gitBranch = "" if $gitBranch eq "master"; } return $gitBranch; } sub isGitBranchBuild() { my $branch = gitBranch(); chomp(my $override = `git config --bool branch.$branch.webKitBranchBuild`); return 1 if $override eq "true"; return 0 if $override eq "false"; unless (defined $isGitBranchBuild) { chomp(my $gitBranchBuild = `git config --bool core.webKitBranchBuild`); $isGitBranchBuild = $gitBranchBuild eq "true"; } return $isGitBranchBuild; } sub isSVNDirectory($) { my ($dir) = @_; return -d File::Spec->catdir($dir, ".svn"); } sub isSVN() { return $isSVN if defined $isSVN; $isSVN = isSVNDirectory("."); return $isSVN; } sub chdirReturningRelativePath($) { my ($directory) = @_; my $previousDirectory = Cwd::getcwd(); chdir $directory; my $newDirectory = Cwd::getcwd(); return "." if $newDirectory eq $previousDirectory; return File::Spec->abs2rel($previousDirectory, $newDirectory); } sub determineGitRoot() { chomp(my $gitDir = `git rev-parse --git-dir`); return dirname($gitDir); } sub determineSVNRoot() { my $devNull = File::Spec->devnull(); my $last = ''; my $path = '.'; my $parent = '..'; my $repositoryUUID; while (1) { my $thisUUID; # Ignore error messages in case we've run past the root of the checkout. open INFO, "svn info '$path' 2> $devNull |" or die; while () { if (/^Repository UUID: (.+)/) { $thisUUID = $1; { local $/ = undef; ; } # Consume the rest of the input. } } close INFO; # It's possible (e.g. for developers of some ports) to have a WebKit # checkout in a subdirectory of another checkout. So abort if the # repository UUID suddenly changes. last if !$thisUUID; if (!$repositoryUUID) { $repositoryUUID = $thisUUID; } last if $thisUUID ne $repositoryUUID; $last = $path; $path = File::Spec->catdir($parent, $path); } return File::Spec->rel2abs($last); } sub determineVCSRoot() { if (isGit()) { return determineGitRoot(); } if (isSVN()) { return determineSVNRoot(); } die "Unable to determine VCS root"; } sub svnRevisionForDirectory($) { my ($dir) = @_; my $revision; if (isSVNDirectory($dir)) { my $svnInfo = `LC_ALL=C svn info $dir | grep Revision:`; ($revision) = ($svnInfo =~ m/Revision: (\d+).*/g); } elsif (isGitDirectory($dir)) { my $gitLog = `cd $dir && LC_ALL=C git log --grep='git-svn-id: ' -n 1 | grep git-svn-id:`; ($revision) = ($gitLog =~ m/ +git-svn-id: .+@(\d+) /g); } die "Unable to determine current SVN revision in $dir" unless (defined $revision); return $revision; } sub pathRelativeToSVNRepositoryRootForPath($) { my ($file) = @_; my $relativePath = File::Spec->abs2rel($file); my $svnInfo; if (isSVN()) { $svnInfo = `LC_ALL=C svn info $relativePath`; } elsif (isGit()) { $svnInfo = `LC_ALL=C git svn info $relativePath`; } $svnInfo =~ /.*^URL: (.*?)$/m; my $svnURL = $1; $svnInfo =~ /.*^Repository Root: (.*?)$/m; my $repositoryRoot = $1; $svnURL =~ s/$repositoryRoot\///; return $svnURL; } my $gitRoot; sub makeFilePathRelative($) { my ($path) = @_; return $path unless isGit(); unless (defined $gitRoot) { chomp($gitRoot = `git rev-parse --show-cdup`); } return $gitRoot . $path; } 1;