# Copyright (C) 2007, 2008, 2009 Apple Inc. All rights reserved.
# Copyright (C) 2009, 2010 Chris Jerdonek (chris.jerdonek@gmail.com)
# Copyright (C) 2010, 2011 Research In Motion Limited. 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.
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(
&applyGitBinaryPatchDelta
&callSilently
&canonicalizePath
&changeLogEmailAddress
&changeLogName
&chdirReturningRelativePath
&decodeGitBinaryChunk
&decodeGitBinaryPatch
&determineSVNRoot
&determineVCSRoot
&exitStatus
&fixChangeLogPatch
&gitBranch
&gitdiff2svndiff
&isGit
&isGitSVN
&isGitBranchBuild
&isGitDirectory
&isSVN
&isSVNDirectory
&isSVNVersion16OrNewer
&makeFilePathRelative
&mergeChangeLogs
&normalizePath
&parseFirstEOL
&parsePatch
&pathRelativeToSVNRepositoryRootForPath
&prepareParsedPatch
&removeEOL
&runPatchCommand
&scmMoveOrRenameFile
&scmToggleExecutableBit
&setChangeLogDateAndReviewer
&svnRevisionForDirectory
&svnStatus
&toWindowsLineEndings
);
%EXPORT_TAGS = ( );
@EXPORT_OK = ();
}
our @EXPORT_OK;
my $gitBranch;
my $gitRoot;
my $isGit;
my $isGitSVN;
my $isGitBranchBuild;
my $isSVN;
my $svnVersion;
# Project time zone for Cupertino, CA, US
my $changeLogTimeZone = "PST8PDT";
my $chunkRangeRegEx = qr#^\@\@ -(\d+),(\d+) \+\d+,(\d+) \@\@$#; # e.g. @@ -2,6 +2,18 @@
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#^ (\+|-|Merged|Reverse-merged) ([^\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;
}
sub toWindowsLineEndings
{
my ($text) = @_;
$text =~ s/\n/\r\n/g;
return $text;
}
# Note, this method will not error if the file corresponding to the $source path does not exist.
sub scmMoveOrRenameFile
{
my ($source, $destination) = @_;
return if ! -e $source;
if (isSVN()) {
system("svn", "move", $source, $destination);
} elsif (isGit()) {
system("git", "mv", $source, $destination);
}
}
# 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 isGitSVN()
{
return $isGitSVN if defined $isGitSVN;
# There doesn't seem to be an officially documented way to determine
# if you're in a git-svn checkout. The best suggestions seen so far
# all use something like the following:
my $output = `git config --get svn-remote.svn.fetch 2>& 1`;
$isGitSVN = $output ne '';
return $isGitSVN;
}
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 adjustPathForRecentRenamings($)
{
my ($fullPath) = @_;
if ($fullPath =~ m|^WebCore/|
|| $fullPath =~ m|^JavaScriptCore/|
|| $fullPath =~ m|^WebKit/|
|| $fullPath =~ m|^WebKit2/|) {
return "Source/$fullPath";
}
return $fullPath;
}
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) = @_;
return "" unless $line;
$line =~ s/[\r\n]+$//g;
return $line;
}
sub parseFirstEOL($)
{
my ($fileHandle) = @_;
# Make input record separator the new-line character to simplify regex matching below.
my $savedInputRecordSeparator = $INPUT_RECORD_SEPARATOR;
$INPUT_RECORD_SEPARATOR = "\n";
my $firstLine = <$fileHandle>;
$INPUT_RECORD_SEPARATOR = $savedInputRecordSeparator;
return unless defined($firstLine);
my $eol;
if ($firstLine =~ /\r\n/) {
$eol = "\r\n";
} elsif ($firstLine =~ /\r/) {
$eol = "\r";
} elsif ($firstLine =~ /\n/) {
$eol = "\n";
}
return $eol;
}
sub firstEOLInFile($)
{
my ($file) = @_;
my $eol;
if (open(FILE, $file)) {
$eol = parseFirstEOL(*FILE);
close(FILE);
}
return $eol;
}
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 = adjustPathForRecentRenamings($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 = adjustPathForRecentRenamings($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.
# $optionsHashRef: a hash reference representing optional options to use
# when processing a diff.
# shouldNotUseIndexPathEOL: whether to use the line endings in the diff instead
# instead of the line endings in the target file; the
# value of 1 if svnConvertedText should use the line
# endings in the diff.
#
# 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, $optionsHashRef) = @_;
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;
my $indexPathEOL;
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.
if ($indexPathEOL && $line !~ /$chunkRangeRegEx/) {
# The chunk range is part of the body of the diff, but its line endings should't be
# modified or patch(1) will complain. So, we only modify non-chunk range lines.
$line =~ s/\r\n|\r|\n/$indexPathEOL/g;
}
$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);
if (!$optionsHashRef || !$optionsHashRef->{shouldNotUseIndexPathEOL}) {
$indexPathEOL = firstEOLInFile($headerHashRef->{indexPath}) if !$headerHashRef->{isNew} && !$headerHashRef->{isBinary};
}
$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 "+" || $propertyValueType eq "Merged") {
$propertyChangeDelta = 1;
} elsif ($propertyValueType eq "-" || $propertyValueType eq "Reverse-merged") {
$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 '+', '-', 'Merged', or 'Reverse-merged': \"$_\".");
}
while (<$fileHandle>) {
if (/^[\r\n]+$/ || /$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.
# $optionsHashRef: a hash reference representing optional options to use
# when processing a diff.
# shouldNotUseIndexPathEOL: whether to use the line endings in the diff instead
# instead of the line endings in the target file; the
# value of 1 if svnConvertedText should use the line
# endings in the diff.
#
# Returns:
# @diffHashRefs: an array of diff hash references.
# See the %diffHash documentation above.
sub parsePatch($;$)
{
my ($fileHandle, $optionsHashRef) = @_;
my $newDiffHashRefs;
my @diffHashRefs; # return value
my $line = <$fileHandle>;
while (defined($line)) { # Otherwise, at EOF.
($newDiffHashRefs, $line) = parseDiff($fileHandle, $line, $optionsHashRef);
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.
#
# Returns $changeLogHashRef:
# $changeLogHashRef: a hash reference representing a change log patch.
# patch: a ChangeLog patch equivalent to the given one, but with the
# newest ChangeLog entry inserted at the top of the file, if possible.
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;
my %changeLogHashRef;
# Optimization: do not process if new lines already begin the chunk.
if (substr($lines[$i], 0, 1) eq "+") {
$changeLogHashRef{patch} = $patch;
return \%changeLogHashRef;
}
# 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;
}
$changeLogHashRef{patch} = $patch; # Do not change if, for example, "-" or "@" found.
return \%changeLogHashRef;
}
if ($i >= @lines) {
$changeLogHashRef{patch} = $patch; # Do not change if date not found.
return \%changeLogHashRef;
}
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)) {
$changeLogHashRef{patch} = $patch; # Unexpected difference.
return \%changeLogHashRef;
}
$lines[$i] = "+$text";
}
# 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);
# Update the date start index as it may have changed after shifting
# the overlapping lines towards the front.
for ($i = $chunkStartIndex; $i < $dateStartIndex; ++$i) {
$dateStartIndex = $i if $lines[$i] =~ /$dateStartRegEx/;
}
splice(@lines, $chunkStartIndex, $dateStartIndex - $chunkStartIndex); # Remove context of later entry.
$deletedLineCount += $dateStartIndex - $chunkStartIndex;
# Update the initial chunk range.
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.
$changeLogHashRef{patch} = $patch; # Error: unexpected patch string format.
return \%changeLogHashRef;
}
my $oldSourceLineCount = $2;
my $oldTargetLineCount = $3;
my $sourceLineCount = $oldSourceLineCount + @overlappingLines - $deletedLineCount;
my $targetLineCount = $oldTargetLineCount + @overlappingLines - $deletedLineCount;
$lines[$chunkStartIndex - 1] = "@@ -1,$sourceLineCount +1,$targetLineCount @@";
$changeLogHashRef{patch} = join($lineEnding, @lines) . "\n"; # patch(1) expects an extra trailing newline.
return \%changeLogHashRef;
}
# 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 $!;
if ($traditionalReject) {
print PATCH $patch;
} else {
my $changeLogHash = fixChangeLogPatch($patch);
print PATCH $changeLogHash->{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.
#
# 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 ($binaryChunkType eq "literal" and $binaryChunkExpectedSize != $binaryChunkActualSize);
die "$fullPath: unexpected size of the second chunk (expected $reverseBinaryChunkExpectedSize but was $reverseBinaryChunkActualSize" if ($reverseBinaryChunkType eq "literal" and $reverseBinaryChunkExpectedSize != $reverseBinaryChunkActualSize);
return ($binaryChunkType, $binaryChunk, $reverseBinaryChunkType, $reverseBinaryChunk);
}
sub readByte($$)
{
my ($data, $location) = @_;
# Return the byte at $location in $data as a numeric value.
return ord(substr($data, $location, 1));
}
# The git binary delta format is undocumented, except in code:
# - https://github.com/git/git/blob/master/delta.h:get_delta_hdr_size is the source
# of the algorithm in decodeGitBinaryPatchDeltaSize.
# - https://github.com/git/git/blob/master/patch-delta.c:patch_delta is the source
# of the algorithm in applyGitBinaryPatchDelta.
sub decodeGitBinaryPatchDeltaSize($)
{
my ($binaryChunk) = @_;
# Source and destination buffer sizes are stored in 7-bit chunks at the
# start of the binary delta patch data. The highest bit in each byte
# except the last is set; the remaining 7 bits provide the next
# chunk of the size. The chunks are stored in ascending significance
# order.
my $cmd;
my $size = 0;
my $shift = 0;
for (my $i = 0; $i < length($binaryChunk);) {
$cmd = readByte($binaryChunk, $i++);
$size |= ($cmd & 0x7f) << $shift;
$shift += 7;
if (!($cmd & 0x80)) {
return ($size, $i);
}
}
}
sub applyGitBinaryPatchDelta($$)
{
my ($binaryChunk, $originalContents) = @_;
# Git delta format consists of two headers indicating source buffer size
# and result size, then a series of commands. Each command is either
# a copy-from-old-version (the 0x80 bit is set) or a copy-from-delta
# command. Commands are applied sequentially to generate the result.
#
# A copy-from-old-version command encodes an offset and size to copy
# from in subsequent bits, while a copy-from-delta command consists only
# of the number of bytes to copy from the delta.
# We don't use these values, but we need to know how big they are so that
# we can skip to the diff data.
my ($size, $bytesUsed) = decodeGitBinaryPatchDeltaSize($binaryChunk);
$binaryChunk = substr($binaryChunk, $bytesUsed);
($size, $bytesUsed) = decodeGitBinaryPatchDeltaSize($binaryChunk);
$binaryChunk = substr($binaryChunk, $bytesUsed);
my $out = "";
for (my $i = 0; $i < length($binaryChunk); ) {
my $cmd = ord(substr($binaryChunk, $i++, 1));
if ($cmd & 0x80) {
# Extract an offset and size from the delta data, then copy
# $size bytes from $offset in the original data into the output.
my $offset = 0;
my $size = 0;
if ($cmd & 0x01) { $offset = readByte($binaryChunk, $i++); }
if ($cmd & 0x02) { $offset |= readByte($binaryChunk, $i++) << 8; }
if ($cmd & 0x04) { $offset |= readByte($binaryChunk, $i++) << 16; }
if ($cmd & 0x08) { $offset |= readByte($binaryChunk, $i++) << 24; }
if ($cmd & 0x10) { $size = readByte($binaryChunk, $i++); }
if ($cmd & 0x20) { $size |= readByte($binaryChunk, $i++) << 8; }
if ($cmd & 0x40) { $size |= readByte($binaryChunk, $i++) << 16; }
if ($size == 0) { $size = 0x10000; }
$out .= substr($originalContents, $offset, $size);
} elsif ($cmd) {
# Copy $cmd bytes from the delta data into the output.
$out .= substr($binaryChunk, $i, $cmd);
$i += $cmd;
} else {
die "unexpected delta opcode 0";
}
}
return $out;
}
1;