# Copyright (C) 2007, 2008, 2009 Apple Inc.  All rights reserved.

# Copyright (C) 2009, 2010 Chris Jerdonek (chris.jerdonek@gmail.com)

#

# 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.

package VCSUtils;

use strict;

use warnings;

use Cwd qw();  # "qw()" prevents warnings about redefining getcwd() with "use POSIX;"

use English; # for $POSTMATCH, etc.

use File::Basename;

use File::Spec;

use POSIX;

BEGIN {

    use Exporter   ();

    our ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS);

    $VERSION     = 1.00;

    @ISA         = qw(Exporter);

    @EXPORT      = qw(

        &callSilently

        &canonicalizePath

        &changeLogEmailAddress

        &changeLogName

        &chdirReturningRelativePath

        &decodeGitBinaryPatch

        &determineSVNRoot

        &determineVCSRoot

        &exitStatus

        &fixChangeLogPatch

        &gitBranch

        &gitdiff2svndiff

        &isGit

        &isGitBranchBuild

        &isGitDirectory

        &isSVN

        &isSVNDirectory

        &isSVNVersion16OrNewer

        &makeFilePathRelative

        &mergeChangeLogs

        &normalizePath

        &parsePatch

        &pathRelativeToSVNRepositoryRootForPath

        &prepareParsedPatch

        &runPatchCommand

        &scmToggleExecutableBit

        &setChangeLogDateAndReviewer

        &svnRevisionForDirectory

        &svnStatus

    );

    %EXPORT_TAGS = ( );

    @EXPORT_OK   = ();

}

our @EXPORT_OK;

my $gitBranch;

my $gitRoot;

my $isGit;

my $isGitBranchBuild;

my $isSVN;

my $svnVersion;

# Project time zone for Cupertino, CA, US

my $changeLogTimeZone = "PST8PDT";

my $gitDiffStartRegEx = qr#^diff --git (\w/)?(.+) (\w/)?([^\r\n]+)#;

my $svnDiffStartRegEx = qr#^Index: ([^\r\n]+)#;

my $svnPropertiesStartRegEx = qr#^Property changes on: ([^\r\n]+)#; # $1 is normally the same as the index path.

my $svnPropertyStartRegEx = qr#^(Modified|Name|Added|Deleted): ([^\r\n]+)#; # $2 is the name of the property.

my $svnPropertyValueStartRegEx = qr#^   (\+|-) ([^\r\n]+)#; # $2 is the start of the property's value (which may span multiple lines).

# This method is for portability. Return the system-appropriate exit

# status of a child process.

#

# Args: pass the child error status returned by the last pipe close,

#       for example "$?".

sub exitStatus($)

{

    my ($returnvalue) = @_;

    if ($^O eq "MSWin32") {

        return $returnvalue >> 8;

    }

    return WEXITSTATUS($returnvalue);

}

# Call a function while suppressing STDERR, and return the return values

# as an array.

sub callSilently($@) {

    my ($func, @args) = @_;

    # The following pattern was taken from here:

    #   http://www.sdsc.edu/~moreland/courses/IntroPerl/docs/manual/pod/perlfunc/open.html

    #

    # Also see this Perl documentation (search for "open OLDERR"):

    #   http://perldoc.perl.org/functions/open.html

    open(OLDERR, ">&STDERR");

    close(STDERR);

    my @returnValue = &$func(@args);

    open(STDERR, ">&OLDERR");

    close(OLDERR);

    return @returnValue;

}

# Note, this method will not error if the file corresponding to the path does not exist.

sub scmToggleExecutableBit

{

    my ($path, $executableBitDelta) = @_;

    return if ! -e $path;

    if ($executableBitDelta == 1) {

        scmAddExecutableBit($path);

    } elsif ($executableBitDelta == -1) {

        scmRemoveExecutableBit($path);

    }

}

sub scmAddExecutableBit($)

{

    my ($path) = @_;

    if (isSVN()) {

        system("svn", "propset", "svn:executable", "on", $path) == 0 or die "Failed to run 'svn propset svn:executable on $path'.";

    } elsif (isGit()) {

        chmod(0755, $path);

    }

}

sub scmRemoveExecutableBit($)

{

    my ($path) = @_;

    if (isSVN()) {

        system("svn", "propdel", "svn:executable", $path) == 0 or die "Failed to run 'svn propdel svn:executable $path'.";

    } elsif (isGit()) {

        chmod(0664, $path);

    }

}

sub isGitDirectory($)

{

    my ($dir) = @_;

    return system("cd $dir && git rev-parse > " . File::Spec->devnull() . " 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 svnVersion()

{

    return $svnVersion if defined $svnVersion;

    if (!isSVN()) {

        $svnVersion = 0;

    } else {

        chomp($svnVersion = `svn --version --quiet`);

    }

    return $svnVersion;

}

sub isSVNVersion16OrNewer()

{

    my $version = svnVersion();

    return eval "v$version" ge v1.6;

}

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 $last = '';

    my $path = '.';

    my $parent = '..';

    my $repositoryRoot;

    my $repositoryUUID;

    while (1) {

        my $thisRoot;

        my $thisUUID;

        # Ignore error messages in case we've run past the root of the checkout.

        open INFO, "svn info '$path' 2> " . File::Spec->devnull() . " |" or die;

        while (<INFO>) {

            if (/^Repository Root: (.+)/) {

                $thisRoot = $1;

            }

            if (/^Repository UUID: (.+)/) {

                $thisUUID = $1;

            }

            if ($thisRoot && $thisUUID) {

                local $/ = undef;

                <INFO>; # 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 root or the repository UUID suddenly changes.

        last if !$thisUUID;

        $repositoryUUID = $thisUUID if !$repositoryUUID;

        last if $thisUUID ne $repositoryUUID;

        last if !$thisRoot;

        $repositoryRoot = $thisRoot if !$repositoryRoot;

        last if $thisRoot ne $repositoryRoot;

        $last = $path;

        $path = File::Spec->catdir($parent, $path);

    }

    return File::Spec->rel2abs($last);

}

sub determineVCSRoot()

{

    if (isGit()) {

        return determineGitRoot();

    }

    if (!isSVN()) {

        # Some users have a workflow where svn-create-patch, svn-apply and

        # svn-unapply are used outside of multiple svn working directores,

        # so warn the user and assume Subversion is being used in this case.

        warn "Unable to determine VCS root; assuming Subversion";

        $isSVN = 1;

    }

    return determineSVNRoot();

}

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;

}

sub makeFilePathRelative($)

{

    my ($path) = @_;

    return $path unless isGit();

    unless (defined $gitRoot) {

        chomp($gitRoot = `git rev-parse --show-cdup`);

    }

    return $gitRoot . $path;

}

sub normalizePath($)

{

    my ($path) = @_;

    $path =~ s/\\/\//g;

    return $path;

}

sub canonicalizePath($)

{

    my ($file) = @_;

    # Remove extra slashes and '.' directories in path

    $file = File::Spec->canonpath($file);

    # Remove '..' directories in path

    my @dirs = ();

    foreach my $dir (File::Spec->splitdir($file)) {

        if ($dir eq '..' && $#dirs >= 0 && $dirs[$#dirs] ne '..') {

            pop(@dirs);

        } else {

            push(@dirs, $dir);

        }

    }

    return ($#dirs >= 0) ? File::Spec->catdir(@dirs) : ".";

}

sub removeEOL($)

{

    my ($line) = @_;

    $line =~ s/[\r\n]+$//g;

    return $line;

}

sub svnStatus($)

{

    my ($fullPath) = @_;

    my $svnStatus;

    open SVN, "svn status --non-interactive --non-recursive '$fullPath' |" or die;

    if (-d $fullPath) {

        # When running "svn stat" on a directory, we can't assume that only one

        # status will be returned (since any files with a status below the

        # directory will be returned), and we can't assume that the directory will

        # be first (since any files with unknown status will be listed first).

        my $normalizedFullPath = File::Spec->catdir(File::Spec->splitdir($fullPath));

        while (<SVN>) {

            # Input may use a different EOL sequence than $/, so avoid chomp.

            $_ = removeEOL($_);

            my $normalizedStatPath = File::Spec->catdir(File::Spec->splitdir(substr($_, 7)));

            if ($normalizedFullPath eq $normalizedStatPath) {

                $svnStatus = "$_\n";

                last;

            }

        }

        # Read the rest of the svn command output to avoid a broken pipe warning.

        local $/ = undef;

        <SVN>;

    }

    else {

        # Files will have only one status returned.

        $svnStatus = removeEOL(<SVN>) . "\n";

    }

    close SVN;

    return $svnStatus;

}

# Return whether the given file mode is executable in the source control

# sense.  We make this determination based on whether the executable bit

# is set for "others" rather than the stronger condition that it be set

# for the user, group, and others.  This is sufficient for distinguishing

# the default behavior in Git and SVN.

#

# Args:

#   $fileMode: A number or string representing a file mode in octal notation.

sub isExecutable($)

{

    my $fileMode = shift;

    return $fileMode % 2;

}

# Parse the next Git diff header from the given file handle, and advance

# the handle so the last line read is the first line after the header.

#

# This subroutine dies if given leading junk.

#

# Args:

#   $fileHandle: advanced so the last line read from the handle is the first

#                line of the header to parse.  This should be a line

#                beginning with "diff --git".

#   $line: the line last read from $fileHandle

#

# Returns ($headerHashRef, $lastReadLine):

#   $headerHashRef: a hash reference representing a diff header, as follows--

#     copiedFromPath: the path from which the file was copied or moved if

#                     the diff is a copy or move.

#     executableBitDelta: the value 1 or -1 if the executable bit was added or

#                         removed, respectively.  New and deleted files have

#                         this value only if the file is executable, in which

#                         case the value is 1 and -1, respectively.

#     indexPath: the path of the target file.

#     isBinary: the value 1 if the diff is for a binary file.

#     isDeletion: the value 1 if the diff is a file deletion.

#     isCopyWithChanges: the value 1 if the file was copied or moved and

#                        the target file was changed in some way after being

#                        copied or moved (e.g. if its contents or executable

#                        bit were changed).

#     isNew: the value 1 if the diff is for a new file.

#     shouldDeleteSource: the value 1 if the file was copied or moved and

#                         the source file was deleted -- i.e. if the copy

#                         was actually a move.

#     svnConvertedText: the header text with some lines converted to SVN

#                       format.  Git-specific lines are preserved.

#   $lastReadLine: the line last read from $fileHandle.

sub parseGitDiffHeader($$)

{

    my ($fileHandle, $line) = @_;

    $_ = $line;

    my $indexPath;

    if (/$gitDiffStartRegEx/) {

        # The first and second paths can differ in the case of copies

        # and renames.  We use the second file path because it is the

        # destination path.

        $indexPath = $4;

        # Use $POSTMATCH to preserve the end-of-line character.

        $_ = "Index: $indexPath$POSTMATCH"; # Convert to SVN format.

    } else {

        die("Could not parse leading \"diff --git\" line: \"$line\".");

    }

    my $copiedFromPath;

    my $foundHeaderEnding;

    my $isBinary;

    my $isDeletion;

    my $isNew;

    my $newExecutableBit = 0;

    my $oldExecutableBit = 0;

    my $shouldDeleteSource = 0;

    my $similarityIndex = 0;

    my $svnConvertedText;

    while (1) {

        # Temporarily strip off any end-of-line characters to simplify

        # regex matching below.

        s/([\n\r]+)$//;

        my $eol = $1;

        if (/^(deleted file|old) mode (\d+)/) {

            $oldExecutableBit = (isExecutable($2) ? 1 : 0);

            $isDeletion = 1 if $1 eq "deleted file";

        } elsif (/^new( file)? mode (\d+)/) {

            $newExecutableBit = (isExecutable($2) ? 1 : 0);

            $isNew = 1 if $1;

        } elsif (/^similarity index (\d+)%/) {

            $similarityIndex = $1;

        } elsif (/^copy from (\S+)/) {

            $copiedFromPath = $1;

        } elsif (/^rename from (\S+)/) {

            # FIXME: Record this as a move rather than as a copy-and-delete.

            #        This will simplify adding rename support to svn-unapply.

            #        Otherwise, the hash for a deletion would have to know

            #        everything about the file being deleted in order to

            #        support undoing itself.  Recording as a move will also