--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/WebKitTools/Scripts/VCSUtils.pm Fri Sep 17 09:02:29 2010 +0300
@@ -0,0 +1,1720 @@
+# 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
+ # permit us to use "svn move" and "git move".
+ $copiedFromPath = $1;
+ $shouldDeleteSource = 1;
+ } elsif (/^--- \S+/) {
+ $_ = "--- $indexPath"; # Convert to SVN format.
+ } elsif (/^\+\+\+ \S+/) {
+ $_ = "+++ $indexPath"; # Convert to SVN format.
+ $foundHeaderEnding = 1;
+ } elsif (/^GIT binary patch$/ ) {
+ $isBinary = 1;
+ $foundHeaderEnding = 1;
+ # The "git diff" command includes a line of the form "Binary files
+ # <path1> and <path2> differ" if the --binary flag is not used.
+ } elsif (/^Binary files / ) {
+ die("Error: the Git diff contains a binary file without the binary data in ".
+ "line: \"$_\". Be sure to use the --binary flag when invoking \"git diff\" ".
+ "with diffs containing binary files.");
+ }
+
+ $svnConvertedText .= "$_$eol"; # Also restore end-of-line characters.
+
+ $_ = <$fileHandle>; # Not defined if end-of-file reached.
+
+ last if (!defined($_) || /$gitDiffStartRegEx/ || $foundHeaderEnding);
+ }
+
+ my $executableBitDelta = $newExecutableBit - $oldExecutableBit;
+
+ my %header;
+
+ $header{copiedFromPath} = $copiedFromPath if $copiedFromPath;
+ $header{executableBitDelta} = $executableBitDelta if $executableBitDelta;
+ $header{indexPath} = $indexPath;
+ $header{isBinary} = $isBinary if $isBinary;
+ $header{isCopyWithChanges} = 1 if ($copiedFromPath && ($similarityIndex != 100 || $executableBitDelta));
+ $header{isDeletion} = $isDeletion if $isDeletion;
+ $header{isNew} = $isNew if $isNew;
+ $header{shouldDeleteSource} = $shouldDeleteSource if $shouldDeleteSource;
+ $header{svnConvertedText} = $svnConvertedText;
+
+ return (\%header, $_);
+}
+
+# Parse the next SVN 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 or if it could not detect
+# the end of the header block.
+#
+# 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 "Index:".
+# $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 if the diff
+# is a copy.
+# indexPath: the path of the target file, which is the path found in
+# the "Index:" line.
+# isBinary: the value 1 if the diff is for a binary file.
+# isNew: the value 1 if the diff is for a new file.
+# sourceRevision: the revision number of the source, if it exists. This
+# is the same as the revision number the file was copied
+# from, in the case of a file copy.
+# svnConvertedText: the header text converted to a header with the paths
+# in some lines corrected.
+# $lastReadLine: the line last read from $fileHandle.
+sub parseSvnDiffHeader($$)
+{
+ my ($fileHandle, $line) = @_;
+
+ $_ = $line;
+
+ my $indexPath;
+ if (/$svnDiffStartRegEx/) {
+ $indexPath = $1;
+ } else {
+ die("First line of SVN diff does not begin with \"Index \": \"$_\"");
+ }
+
+ my $copiedFromPath;
+ my $foundHeaderEnding;
+ my $isBinary;
+ my $isNew;
+ my $sourceRevision;
+ my $svnConvertedText;
+ while (1) {
+ # Temporarily strip off any end-of-line characters to simplify
+ # regex matching below.
+ s/([\n\r]+)$//;
+ my $eol = $1;
+
+ # Fix paths on ""---" and "+++" lines to match the leading
+ # index line.
+ if (s/^--- \S+/--- $indexPath/) {
+ # ---
+ if (/^--- .+\(revision (\d+)\)/) {
+ $sourceRevision = $1;
+ $isNew = 1 if !$sourceRevision; # if revision 0.
+ if (/\(from (\S+):(\d+)\)$/) {
+ # The "from" clause is created by svn-create-patch, in
+ # which case there is always also a "revision" clause.
+ $copiedFromPath = $1;
+ die("Revision number \"$2\" in \"from\" clause does not match " .
+ "source revision number \"$sourceRevision\".") if ($2 != $sourceRevision);
+ }
+ }
+ } elsif (s/^\+\+\+ \S+/+++ $indexPath/) {
+ $foundHeaderEnding = 1;
+ } elsif (/^Cannot display: file marked as a binary type.$/) {
+ $isBinary = 1;
+ $foundHeaderEnding = 1;
+ }
+
+ $svnConvertedText .= "$_$eol"; # Also restore end-of-line characters.
+
+ $_ = <$fileHandle>; # Not defined if end-of-file reached.
+
+ last if (!defined($_) || /$svnDiffStartRegEx/ || $foundHeaderEnding);
+ }
+
+ if (!$foundHeaderEnding) {
+ die("Did not find end of header block corresponding to index path \"$indexPath\".");
+ }
+
+ my %header;
+
+ $header{copiedFromPath} = $copiedFromPath if $copiedFromPath;
+ $header{indexPath} = $indexPath;
+ $header{isBinary} = $isBinary if $isBinary;
+ $header{isNew} = $isNew if $isNew;
+ $header{sourceRevision} = $sourceRevision if $sourceRevision;
+ $header{svnConvertedText} = $svnConvertedText;
+
+ return (\%header, $_);
+}
+
+# Parse the next 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 or if it could not detect
+# the end of the header block.
+#
+# Args:
+# $fileHandle: advanced so the last line read from the handle is the first
+# line of the header to parse. For SVN-formatted diffs, this
+# is a line beginning with "Index:". For Git, this is a line
+# beginning with "diff --git".
+# $line: the line last read from $fileHandle
+#
+# Returns ($headerHashRef, $lastReadLine):
+# $headerHashRef: a hash reference representing a diff header
+# copiedFromPath: the path from which the file was copied if the diff
+# is a copy.
+# 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.
+# isGit: the value 1 if the diff is Git-formatted.
+# isSvn: the value 1 if the diff is SVN-formatted.
+# sourceRevision: the revision number of the source, if it exists. This
+# is the same as the revision number the file was copied
+# from, in the case of a file copy.
+# svnConvertedText: the header text with some lines converted to SVN
+# format. Git-specific lines are preserved.
+# $lastReadLine: the line last read from $fileHandle.
+sub parseDiffHeader($$)
+{
+ my ($fileHandle, $line) = @_;
+
+ my $header; # This is a hash ref.
+ my $isGit;
+ my $isSvn;
+ my $lastReadLine;
+
+ if ($line =~ $svnDiffStartRegEx) {
+ $isSvn = 1;
+ ($header, $lastReadLine) = parseSvnDiffHeader($fileHandle, $line);
+ } elsif ($line =~ $gitDiffStartRegEx) {
+ $isGit = 1;
+ ($header, $lastReadLine) = parseGitDiffHeader($fileHandle, $line);
+ } else {
+ die("First line of diff does not begin with \"Index:\" or \"diff --git\": \"$line\"");
+ }
+
+ $header->{isGit} = $isGit if $isGit;
+ $header->{isSvn} = $isSvn if $isSvn;
+
+ return ($header, $lastReadLine);
+}
+
+# FIXME: The %diffHash "object" should not have an svnConvertedText property.
+# Instead, the hash object should store its information in a
+# structured way as properties. This should be done in a way so
+# that, if necessary, the text of an SVN or Git patch can be
+# reconstructed from the information in those hash properties.
+#
+# A %diffHash is a hash representing a source control diff of a single
+# file operation (e.g. a file modification, copy, or delete).
+#
+# These hashes appear, for example, in the parseDiff(), parsePatch(),
+# and prepareParsedPatch() subroutines of this package.
+#
+# The corresponding values are--
+#
+# copiedFromPath: the path from which the file was copied if the diff
+# is a copy.
+# executableBitDelta: the value 1 or -1 if the executable bit was added or
+# removed from the target file, respectively.
+# indexPath: the path of the target file. For SVN-formatted diffs,
+# this is the same as the path in the "Index:" line.
+# isBinary: the value 1 if the diff is for a binary file.
+# isDeletion: the value 1 if the diff is known from the header to be a deletion.
+# isGit: the value 1 if the diff is Git-formatted.
+# isNew: the value 1 if the dif is known from the header to be a new file.
+# isSvn: the value 1 if the diff is SVN-formatted.
+# sourceRevision: the revision number of the source, if it exists. This
+# is the same as the revision number the file was copied
+# from, in the case of a file copy.
+# svnConvertedText: the diff with some lines converted to SVN format.
+# Git-specific lines are preserved.
+
+# Parse one diff from a patch file created by svn-create-patch, and
+# advance the file handle so the last line read is the first line
+# of the next header block.
+#
+# This subroutine preserves any leading junk encountered before the header.
+#
+# Composition of an SVN diff
+#
+# There are three parts to an SVN diff: the header, the property change, and
+# the binary contents, in that order. Either the header or the property change
+# may be ommitted, but not both. If there are binary changes, then you always
+# have all three.
+#
+# Args:
+# $fileHandle: a file handle advanced to the first line of the next
+# header block. Leading junk is okay.
+# $line: the line last read from $fileHandle.
+#
+# Returns ($diffHashRefs, $lastReadLine):
+# $diffHashRefs: A reference to an array of references to %diffHash hashes.
+# See the %diffHash documentation above.
+# $lastReadLine: the line last read from $fileHandle
+sub parseDiff($$)
+{
+ # FIXME: Adjust this method so that it dies if the first line does not
+ # match the start of a diff. This will require a change to
+ # parsePatch() so that parsePatch() skips over leading junk.
+ my ($fileHandle, $line) = @_;
+
+ my $headerStartRegEx = $svnDiffStartRegEx; # SVN-style header for the default
+
+ my $headerHashRef; # Last header found, as returned by parseDiffHeader().
+ my $svnPropertiesHashRef; # Last SVN properties diff found, as returned by parseSvnDiffProperties().
+ my $svnText;
+ while (defined($line)) {
+ if (!$headerHashRef && ($line =~ $gitDiffStartRegEx)) {
+ # Then assume all diffs in the patch are Git-formatted. This
+ # block was made to be enterable at most once since we assume
+ # all diffs in the patch are formatted the same (SVN or Git).
+ $headerStartRegEx = $gitDiffStartRegEx;
+ }
+
+ if ($line =~ $svnPropertiesStartRegEx) {
+ my $propertyPath = $1;
+ if ($svnPropertiesHashRef || $headerHashRef && ($propertyPath ne $headerHashRef->{indexPath})) {
+ # This is the start of the second diff in the while loop, which happens to
+ # be a property diff. If $svnPropertiesHasRef is defined, then this is the
+ # second consecutive property diff, otherwise it's the start of a property
+ # diff for a file that only has property changes.
+ last;
+ }
+ ($svnPropertiesHashRef, $line) = parseSvnDiffProperties($fileHandle, $line);
+ next;
+ }
+ if ($line !~ $headerStartRegEx) {
+ # Then we are in the body of the diff.
+ $svnText .= $line;
+ $line = <$fileHandle>;
+ next;
+ } # Otherwise, we found a diff header.
+
+ if ($svnPropertiesHashRef || $headerHashRef) {
+ # Then either we just processed an SVN property change or this
+ # is the start of the second diff header of this while loop.
+ last;
+ }
+
+ ($headerHashRef, $line) = parseDiffHeader($fileHandle, $line);
+
+ $svnText .= $headerHashRef->{svnConvertedText};
+ }
+
+ my @diffHashRefs;
+
+ if ($headerHashRef->{shouldDeleteSource}) {
+ my %deletionHash;
+ $deletionHash{indexPath} = $headerHashRef->{copiedFromPath};
+ $deletionHash{isDeletion} = 1;
+ push @diffHashRefs, \%deletionHash;
+ }
+ if ($headerHashRef->{copiedFromPath}) {
+ my %copyHash;
+ $copyHash{copiedFromPath} = $headerHashRef->{copiedFromPath};
+ $copyHash{indexPath} = $headerHashRef->{indexPath};
+ $copyHash{sourceRevision} = $headerHashRef->{sourceRevision} if $headerHashRef->{sourceRevision};
+ if ($headerHashRef->{isSvn}) {
+ $copyHash{executableBitDelta} = $svnPropertiesHashRef->{executableBitDelta} if $svnPropertiesHashRef->{executableBitDelta};
+ }
+ push @diffHashRefs, \%copyHash;
+ }
+
+ # Note, the order of evaluation for the following if conditional has been explicitly chosen so that
+ # it evaluates to false when there is no headerHashRef (e.g. a property change diff for a file that
+ # only has property changes).
+ if ($headerHashRef->{isCopyWithChanges} || (%$headerHashRef && !$headerHashRef->{copiedFromPath})) {
+ # Then add the usual file modification.
+ my %diffHash;
+ # FIXME: We should expand this code to support other properties. In the future,
+ # parseSvnDiffProperties may return a hash whose keys are the properties.
+ if ($headerHashRef->{isSvn}) {
+ # SVN records the change to the executable bit in a separate property change diff
+ # that follows the contents of the diff, except for binary diffs. For binary
+ # diffs, the property change diff follows the diff header.
+ $diffHash{executableBitDelta} = $svnPropertiesHashRef->{executableBitDelta} if $svnPropertiesHashRef->{executableBitDelta};
+ } elsif ($headerHashRef->{isGit}) {
+ # Git records the change to the executable bit in the header of a diff.
+ $diffHash{executableBitDelta} = $headerHashRef->{executableBitDelta} if $headerHashRef->{executableBitDelta};
+ }
+ $diffHash{indexPath} = $headerHashRef->{indexPath};
+ $diffHash{isBinary} = $headerHashRef->{isBinary} if $headerHashRef->{isBinary};
+ $diffHash{isDeletion} = $headerHashRef->{isDeletion} if $headerHashRef->{isDeletion};
+ $diffHash{isGit} = $headerHashRef->{isGit} if $headerHashRef->{isGit};
+ $diffHash{isNew} = $headerHashRef->{isNew} if $headerHashRef->{isNew};
+ $diffHash{isSvn} = $headerHashRef->{isSvn} if $headerHashRef->{isSvn};
+ if (!$headerHashRef->{copiedFromPath}) {
+ # If the file was copied, then we have already incorporated the
+ # sourceRevision information into the change.
+ $diffHash{sourceRevision} = $headerHashRef->{sourceRevision} if $headerHashRef->{sourceRevision};
+ }
+ # FIXME: Remove the need for svnConvertedText. See the %diffHash
+ # code comments above for more information.
+ #
+ # Note, we may not always have SVN converted text since we intend
+ # to deprecate it in the future. For example, a property change
+ # diff for a file that only has property changes will not return
+ # any SVN converted text.
+ $diffHash{svnConvertedText} = $svnText if $svnText;
+ push @diffHashRefs, \%diffHash;
+ }
+
+ if (!%$headerHashRef && $svnPropertiesHashRef) {
+ # A property change diff for a file that only has property changes.
+ my %propertyChangeHash;
+ $propertyChangeHash{executableBitDelta} = $svnPropertiesHashRef->{executableBitDelta} if $svnPropertiesHashRef->{executableBitDelta};
+ $propertyChangeHash{indexPath} = $svnPropertiesHashRef->{propertyPath};
+ $propertyChangeHash{isSvn} = 1;
+ push @diffHashRefs, \%propertyChangeHash;
+ }
+
+ return (\@diffHashRefs, $line);
+}
+
+# Parse an SVN property change diff from the given file handle, and advance
+# the handle so the last line read is the first line after this diff.
+#
+# For the case of an SVN binary diff, the binary contents will follow the
+# the property changes.
+#
+# This subroutine dies if the first line does not begin with "Property changes on"
+# or if the separator line that follows this line is missing.
+#
+# Args:
+# $fileHandle: advanced so the last line read from the handle is the first
+# line of the footer to parse. This line begins with
+# "Property changes on".
+# $line: the line last read from $fileHandle.
+#
+# Returns ($propertyHashRef, $lastReadLine):
+# $propertyHashRef: a hash reference representing an SVN diff footer.
+# propertyPath: the path of the target file.
+# executableBitDelta: the value 1 or -1 if the executable bit was added or
+# removed from the target file, respectively.
+# $lastReadLine: the line last read from $fileHandle.
+sub parseSvnDiffProperties($$)
+{
+ my ($fileHandle, $line) = @_;
+
+ $_ = $line;
+
+ my %footer;
+ if (/$svnPropertiesStartRegEx/) {
+ $footer{propertyPath} = $1;
+ } else {
+ die("Failed to find start of SVN property change, \"Property changes on \": \"$_\"");
+ }
+
+ # We advance $fileHandle two lines so that the next line that
+ # we process is $svnPropertyStartRegEx in a well-formed footer.
+ # A well-formed footer has the form:
+ # Property changes on: FileA
+ # ___________________________________________________________________
+ # Added: svn:executable
+ # + *
+ $_ = <$fileHandle>; # Not defined if end-of-file reached.
+ my $separator = "_" x 67;
+ if (defined($_) && /^$separator[\r\n]+$/) {
+ $_ = <$fileHandle>;
+ } else {
+ die("Failed to find separator line: \"$_\".");
+ }
+
+ # FIXME: We should expand this to support other SVN properties
+ # (e.g. return a hash of property key-values that represents
+ # all properties).
+ #
+ # Notice, we keep processing until we hit end-of-file or some
+ # line that does not resemble $svnPropertyStartRegEx, such as
+ # the empty line that precedes the start of the binary contents
+ # of a patch, or the start of the next diff (e.g. "Index:").
+ my $propertyHashRef;
+ while (defined($_) && /$svnPropertyStartRegEx/) {
+ ($propertyHashRef, $_) = parseSvnProperty($fileHandle, $_);
+ if ($propertyHashRef->{name} eq "svn:executable") {
+ # Notice, for SVN properties, propertyChangeDelta is always non-zero
+ # because a property can only be added or removed.
+ $footer{executableBitDelta} = $propertyHashRef->{propertyChangeDelta};
+ }
+ }
+
+ return(\%footer, $_);
+}
+
+# Parse the next SVN property from the given file handle, and advance the handle so the last
+# line read is the first line after the property.
+#
+# This subroutine dies if the first line is not a valid start of an SVN property,
+# or the property is missing a value, or the property change type (e.g. "Added")
+# does not correspond to the property value type (e.g. "+").
+#
+# Args:
+# $fileHandle: advanced so the last line read from the handle is the first
+# line of the property to parse. This should be a line
+# that matches $svnPropertyStartRegEx.
+# $line: the line last read from $fileHandle.
+#
+# Returns ($propertyHashRef, $lastReadLine):
+# $propertyHashRef: a hash reference representing a SVN property.
+# name: the name of the property.
+# value: the last property value. For instance, suppose the property is "Modified".
+# Then it has both a '-' and '+' property value in that order. Therefore,
+# the value of this key is the value of the '+' property by ordering (since
+# it is the last value).
+# propertyChangeDelta: the value 1 or -1 if the property was added or
+# removed, respectively.
+# $lastReadLine: the line last read from $fileHandle.
+sub parseSvnProperty($$)
+{
+ my ($fileHandle, $line) = @_;
+
+ $_ = $line;
+
+ my $propertyName;
+ my $propertyChangeType;
+ if (/$svnPropertyStartRegEx/) {
+ $propertyChangeType = $1;
+ $propertyName = $2;
+ } else {
+ die("Failed to find SVN property: \"$_\".");
+ }
+
+ $_ = <$fileHandle>; # Not defined if end-of-file reached.
+
+ # The "svn diff" command neither inserts newline characters between property values
+ # nor between successive properties.
+ #
+ # FIXME: We do not support property values that contain tailing newline characters
+ # as it is difficult to disambiguate these trailing newlines from the empty
+ # line that precedes the contents of a binary patch.
+ my $propertyValue;
+ my $propertyValueType;
+ while (defined($_) && /$svnPropertyValueStartRegEx/) {
+ # Note, a '-' property may be followed by a '+' property in the case of a "Modified"
+ # or "Name" property. We only care about the ending value (i.e. the '+' property)
+ # in such circumstances. So, we take the property value for the property to be its
+ # last parsed property value.
+ #
+ # FIXME: We may want to consider strictly enforcing a '-', '+' property ordering or
+ # add error checking to prevent '+', '+', ..., '+' and other invalid combinations.
+ $propertyValueType = $1;
+ ($propertyValue, $_) = parseSvnPropertyValue($fileHandle, $_);
+ }
+
+ if (!$propertyValue) {
+ die("Failed to find the property value for the SVN property \"$propertyName\": \"$_\".");
+ }
+
+ my $propertyChangeDelta;
+ if ($propertyValueType eq '+') {
+ $propertyChangeDelta = 1;
+ } elsif ($propertyValueType eq '-') {
+ $propertyChangeDelta = -1;
+ } else {
+ die("Not reached.");
+ }
+
+ # We perform a simple validation that an "Added" or "Deleted" property
+ # change type corresponds with a "+" and "-" value type, respectively.
+ my $expectedChangeDelta;
+ if ($propertyChangeType eq "Added") {
+ $expectedChangeDelta = 1;
+ } elsif ($propertyChangeType eq "Deleted") {
+ $expectedChangeDelta = -1;
+ }
+
+ if ($expectedChangeDelta && $propertyChangeDelta != $expectedChangeDelta) {
+ die("The final property value type found \"$propertyValueType\" does not " .
+ "correspond to the property change type found \"$propertyChangeType\".");
+ }
+
+ my %propertyHash;
+ $propertyHash{name} = $propertyName;
+ $propertyHash{propertyChangeDelta} = $propertyChangeDelta;
+ $propertyHash{value} = $propertyValue;
+ return (\%propertyHash, $_);
+}
+
+# Parse the value of an SVN property from the given file handle, and advance
+# the handle so the last line read is the first line after the property value.
+#
+# This subroutine dies if the first line is an invalid SVN property value line
+# (i.e. a line that does not begin with " +" or " -").
+#
+# Args:
+# $fileHandle: advanced so the last line read from the handle is the first
+# line of the property value to parse. This should be a line
+# beginning with " +" or " -".
+# $line: the line last read from $fileHandle.
+#
+# Returns ($propertyValue, $lastReadLine):
+# $propertyValue: the value of the property.
+# $lastReadLine: the line last read from $fileHandle.
+sub parseSvnPropertyValue($$)
+{
+ my ($fileHandle, $line) = @_;
+
+ $_ = $line;
+
+ my $propertyValue;
+ my $eol;
+ if (/$svnPropertyValueStartRegEx/) {
+ $propertyValue = $2; # Does not include the end-of-line character(s).
+ $eol = $POSTMATCH;
+ } else {
+ die("Failed to find property value beginning with '+' or '-': \"$_\".");
+ }
+
+ while (<$fileHandle>) {
+ if (/^$/ || /$svnPropertyValueStartRegEx/ || /$svnPropertyStartRegEx/) {
+ # Note, we may encounter an empty line before the contents of a binary patch.
+ # Also, we check for $svnPropertyValueStartRegEx because a '-' property may be
+ # followed by a '+' property in the case of a "Modified" or "Name" property.
+ # We check for $svnPropertyStartRegEx because it indicates the start of the
+ # next property to parse.
+ last;
+ }
+
+ # Temporarily strip off any end-of-line characters. We add the end-of-line characters
+ # from the previously processed line to the start of this line so that the last line
+ # of the property value does not end in end-of-line characters.
+ s/([\n\r]+)$//;
+ $propertyValue .= "$eol$_";
+ $eol = $1;
+ }
+
+ return ($propertyValue, $_);
+}
+
+# Parse a patch file created by svn-create-patch.
+#
+# Args:
+# $fileHandle: A file handle to the patch file that has not yet been
+# read from.
+#
+# Returns:
+# @diffHashRefs: an array of diff hash references.
+# See the %diffHash documentation above.
+sub parsePatch($)
+{
+ my ($fileHandle) = @_;
+
+ my $newDiffHashRefs;
+ my @diffHashRefs; # return value
+
+ my $line = <$fileHandle>;
+
+ while (defined($line)) { # Otherwise, at EOF.
+
+ ($newDiffHashRefs, $line) = parseDiff($fileHandle, $line);
+
+ push @diffHashRefs, @$newDiffHashRefs;
+ }
+
+ return @diffHashRefs;
+}
+
+# Prepare the results of parsePatch() for use in svn-apply and svn-unapply.
+#
+# Args:
+# $shouldForce: Whether to continue processing if an unexpected
+# state occurs.
+# @diffHashRefs: An array of references to %diffHashes.
+# See the %diffHash documentation above.
+#
+# Returns $preparedPatchHashRef:
+# copyDiffHashRefs: A reference to an array of the $diffHashRefs in
+# @diffHashRefs that represent file copies. The original
+# ordering is preserved.
+# nonCopyDiffHashRefs: A reference to an array of the $diffHashRefs in
+# @diffHashRefs that do not represent file copies.
+# The original ordering is preserved.
+# sourceRevisionHash: A reference to a hash of source path to source
+# revision number.
+sub prepareParsedPatch($@)
+{
+ my ($shouldForce, @diffHashRefs) = @_;
+
+ my %copiedFiles;
+
+ # Return values
+ my @copyDiffHashRefs = ();
+ my @nonCopyDiffHashRefs = ();
+ my %sourceRevisionHash = ();
+ for my $diffHashRef (@diffHashRefs) {
+ my $copiedFromPath = $diffHashRef->{copiedFromPath};
+ my $indexPath = $diffHashRef->{indexPath};
+ my $sourceRevision = $diffHashRef->{sourceRevision};
+ my $sourcePath;
+
+ if (defined($copiedFromPath)) {
+ # Then the diff is a copy operation.
+ $sourcePath = $copiedFromPath;
+
+ # FIXME: Consider printing a warning or exiting if
+ # exists($copiedFiles{$indexPath}) is true -- i.e. if
+ # $indexPath appears twice as a copy target.
+ $copiedFiles{$indexPath} = $sourcePath;
+
+ push @copyDiffHashRefs, $diffHashRef;
+ } else {
+ # Then the diff is not a copy operation.
+ $sourcePath = $indexPath;
+
+ push @nonCopyDiffHashRefs, $diffHashRef;
+ }
+
+ if (defined($sourceRevision)) {
+ if (exists($sourceRevisionHash{$sourcePath}) &&
+ ($sourceRevisionHash{$sourcePath} != $sourceRevision)) {
+ if (!$shouldForce) {
+ die "Two revisions of the same file required as a source:\n".
+ " $sourcePath:$sourceRevisionHash{$sourcePath}\n".
+ " $sourcePath:$sourceRevision";
+ }
+ }
+ $sourceRevisionHash{$sourcePath} = $sourceRevision;
+ }
+ }
+
+ my %preparedPatchHash;
+
+ $preparedPatchHash{copyDiffHashRefs} = \@copyDiffHashRefs;
+ $preparedPatchHash{nonCopyDiffHashRefs} = \@nonCopyDiffHashRefs;
+ $preparedPatchHash{sourceRevisionHash} = \%sourceRevisionHash;
+
+ return \%preparedPatchHash;
+}
+
+# Return localtime() for the project's time zone, given an integer time as
+# returned by Perl's time() function.
+sub localTimeInProjectTimeZone($)
+{
+ my $epochTime = shift;
+
+ # Change the time zone temporarily for the localtime() call.
+ my $savedTimeZone = $ENV{'TZ'};
+ $ENV{'TZ'} = $changeLogTimeZone;
+ my @localTime = localtime($epochTime);
+ if (defined $savedTimeZone) {
+ $ENV{'TZ'} = $savedTimeZone;
+ } else {
+ delete $ENV{'TZ'};
+ }
+
+ return @localTime;
+}
+
+# Set the reviewer and date in a ChangeLog patch, and return the new patch.
+#
+# Args:
+# $patch: a ChangeLog patch as a string.
+# $reviewer: the name of the reviewer, or undef if the reviewer should not be set.
+# $epochTime: an integer time as returned by Perl's time() function.
+sub setChangeLogDateAndReviewer($$$)
+{
+ my ($patch, $reviewer, $epochTime) = @_;
+
+ my @localTime = localTimeInProjectTimeZone($epochTime);
+ my $newDate = strftime("%Y-%m-%d", @localTime);
+
+ my $firstChangeLogLineRegEx = qr#(\n\+)\d{4}-[^-]{2}-[^-]{2}( )#;
+ $patch =~ s/$firstChangeLogLineRegEx/$1$newDate$2/;
+
+ if (defined($reviewer)) {
+ # We include a leading plus ("+") in the regular expression to make
+ # the regular expression less likely to match text in the leading junk
+ # for the patch, if the patch has leading junk.
+ $patch =~ s/(\n\+.*)NOBODY \(OOPS!\)/$1$reviewer/;
+ }
+
+ return $patch;
+}
+
+# If possible, returns a ChangeLog patch equivalent to the given one,
+# but with the newest ChangeLog entry inserted at the top of the
+# file -- i.e. no leading context and all lines starting with "+".
+#
+# If given a patch string not representable as a patch with the above
+# properties, it returns the input back unchanged.
+#
+# WARNING: This subroutine can return an inequivalent patch string if
+# both the beginning of the new ChangeLog file matches the beginning
+# of the source ChangeLog, and the source beginning was modified.
+# Otherwise, it is guaranteed to return an equivalent patch string,
+# if it returns.
+#
+# Applying this subroutine to ChangeLog patches allows svn-apply to
+# insert new ChangeLog entries at the top of the ChangeLog file.
+# svn-apply uses patch with --fuzz=3 to do this. We need to apply
+# this subroutine because the diff(1) command is greedy when matching
+# lines. A new ChangeLog entry with the same date and author as the
+# previous will match and cause the diff to have lines of starting
+# context.
+#
+# This subroutine has unit tests in VCSUtils_unittest.pl.
+sub fixChangeLogPatch($)
+{
+ my $patch = shift; # $patch will only contain patch fragments for ChangeLog.
+
+ $patch =~ /(\r?\n)/;
+ my $lineEnding = $1;
+ my @lines = split(/$lineEnding/, $patch);
+
+ my $i = 0; # We reuse the same index throughout.
+
+ # Skip to beginning of first chunk.
+ for (; $i < @lines; ++$i) {
+ if (substr($lines[$i], 0, 1) eq "@") {
+ last;
+ }
+ }
+ my $chunkStartIndex = ++$i;
+
+ # Optimization: do not process if new lines already begin the chunk.
+ if (substr($lines[$i], 0, 1) eq "+") {
+ return $patch;
+ }
+
+ # Skip to first line of newly added ChangeLog entry.
+ # For example, +2009-06-03 Eric Seidel <eric@webkit.org>
+ my $dateStartRegEx = '^\+(\d{4}-\d{2}-\d{2})' # leading "+" and date
+ . '\s+(.+)\s+' # name
+ . '<([^<>]+)>$'; # e-mail address
+
+ for (; $i < @lines; ++$i) {
+ my $line = $lines[$i];
+ my $firstChar = substr($line, 0, 1);
+ if ($line =~ /$dateStartRegEx/) {
+ last;
+ } elsif ($firstChar eq " " or $firstChar eq "+") {
+ next;
+ }
+ return $patch; # Do not change if, for example, "-" or "@" found.
+ }
+ if ($i >= @lines) {
+ return $patch; # Do not change if date not found.
+ }
+ my $dateStartIndex = $i;
+
+ # Rewrite overlapping lines to lead with " ".
+ my @overlappingLines = (); # These will include a leading "+".
+ for (; $i < @lines; ++$i) {
+ my $line = $lines[$i];
+ if (substr($line, 0, 1) ne "+") {
+ last;
+ }
+ push(@overlappingLines, $line);
+ $lines[$i] = " " . substr($line, 1);
+ }
+
+ # Remove excess ending context, if necessary.
+ my $shouldTrimContext = 1;
+ for (; $i < @lines; ++$i) {
+ my $firstChar = substr($lines[$i], 0, 1);
+ if ($firstChar eq " ") {
+ next;
+ } elsif ($firstChar eq "@") {
+ last;
+ }
+ $shouldTrimContext = 0; # For example, if "+" or "-" encountered.
+ last;
+ }
+ my $deletedLineCount = 0;
+ if ($shouldTrimContext) { # Also occurs if end of file reached.
+ splice(@lines, $i - @overlappingLines, @overlappingLines);
+ $deletedLineCount = @overlappingLines;
+ }
+
+ # Work backwards, shifting overlapping lines towards front
+ # while checking that patch stays equivalent.
+ for ($i = $dateStartIndex - 1; @overlappingLines && $i >= $chunkStartIndex; --$i) {
+ my $line = $lines[$i];
+ if (substr($line, 0, 1) ne " ") {
+ next;
+ }
+ my $text = substr($line, 1);
+ my $newLine = pop(@overlappingLines);
+ if ($text ne substr($newLine, 1)) {
+ return $patch; # Unexpected difference.
+ }
+ $lines[$i] = "+$text";
+ }
+
+ # Finish moving whatever overlapping lines remain, and update
+ # the initial chunk range.
+ my $chunkRangeRegEx = '^\@\@ -(\d+),(\d+) \+\d+,(\d+) \@\@$'; # e.g. @@ -2,6 +2,18 @@
+ if ($lines[$chunkStartIndex - 1] !~ /$chunkRangeRegEx/) {
+ # FIXME: Handle errors differently from ChangeLog files that
+ # are okay but should not be altered. That way we can find out
+ # if improvements to the script ever become necessary.
+ return $patch; # Error: unexpected patch string format.
+ }
+ my $skippedFirstLineCount = $1 - 1;
+ my $oldSourceLineCount = $2;
+ my $oldTargetLineCount = $3;
+
+ if (@overlappingLines != $skippedFirstLineCount) {
+ # This can happen, for example, when deliberately inserting
+ # a new ChangeLog entry earlier in the file.
+ return $patch;
+ }
+ # If @overlappingLines > 0, this is where we make use of the
+ # assumption that the beginning of the source file was not modified.
+ splice(@lines, $chunkStartIndex, 0, @overlappingLines);
+
+ my $sourceLineCount = $oldSourceLineCount + @overlappingLines - $deletedLineCount;
+ my $targetLineCount = $oldTargetLineCount + @overlappingLines - $deletedLineCount;
+ $lines[$chunkStartIndex - 1] = "@@ -1,$sourceLineCount +1,$targetLineCount @@";
+
+ return join($lineEnding, @lines) . "\n"; # patch(1) expects an extra trailing newline.
+}
+
+# This is a supporting method for runPatchCommand.
+#
+# Arg: the optional $args parameter passed to runPatchCommand (can be undefined).
+#
+# Returns ($patchCommand, $isForcing).
+#
+# This subroutine has unit tests in VCSUtils_unittest.pl.
+sub generatePatchCommand($)
+{
+ my ($passedArgsHashRef) = @_;
+
+ my $argsHashRef = { # Defaults
+ ensureForce => 0,
+ shouldReverse => 0,
+ options => []
+ };
+
+ # Merges hash references. It's okay here if passed hash reference is undefined.
+ @{$argsHashRef}{keys %{$passedArgsHashRef}} = values %{$passedArgsHashRef};
+
+ my $ensureForce = $argsHashRef->{ensureForce};
+ my $shouldReverse = $argsHashRef->{shouldReverse};
+ my $options = $argsHashRef->{options};
+
+ if (! $options) {
+ $options = [];
+ } else {
+ $options = [@{$options}]; # Copy to avoid side effects.
+ }
+
+ my $isForcing = 0;
+ if (grep /^--force$/, @{$options}) {
+ $isForcing = 1;
+ } elsif ($ensureForce) {
+ push @{$options}, "--force";
+ $isForcing = 1;
+ }
+
+ if ($shouldReverse) { # No check: --reverse should never be passed explicitly.
+ push @{$options}, "--reverse";
+ }
+
+ @{$options} = sort(@{$options}); # For easier testing.
+
+ my $patchCommand = join(" ", "patch -p0", @{$options});
+
+ return ($patchCommand, $isForcing);
+}
+
+# Apply the given patch using the patch(1) command.
+#
+# On success, return the resulting exit status. Otherwise, exit with the
+# exit status. If "--force" is passed as an option, however, then never
+# exit and always return the exit status.
+#
+# Args:
+# $patch: a patch string.
+# $repositoryRootPath: an absolute path to the repository root.
+# $pathRelativeToRoot: the path of the file to be patched, relative to the
+# repository root. This should normally be the path
+# found in the patch's "Index:" line. It is passed
+# explicitly rather than reparsed from the patch
+# string for optimization purposes.
+# This is used only for error reporting. The
+# patch command gleans the actual file to patch
+# from the patch string.
+# $args: a reference to a hash of optional arguments. The possible
+# keys are --
+# ensureForce: whether to ensure --force is passed (defaults to 0).
+# shouldReverse: whether to pass --reverse (defaults to 0).
+# options: a reference to an array of options to pass to the
+# patch command. The subroutine passes the -p0 option
+# no matter what. This should not include --reverse.
+#
+# This subroutine has unit tests in VCSUtils_unittest.pl.
+sub runPatchCommand($$$;$)
+{
+ my ($patch, $repositoryRootPath, $pathRelativeToRoot, $args) = @_;
+
+ my ($patchCommand, $isForcing) = generatePatchCommand($args);
+
+ # Temporarily change the working directory since the path found
+ # in the patch's "Index:" line is relative to the repository root
+ # (i.e. the same as $pathRelativeToRoot).
+ my $cwd = Cwd::getcwd();
+ chdir $repositoryRootPath;
+
+ open PATCH, "| $patchCommand" or die "Could not call \"$patchCommand\" for file \"$pathRelativeToRoot\": $!";
+ print PATCH $patch;
+ close PATCH;
+ my $exitStatus = exitStatus($?);
+
+ chdir $cwd;
+
+ if ($exitStatus && !$isForcing) {
+ print "Calling \"$patchCommand\" for file \"$pathRelativeToRoot\" returned " .
+ "status $exitStatus. Pass --force to ignore patch failures.\n";
+ exit $exitStatus;
+ }
+
+ return $exitStatus;
+}
+
+# Merge ChangeLog patches using a three-file approach.
+#
+# This is used by resolve-ChangeLogs when it's operated as a merge driver
+# and when it's used to merge conflicts after a patch is applied or after
+# an svn update.
+#
+# It's also used for traditional rejected patches.
+#
+# Args:
+# $fileMine: The merged version of the file. Also known in git as the
+# other branch's version (%B) or "ours".
+# For traditional patch rejects, this is the *.rej file.
+# $fileOlder: The base version of the file. Also known in git as the
+# ancestor version (%O) or "base".
+# For traditional patch rejects, this is the *.orig file.
+# $fileNewer: The current version of the file. Also known in git as the
+# current version (%A) or "theirs".
+# For traditional patch rejects, this is the original-named
+# file.
+#
+# Returns 1 if merge was successful, else 0.
+sub mergeChangeLogs($$$)
+{
+ my ($fileMine, $fileOlder, $fileNewer) = @_;
+
+ my $traditionalReject = $fileMine =~ /\.rej$/ ? 1 : 0;
+
+ local $/ = undef;
+
+ my $patch;
+ if ($traditionalReject) {
+ open(DIFF, "<", $fileMine) or die $!;
+ $patch = <DIFF>;
+ close(DIFF);
+ rename($fileMine, "$fileMine.save");
+ rename($fileOlder, "$fileOlder.save");
+ } else {
+ open(DIFF, "-|", qw(diff -u -a --binary), $fileOlder, $fileMine) or die $!;
+ $patch = <DIFF>;
+ close(DIFF);
+ }
+
+ unlink("${fileNewer}.orig");
+ unlink("${fileNewer}.rej");
+
+ open(PATCH, "| patch --force --fuzz=3 --binary $fileNewer > " . File::Spec->devnull()) or die $!;
+ print PATCH ($traditionalReject ? $patch : fixChangeLogPatch($patch));
+ close(PATCH);
+
+ my $result = !exitStatus($?);
+
+ # Refuse to merge the patch if it did not apply cleanly
+ if (-e "${fileNewer}.rej") {
+ unlink("${fileNewer}.rej");
+ if (-f "${fileNewer}.orig") {
+ unlink($fileNewer);
+ rename("${fileNewer}.orig", $fileNewer);
+ }
+ } else {
+ unlink("${fileNewer}.orig");
+ }
+
+ if ($traditionalReject) {
+ rename("$fileMine.save", $fileMine);
+ rename("$fileOlder.save", $fileOlder);
+ }
+
+ return $result;
+}
+
+sub gitConfig($)
+{
+ return unless $isGit;
+
+ my ($config) = @_;
+
+ my $result = `git config $config`;
+ if (($? >> 8)) {
+ $result = `git repo-config $config`;
+ }
+ chomp $result;
+ return $result;
+}
+
+sub changeLogNameError($)
+{
+ my ($message) = @_;
+ print STDERR "$message\nEither:\n";
+ print STDERR " set CHANGE_LOG_NAME in your environment\n";
+ print STDERR " OR pass --name= on the command line\n";
+ print STDERR " OR set REAL_NAME in your environment";
+ print STDERR " OR git users can set 'git config user.name'\n";
+ exit(1);
+}
+
+sub changeLogName()
+{
+ my $name = $ENV{CHANGE_LOG_NAME} || $ENV{REAL_NAME} || gitConfig("user.name") || (split /\s*,\s*/, (getpwuid $<)[6])[0];
+
+ changeLogNameError("Failed to determine ChangeLog name.") unless $name;
+ # getpwuid seems to always succeed on windows, returning the username instead of the full name. This check will catch that case.
+ changeLogNameError("'$name' does not contain a space! ChangeLogs should contain your full name.") unless ($name =~ /\w \w/);
+
+ return $name;
+}
+
+sub changeLogEmailAddressError($)
+{
+ my ($message) = @_;
+ print STDERR "$message\nEither:\n";
+ print STDERR " set CHANGE_LOG_EMAIL_ADDRESS in your environment\n";
+ print STDERR " OR pass --email= on the command line\n";
+ print STDERR " OR set EMAIL_ADDRESS in your environment\n";
+ print STDERR " OR git users can set 'git config user.email'\n";
+ exit(1);
+}
+
+sub changeLogEmailAddress()
+{
+ my $emailAddress = $ENV{CHANGE_LOG_EMAIL_ADDRESS} || $ENV{EMAIL_ADDRESS} || gitConfig("user.email");
+
+ changeLogEmailAddressError("Failed to determine email address for ChangeLog.") unless $emailAddress;
+ changeLogEmailAddressError("Email address '$emailAddress' does not contain '\@' and is likely invalid.") unless ($emailAddress =~ /\@/);
+
+ return $emailAddress;
+}
+
+# http://tools.ietf.org/html/rfc1924
+sub decodeBase85($)
+{
+ my ($encoded) = @_;
+ my %table;
+ my @characters = ('0'..'9', 'A'..'Z', 'a'..'z', '!', '#', '$', '%', '&', '(', ')', '*', '+', '-', ';', '<', '=', '>', '?', '@', '^', '_', '`', '{', '|', '}', '~');
+ for (my $i = 0; $i < 85; $i++) {
+ $table{$characters[$i]} = $i;
+ }
+
+ my $decoded = '';
+ my @encodedChars = $encoded =~ /./g;
+
+ for (my $encodedIter = 0; defined($encodedChars[$encodedIter]);) {
+ my $digit = 0;
+ for (my $i = 0; $i < 5; $i++) {
+ $digit *= 85;
+ my $char = $encodedChars[$encodedIter];
+ $digit += $table{$char};
+ $encodedIter++;
+ }
+
+ for (my $i = 0; $i < 4; $i++) {
+ $decoded .= chr(($digit >> (3 - $i) * 8) & 255);
+ }
+ }
+
+ return $decoded;
+}
+
+sub decodeGitBinaryChunk($$)
+{
+ my ($contents, $fullPath) = @_;
+
+ # Load this module lazily in case the user don't have this module
+ # and won't handle git binary patches.
+ require Compress::Zlib;
+
+ my $encoded = "";
+ my $compressedSize = 0;
+ while ($contents =~ /^([A-Za-z])(.*)$/gm) {
+ my $line = $2;
+ next if $line eq "";
+ die "$fullPath: unexpected size of a line: $&" if length($2) % 5 != 0;
+ my $actualSize = length($2) / 5 * 4;
+ my $encodedExpectedSize = ord($1);
+ my $expectedSize = $encodedExpectedSize <= ord("Z") ? $encodedExpectedSize - ord("A") + 1 : $encodedExpectedSize - ord("a") + 27;
+
+ die "$fullPath: unexpected size of a line: $&" if int(($expectedSize + 3) / 4) * 4 != $actualSize;
+ $compressedSize += $expectedSize;
+ $encoded .= $line;
+ }
+
+ my $compressed = decodeBase85($encoded);
+ $compressed = substr($compressed, 0, $compressedSize);
+ return Compress::Zlib::uncompress($compressed);
+}
+
+sub decodeGitBinaryPatch($$)
+{
+ my ($contents, $fullPath) = @_;
+
+ # Git binary patch has two chunks. One is for the normal patching
+ # and another is for the reverse patching.
+ #
+ # Each chunk a line which starts from either "literal" or "delta",
+ # followed by a number which specifies decoded size of the chunk.
+ # The "delta" type chunks aren't supported by this function yet.
+ #
+ # Then, content of the chunk comes. To decode the content, we
+ # need decode it with base85 first, and then zlib.
+ my $gitPatchRegExp = '(literal|delta) ([0-9]+)\n([A-Za-z0-9!#$%&()*+-;<=>?@^_`{|}~\\n]*?)\n\n';
+ if ($contents !~ m"\nGIT binary patch\n$gitPatchRegExp$gitPatchRegExp\Z") {
+ die "$fullPath: unknown git binary patch format"
+ }
+
+ my $binaryChunkType = $1;
+ my $binaryChunkExpectedSize = $2;
+ my $encodedChunk = $3;
+ my $reverseBinaryChunkType = $4;
+ my $reverseBinaryChunkExpectedSize = $5;
+ my $encodedReverseChunk = $6;
+
+ my $binaryChunk = decodeGitBinaryChunk($encodedChunk, $fullPath);
+ my $binaryChunkActualSize = length($binaryChunk);
+ my $reverseBinaryChunk = decodeGitBinaryChunk($encodedReverseChunk, $fullPath);
+ my $reverseBinaryChunkActualSize = length($reverseBinaryChunk);
+
+ die "$fullPath: unexpected size of the first chunk (expected $binaryChunkExpectedSize but was $binaryChunkActualSize" if ($binaryChunkExpectedSize != $binaryChunkActualSize);
+ die "$fullPath: unexpected size of the second chunk (expected $reverseBinaryChunkExpectedSize but was $reverseBinaryChunkActualSize" if ($reverseBinaryChunkExpectedSize != $reverseBinaryChunkActualSize);
+
+ return ($binaryChunkType, $binaryChunk, $reverseBinaryChunkType, $reverseBinaryChunk);
+}
+
+1;