• Home
  • Line#
  • Scopes#
  • Navigate#
  • Raw
  • Download
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