Tools/Scripts/VCSUtils.pm

   1 # Copyright (C) 2007, 2008, 2009 Apple Inc.  All rights reserved.
   2 # Copyright (C) 2009, 2010 Chris Jerdonek (chris.jerdonek@gmail.com)
   3 # Copyright (C) 2010, 2011 Research In Motion Limited. All rights reserved.
   4 #
   5 # Redistribution and use in source and binary forms, with or without
   6 # modification, are permitted provided that the following conditions
   7 # are met:
   8 #
   9 # 1.  Redistributions of source code must retain the above copyright
  10 #     notice, this list of conditions and the following disclaimer.
  11 # 2.  Redistributions in binary form must reproduce the above copyright
  12 #     notice, this list of conditions and the following disclaimer in the
  13 #     documentation and/or other materials provided with the distribution.
  14 # 3.  Neither the name of Apple Computer, Inc. ("Apple") nor the names of
  15 #     its contributors may be used to endorse or promote products derived
  16 #     from this software without specific prior written permission.
  17 #
  18 # THIS SOFTWARE IS PROVIDED BY APPLE AND ITS CONTRIBUTORS "AS IS" AND ANY
  19 # EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
  20 # WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
  21 # DISCLAIMED. IN NO EVENT SHALL APPLE OR ITS CONTRIBUTORS BE LIABLE FOR ANY
  22 # DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
  23 # (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
  24 # LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
  25 # ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
  26 # (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
  27 # THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  28
  29 # Module to share code to work with various version control systems.
  30 package VCSUtils;
  31
  32 use strict;
  33 use warnings;
  34
  35 use Cwd qw();  # "qw()" prevents warnings about redefining getcwd() with "use POSIX;"
  36 use English; # for $POSTMATCH, etc.
  37 use File::Basename;
  38 use File::Spec;
  39 use POSIX;
  40 use Term::ANSIColor qw(colored);
  41
  42 BEGIN {
  43     use Exporter   ();
  44     our ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS);
  45     $VERSION     = 1.00;
  46     @ISA         = qw(Exporter);
  47     @EXPORT      = qw(
  48         &applyGitBinaryPatchDelta
  49         &callSilently
  50         &canonicalizePath
  51         &changeLogEmailAddress
  52         &changeLogFileName
  53         &changeLogName
  54         &chdirReturningRelativePath
  55         &decodeGitBinaryChunk
  56         &decodeGitBinaryPatch
  57         &determineSVNRoot
  58         &determineVCSRoot
  59         &escapeSubversionPath
  60         &exitStatus
  61         &fixChangeLogPatch
  62         &gitBranch
  63         &gitdiff2svndiff
  64         &isGit
  65         &isGitSVN
  66         &isGitBranchBuild
  67         &isGitDirectory
  68         &isSVN
  69         &isSVNDirectory
  70         &isSVNVersion16OrNewer
  71         &makeFilePathRelative
  72         &mergeChangeLogs
  73         &normalizePath
  74         &parseChunkRange
  75         &parseFirstEOL
  76         &parsePatch
  77         &pathRelativeToSVNRepositoryRootForPath
  78         &possiblyColored
  79         &prepareParsedPatch
  80         &removeEOL
  81         &runCommand
  82         &runPatchCommand
  83         &scmMoveOrRenameFile
  84         &scmToggleExecutableBit
  85         &setChangeLogDateAndReviewer
  86         &svnRevisionForDirectory
  87         &svnStatus
  88         &toWindowsLineEndings
  89     );
  90     %EXPORT_TAGS = ( );
  91     @EXPORT_OK   = ();
  92 }
  93
  94 our @EXPORT_OK;
  95
  96 my $gitBranch;
  97 my $gitRoot;
  98 my $isGit;
  99 my $isGitSVN;
 100 my $isGitBranchBuild;
 101 my $isSVN;
 102 my $svnVersion;
 103
 104 # Project time zone for Cupertino, CA, US
 105 my $changeLogTimeZone = "PST8PDT";
 106
 107 my $gitDiffStartRegEx = qr#^diff --git (\w/)?(.+) (\w/)?([^\r\n]+)#;
 108 my $svnDiffStartRegEx = qr#^Index: ([^\r\n]+)#;
 109 my $svnPropertiesStartRegEx = qr#^Property changes on: ([^\r\n]+)#; # $1 is normally the same as the index path.
 110 my $svnPropertyStartRegEx = qr#^(Modified|Name|Added|Deleted): ([^\r\n]+)#; # $2 is the name of the property.
 111 my $svnPropertyValueStartRegEx = qr#^   (\+|-|Merged|Reverse-merged) ([^\r\n]+)#; # $2 is the start of the property's value (which may span multiple lines).
 112
 113 # This method is for portability. Return the system-appropriate exit
 114 # status of a child process.
 115 #
 116 # Args: pass the child error status returned by the last pipe close,
 117 #       for example "$?".
 118 sub exitStatus($)
 119 {
 120     my ($returnvalue) = @_;
 121     if ($^O eq "MSWin32") {
 122         return $returnvalue >> 8;
 123     }
 124     if (!WIFEXITED($returnvalue)) {
 125         return 254;
 126     }
 127     return WEXITSTATUS($returnvalue);
 128 }
 129
 130 # Call a function while suppressing STDERR, and return the return values
 131 # as an array.
 132 sub callSilently($@) {
 133     my ($func, @args) = @_;
 134
 135     # The following pattern was taken from here:
 136     #   http://www.sdsc.edu/~moreland/courses/IntroPerl/docs/manual/pod/perlfunc/open.html
 137     #
 138     # Also see this Perl documentation (search for "open OLDERR"):
 139     #   http://perldoc.perl.org/functions/open.html
 140     open(OLDERR, ">&STDERR");
 141     close(STDERR);
 142     my @returnValue = &$func(@args);
 143     open(STDERR, ">&OLDERR");
 144     close(OLDERR);
 145
 146     return @returnValue;
 147 }
 148
 149 sub toWindowsLineEndings
 150 {
 151     my ($text) = @_;
 152     $text =~ s/\n/\r\n/g;
 153     return $text;
 154 }
 155
 156 # Note, this method will not error if the file corresponding to the $source path does not exist.
 157 sub scmMoveOrRenameFile
 158 {
 159     my ($source, $destination) = @_;
 160     return if ! -e $source;
 161     if (isSVN()) {
 162         my $escapedDestination = escapeSubversionPath($destination);
 163         my $escapedSource = escapeSubversionPath($source);
 164         system("svn", "move", $escapedSource, $escapedDestination);
 165     } elsif (isGit()) {
 166         system("git", "mv", $source, $destination);
 167     }
 168 }
 169
 170 # Note, this method will not error if the file corresponding to the path does not exist.
 171 sub scmToggleExecutableBit
 172 {
 173     my ($path, $executableBitDelta) = @_;
 174     return if ! -e $path;
 175     if ($executableBitDelta == 1) {
 176         scmAddExecutableBit($path);
 177     } elsif ($executableBitDelta == -1) {
 178         scmRemoveExecutableBit($path);
 179     }
 180 }
 181
 182 sub scmAddExecutableBit($)
 183 {
 184     my ($path) = @_;
 185
 186     if (isSVN()) {
 187         my $escapedPath = escapeSubversionPath($path);
 188         system("svn", "propset", "svn:executable", "on", $escapedPath) == 0 or die "Failed to run 'svn propset svn:executable on $escapedPath'.";
 189     } elsif (isGit()) {
 190         chmod(0755, $path);
 191     }
 192 }
 193
 194 sub scmRemoveExecutableBit($)
 195 {
 196     my ($path) = @_;
 197
 198     if (isSVN()) {
 199         my $escapedPath = escapeSubversionPath($path);
 200         system("svn", "propdel", "svn:executable", $escapedPath) == 0 or die "Failed to run 'svn propdel svn:executable $escapedPath'.";
 201     } elsif (isGit()) {
 202         chmod(0664, $path);
 203     }
 204 }
 205
 206 sub isGitDirectory($)
 207 {
 208     my ($dir) = @_;
 209     return system("cd $dir && git rev-parse > " . File::Spec->devnull() . " 2>&1") == 0;
 210 }
 211
 212 sub isGit()
 213 {
 214     return $isGit if defined $isGit;
 215
 216     $isGit = isGitDirectory(".");
 217     return $isGit;
 218 }
 219
 220 sub isGitSVN()
 221 {
 222     return $isGitSVN if defined $isGitSVN;
 223
 224     # There doesn't seem to be an officially documented way to determine
 225     # if you're in a git-svn checkout. The best suggestions seen so far
 226     # all use something like the following:
 227     my $output = `git config --get svn-remote.svn.fetch 2>& 1`;
 228     $isGitSVN = $output ne '';
 229     return $isGitSVN;
 230 }
 231
 232 sub gitBranch()
 233 {
 234     unless (defined $gitBranch) {
 235         chomp($gitBranch = `git symbolic-ref -q HEAD`);
 236         $gitBranch = "" if exitStatus($?);
 237         $gitBranch =~ s#^refs/heads/##;
 238         $gitBranch = "" if $gitBranch eq "master";
 239     }
 240
 241     return $gitBranch;
 242 }
 243
 244 sub isGitBranchBuild()
 245 {
 246     my $branch = gitBranch();
 247     chomp(my $override = `git config --bool branch.$branch.webKitBranchBuild`);
 248     return 1 if $override eq "true";
 249     return 0 if $override eq "false";
 250
 251     unless (defined $isGitBranchBuild) {
 252         chomp(my $gitBranchBuild = `git config --bool core.webKitBranchBuild`);
 253         $isGitBranchBuild = $gitBranchBuild eq "true";
 254     }
 255
 256     return $isGitBranchBuild;
 257 }
 258
 259 sub isSVNDirectory($)
 260 {
 261     my ($dir) = @_;
 262     return system("cd $dir && svn info > " . File::Spec->devnull() . " 2>&1") == 0;
 263 }
 264
 265 sub isSVN()
 266 {
 267     return $isSVN if defined $isSVN;
 268
 269     $isSVN = isSVNDirectory(".");
 270     return $isSVN;
 271 }
 272
 273 sub svnVersion()
 274 {
 275     return $svnVersion if defined $svnVersion;
 276
 277     if (!isSVN()) {
 278         $svnVersion = 0;
 279     } else {
 280         chomp($svnVersion = `svn --version --quiet`);
 281     }
 282     return $svnVersion;
 283 }
 284
 285 sub isSVNVersion16OrNewer()
 286 {
 287     my $version = svnVersion();
 288     return eval "v$version" ge v1.6;
 289 }
 290
 291 sub chdirReturningRelativePath($)
 292 {
 293     my ($directory) = @_;
 294     my $previousDirectory = Cwd::getcwd();
 295     chdir $directory;
 296     my $newDirectory = Cwd::getcwd();
 297     return "." if $newDirectory eq $previousDirectory;
 298     return File::Spec->abs2rel($previousDirectory, $newDirectory);
 299 }
 300
 301 sub determineGitRoot()
 302 {
 303     chomp(my $gitDir = `git rev-parse --git-dir`);
 304     return dirname($gitDir);
 305 }
 306
 307 sub determineSVNRoot()
 308 {
 309     my $last = '';
 310     my $path = '.';
 311     my $parent = '..';
 312     my $repositoryRoot;
 313     my $repositoryUUID;
 314     while (1) {
 315         my $thisRoot;
 316         my $thisUUID;
 317         my $escapedPath = escapeSubversionPath($path);
 318         # Ignore error messages in case we've run past the root of the checkout.
 319         open INFO, "svn info '$escapedPath' 2> " . File::Spec->devnull() . " |" or die;
 320         while (<INFO>) {
 321             if (/^Repository Root: (.+)/) {
 322                 $thisRoot = $1;
 323             }
 324             if (/^Repository UUID: (.+)/) {
 325                 $thisUUID = $1;
 326             }
 327             if ($thisRoot && $thisUUID) {
 328                 local $/ = undef;
 329                 <INFO>; # Consume the rest of the input.
 330             }
 331         }
 332         close INFO;
 333
 334         # It's possible (e.g. for developers of some ports) to have a WebKit
 335         # checkout in a subdirectory of another checkout.  So abort if the
 336         # repository root or the repository UUID suddenly changes.
 337         last if !$thisUUID;
 338         $repositoryUUID = $thisUUID if !$repositoryUUID;
 339         last if $thisUUID ne $repositoryUUID;
 340
 341         last if !$thisRoot;
 342         $repositoryRoot = $thisRoot if !$repositoryRoot;
 343         last if $thisRoot ne $repositoryRoot;
 344
 345         $last = $path;
 346         $path = File::Spec->catdir($parent, $path);
 347     }
 348
 349     return File::Spec->rel2abs($last);
 350 }
 351
 352 sub determineVCSRoot()
 353 {
 354     if (isGit()) {
 355         return determineGitRoot();
 356     }
 357
 358     if (!isSVN()) {
 359         # Some users have a workflow where svn-create-patch, svn-apply and
 360         # svn-unapply are used outside of multiple svn working directores,
 361         # so warn the user and assume Subversion is being used in this case.
 362         warn "Unable to determine VCS root for '" . Cwd::getcwd() . "'; assuming Subversion";
 363         $isSVN = 1;
 364     }
 365
 366     return determineSVNRoot();
 367 }
 368
 369 sub svnRevisionForDirectory($)
 370 {
 371     my ($dir) = @_;
 372     my $revision;
 373
 374     if (isSVNDirectory($dir)) {
 375         my $escapedDir = escapeSubversionPath($dir);
 376         my $svnInfo = `LC_ALL=C svn info $escapedDir | grep Revision:`;
 377         ($revision) = ($svnInfo =~ m/Revision: (\d+).*/g);
 378     } elsif (isGitDirectory($dir)) {
 379         my $gitLog = `cd $dir && LC_ALL=C git log --grep='git-svn-id: ' -n 1 | grep git-svn-id:`;
 380         ($revision) = ($gitLog =~ m/ +git-svn-id: .+@(\d+) /g);
 381     }
 382     if (!defined($revision)) {
 383         $revision = "unknown";
 384         warn "Unable to determine current SVN revision in $dir";
 385     }
 386     return $revision;
 387 }
 388
 389 sub pathRelativeToSVNRepositoryRootForPath($)
 390 {
 391     my ($file) = @_;
 392     my $relativePath = File::Spec->abs2rel($file);
 393
 394     my $svnInfo;
 395     if (isSVN()) {
 396         my $escapedRelativePath = escapeSubversionPath($relativePath);
 397         $svnInfo = `LC_ALL=C svn info $escapedRelativePath`;
 398     } elsif (isGit()) {
 399         $svnInfo = `LC_ALL=C git svn info $relativePath`;
 400     }
 401
 402     $svnInfo =~ /.*^URL: (.*?)$/m;
 403     my $svnURL = $1;
 404
 405     $svnInfo =~ /.*^Repository Root: (.*?)$/m;
 406     my $repositoryRoot = $1;
 407
 408     $svnURL =~ s/$repositoryRoot\///;
 409     return $svnURL;
 410 }
 411
 412 sub makeFilePathRelative($)
 413 {
 414     my ($path) = @_;
 415     return $path unless isGit();
 416
 417     unless (defined $gitRoot) {
 418         chomp($gitRoot = `git rev-parse --show-cdup`);
 419     }
 420     return $gitRoot . $path;
 421 }
 422
 423 sub normalizePath($)
 424 {
 425     my ($path) = @_;
 426     $path =~ s/\\/\//g;
 427     return $path;
 428 }
 429
 430 sub possiblyColored($$)
 431 {
 432     my ($colors, $string) = @_;
 433
 434     if (-t STDOUT) {
 435         return colored([$colors], $string);
 436     } else {
 437         return $string;
 438     }
 439 }
 440
 441 sub adjustPathForRecentRenamings($)
 442 {
 443     my ($fullPath) = @_;
 444
 445     $fullPath =~ s|WebCore/webaudio|WebCore/Modules/webaudio|g;
 446     $fullPath =~ s|JavaScriptCore/wtf|WTF/wtf|g;
 447     $fullPath =~ s|test_expectations.txt|TestExpectations|g;
 448
 449     return $fullPath;
 450 }
 451
 452 sub canonicalizePath($)
 453 {
 454     my ($file) = @_;
 455
 456     # Remove extra slashes and '.' directories in path
 457     $file = File::Spec->canonpath($file);
 458
 459     # Remove '..' directories in path
 460     my @dirs = ();
 461     foreach my $dir (File::Spec->splitdir($file)) {
 462         if ($dir eq '..' && $#dirs >= 0 && $dirs[$#dirs] ne '..') {
 463             pop(@dirs);
 464         } else {
 465             push(@dirs, $dir);
 466         }
 467     }
 468     return ($#dirs >= 0) ? File::Spec->catdir(@dirs) : ".";
 469 }
 470
 471 sub removeEOL($)
 472 {
 473     my ($line) = @_;
 474     return "" unless $line;
 475
 476     $line =~ s/[\r\n]+$//g;
 477     return $line;
 478 }
 479
 480 sub parseFirstEOL($)
 481 {
 482     my ($fileHandle) = @_;
 483
 484     # Make input record separator the new-line character to simplify regex matching below.
 485     my $savedInputRecordSeparator = $INPUT_RECORD_SEPARATOR;
 486     $INPUT_RECORD_SEPARATOR = "\n";
 487     my $firstLine  = <$fileHandle>;
 488     $INPUT_RECORD_SEPARATOR = $savedInputRecordSeparator;
 489
 490     return unless defined($firstLine);
 491
 492     my $eol;
 493     if ($firstLine =~ /\r\n/) {
 494         $eol = "\r\n";
 495     } elsif ($firstLine =~ /\r/) {
 496         $eol = "\r";
 497     } elsif ($firstLine =~ /\n/) {
 498         $eol = "\n";
 499     }
 500     return $eol;
 501 }
 502
 503 sub firstEOLInFile($)
 504 {
 505     my ($file) = @_;
 506     my $eol;
 507     if (open(FILE, $file)) {
 508         $eol = parseFirstEOL(*FILE);
 509         close(FILE);
 510     }
 511     return $eol;
 512 }
 513
 514 # Parses a chunk range line into its components.
 515 #
 516 # A chunk range line has the form: @@ -L_1,N_1 +L_2,N_2 @@, where the pairs (L_1, N_1),
 517 # (L_2, N_2) are ranges that represent the starting line number and line count in the
 518 # original file and new file, respectively.
 519 #
 520 # Note, some versions of GNU diff may omit the comma and trailing line count (e.g. N_1),
 521 # in which case the omitted line count defaults to 1. For example, GNU diff may output
 522 # @@ -1 +1 @@, which is equivalent to @@ -1,1 +1,1 @@.
 523 #
 524 # This subroutine returns undef if given an invalid or malformed chunk range.
 525 #
 526 # Args:
 527 #   $line: the line to parse.
 528 #
 529 # Returns $chunkRangeHashRef
 530 #   $chunkRangeHashRef: a hash reference representing the parts of a chunk range, as follows--
 531 #     startingLine: the starting line in the original file.
 532 #     lineCount: the line count in the original file.
 533 #     newStartingLine: the new starting line in the new file.
 534 #     newLineCount: the new line count in the new file.
 535 sub parseChunkRange($)
 536 {
 537     my ($line) = @_;
 538     my $chunkRangeRegEx = qr#^\@\@ -(\d+)(,(\d+))? \+(\d+)(,(\d+))? \@\@#;
 539     if ($line !~ /$chunkRangeRegEx/) {
 540         return;
 541     }
 542     my %chunkRange;
 543     $chunkRange{startingLine} = $1;
 544     $chunkRange{lineCount} = defined($2) ? $3 : 1;
 545     $chunkRange{newStartingLine} = $4;
 546     $chunkRange{newLineCount} = defined($5) ? $6 : 1;
 547     return \%chunkRange;
 548 }
 549
 550 sub svnStatus($)
 551 {
 552     my ($fullPath) = @_;
 553     my $escapedFullPath = escapeSubversionPath($fullPath);
 554     my $svnStatus;
 555     open SVN, "svn status --non-interactive --non-recursive '$escapedFullPath' |" or die;
 556     if (-d $fullPath) {
 557         # When running "svn stat" on a directory, we can't assume that only one
 558         # status will be returned (since any files with a status below the
 559         # directory will be returned), and we can't assume that the directory will
 560         # be first (since any files with unknown status will be listed first).
 561         my $normalizedFullPath = File::Spec->catdir(File::Spec->splitdir($fullPath));
 562         while (<SVN>) {
 563             # Input may use a different EOL sequence than $/, so avoid chomp.
 564             $_ = removeEOL($_);
 565             my $normalizedStatPath = File::Spec->catdir(File::Spec->splitdir(substr($_, 7)));
 566             if ($normalizedFullPath eq $normalizedStatPath) {
 567                 $svnStatus = "$_\n";
 568                 last;
 569             }
 570         }
 571         # Read the rest of the svn command output to avoid a broken pipe warning.
 572         local $/ = undef;
 573         <SVN>;
 574     }
 575     else {
 576         # Files will have only one status returned.
 577         $svnStatus = removeEOL(<SVN>) . "\n";
 578     }
 579     close SVN;
 580     return $svnStatus;
 581 }
 582
 583 # Return whether the given file mode is executable in the source control
 584 # sense.  We make this determination based on whether the executable bit
 585 # is set for "others" rather than the stronger condition that it be set
 586 # for the user, group, and others.  This is sufficient for distinguishing
 587 # the default behavior in Git and SVN.
 588 #
 589 # Args:
 590 #   $fileMode: A number or string representing a file mode in octal notation.
 591 sub isExecutable($)
 592 {
 593     my $fileMode = shift;
 594
 595     return $fileMode % 2;
 596 }
 597
 598 # Parse the next Git diff header from the given file handle, and advance
 599 # the handle so the last line read is the first line after the header.
 600 #
 601 # This subroutine dies if given leading junk.
 602 #
 603 # Args:
 604 #   $fileHandle: advanced so the last line read from the handle is the first
 605 #                line of the header to parse.  This should be a line
 606 #                beginning with "diff --git".
 607 #   $line: the line last read from $fileHandle
 608 #
 609 # Returns ($headerHashRef, $lastReadLine):
 610 #   $headerHashRef: a hash reference representing a diff header, as follows--
 611 #     copiedFromPath: the path from which the file was copied or moved if
 612 #                     the diff is a copy or move.
 613 #     executableBitDelta: the value 1 or -1 if the executable bit was added or
 614 #                         removed, respectively.  New and deleted files have
 615 #                         this value only if the file is executable, in which
 616 #                         case the value is 1 and -1, respectively.
 617 #     indexPath: the path of the target file.
 618 #     isBinary: the value 1 if the diff is for a binary file.
 619 #     isDeletion: the value 1 if the diff is a file deletion.
 620 #     isCopyWithChanges: the value 1 if the file was copied or moved and
 621 #                        the target file was changed in some way after being
 622 #                        copied or moved (e.g. if its contents or executable
 623 #                        bit were changed).
 624 #     isNew: the value 1 if the diff is for a new file.
 625 #     shouldDeleteSource: the value 1 if the file was copied or moved and
 626 #                         the source file was deleted -- i.e. if the copy
 627 #                         was actually a move.
 628 #     svnConvertedText: the header text with some lines converted to SVN
 629 #                       format.  Git-specific lines are preserved.
 630 #   $lastReadLine: the line last read from $fileHandle.
 631 sub parseGitDiffHeader($$)
 632 {
 633     my ($fileHandle, $line) = @_;
 634
 635     $_ = $line;
 636
 637     my $indexPath;
 638     if (/$gitDiffStartRegEx/) {
 639         # The first and second paths can differ in the case of copies
 640         # and renames.  We use the second file path because it is the
 641         # destination path.
 642         $indexPath = adjustPathForRecentRenamings($4);
 643         # Use $POSTMATCH to preserve the end-of-line character.
 644         $_ = "Index: $indexPath$POSTMATCH"; # Convert to SVN format.
 645     } else {
 646         die("Could not parse leading \"diff --git\" line: \"$line\".");
 647     }
 648
 649     my $copiedFromPath;
 650     my $foundHeaderEnding;
 651     my $isBinary;
 652     my $isDeletion;
 653     my $isNew;
 654     my $newExecutableBit = 0;
 655     my $oldExecutableBit = 0;
 656     my $shouldDeleteSource = 0;
 657     my $similarityIndex = 0;
 658     my $svnConvertedText;
 659     while (1) {
 660         # Temporarily strip off any end-of-line characters to simplify
 661         # regex matching below.
 662         s/([\n\r]+)$//;
 663         my $eol = $1;
 664
 665         if (/^(deleted file|old) mode (\d+)/) {
 666             $oldExecutableBit = (isExecutable($2) ? 1 : 0);
 667             $isDeletion = 1 if $1 eq "deleted file";
 668         } elsif (/^new( file)? mode (\d+)/) {
 669             $newExecutableBit = (isExecutable($2) ? 1 : 0);
 670             $isNew = 1 if $1;
 671         } elsif (/^similarity index (\d+)%/) {
 672             $similarityIndex = $1;
 673         } elsif (/^copy from (\S+)/) {
 674             $copiedFromPath = $1;
 675         } elsif (/^rename from (\S+)/) {
 676             # FIXME: Record this as a move rather than as a copy-and-delete.
 677             #        This will simplify adding rename support to svn-unapply.
 678             #        Otherwise, the hash for a deletion would have to know
 679             #        everything about the file being deleted in order to
 680             #        support undoing itself.  Recording as a move will also
 681             #        permit us to use "svn move" and "git move".
 682             $copiedFromPath = $1;
 683             $shouldDeleteSource = 1;
 684         } elsif (/^--- \S+/) {
 685             $_ = "--- $indexPath"; # Convert to SVN format.
 686         } elsif (/^\+\+\+ \S+/) {
 687             $_ = "+++ $indexPath"; # Convert to SVN format.
 688             $foundHeaderEnding = 1;
 689         } elsif (/^GIT binary patch$/ ) {
 690             $isBinary = 1;
 691             $foundHeaderEnding = 1;
 692         # The "git diff" command includes a line of the form "Binary files
 693         # <path1> and <path2> differ" if the --binary flag is not used.
 694         } elsif (/^Binary files / ) {
 695             die("Error: the Git diff contains a binary file without the binary data in ".
 696                 "line: \"$_\".  Be sure to use the --binary flag when invoking \"git diff\" ".
 697                 "with diffs containing binary files.");
 698         }
 699
 700         $svnConvertedText .= "$_$eol"; # Also restore end-of-line characters.
 701
 702         $_ = <$fileHandle>; # Not defined if end-of-file reached.
 703
 704         last if (!defined($_) || /$gitDiffStartRegEx/ || $foundHeaderEnding);
 705     }
 706
 707     my $executableBitDelta = $newExecutableBit - $oldExecutableBit;
 708
 709     my %header;
 710
 711     $header{copiedFromPath} = $copiedFromPath if $copiedFromPath;
 712     $header{executableBitDelta} = $executableBitDelta if $executableBitDelta;
 713     $header{indexPath} = $indexPath;
 714     $header{isBinary} = $isBinary if $isBinary;
 715     $header{isCopyWithChanges} = 1 if ($copiedFromPath && ($similarityIndex != 100 || $executableBitDelta));
 716     $header{isDeletion} = $isDeletion if $isDeletion;
 717     $header{isNew} = $isNew if $isNew;
 718     $header{shouldDeleteSource} = $shouldDeleteSource if $shouldDeleteSource;
 719     $header{svnConvertedText} = $svnConvertedText;
 720
 721     return (\%header, $_);
 722 }
 723
 724 # Parse the next SVN diff header from the given file handle, and advance
 725 # the handle so the last line read is the first line after the header.
 726 #
 727 # This subroutine dies if given leading junk or if it could not detect
 728 # the end of the header block.
 729 #
 730 # Args:
 731 #   $fileHandle: advanced so the last line read from the handle is the first
 732 #                line of the header to parse.  This should be a line
 733 #                beginning with "Index:".
 734 #   $line: the line last read from $fileHandle
 735 #
 736 # Returns ($headerHashRef, $lastReadLine):
 737 #   $headerHashRef: a hash reference representing a diff header, as follows--
 738 #     copiedFromPath: the path from which the file was copied if the diff
 739 #                     is a copy.
 740 #     indexPath: the path of the target file, which is the path found in
 741 #                the "Index:" line.
 742 #     isBinary: the value 1 if the diff is for a binary file.
 743 #     isNew: the value 1 if the diff is for a new file.
 744 #     sourceRevision: the revision number of the source, if it exists.  This
 745 #                     is the same as the revision number the file was copied
 746 #                     from, in the case of a file copy.
 747 #     svnConvertedText: the header text converted to a header with the paths
 748 #                       in some lines corrected.
 749 #   $lastReadLine: the line last read from $fileHandle.
 750 sub parseSvnDiffHeader($$)
 751 {
 752     my ($fileHandle, $line) = @_;
 753
 754     $_ = $line;
 755
 756     my $indexPath;
 757     if (/$svnDiffStartRegEx/) {
 758         $indexPath = adjustPathForRecentRenamings($1);
 759     } else {
 760         die("First line of SVN diff does not begin with \"Index \": \"$_\"");
 761     }
 762
 763     my $copiedFromPath;
 764     my $foundHeaderEnding;
 765     my $isBinary;
 766     my $isNew;
 767     my $sourceRevision;
 768     my $svnConvertedText;
 769     while (1) {
 770         # Temporarily strip off any end-of-line characters to simplify
 771         # regex matching below.
 772         s/([\n\r]+)$//;
 773         my $eol = $1;
 774
 775         # Fix paths on "---" and "+++" lines to match the leading
 776         # index line.
 777         if (s/^--- [^\t\n\r]+/--- $indexPath/) {
 778             # ---
 779             if (/^--- .+\(revision (\d+)\)/) {
 780                 $sourceRevision = $1;
 781                 $isNew = 1 if !$sourceRevision; # if revision 0.
 782                 if (/\(from (\S+):(\d+)\)$/) {
 783                     # The "from" clause is created by svn-create-patch, in
 784                     # which case there is always also a "revision" clause.
 785                     $copiedFromPath = $1;
 786                     die("Revision number \"$2\" in \"from\" clause does not match " .
 787                         "source revision number \"$sourceRevision\".") if ($2 != $sourceRevision);
 788                 }
 789             }
 790         } elsif (s/^\+\+\+ [^\t\n\r]+/+++ $indexPath/) {
 791             $foundHeaderEnding = 1;
 792         } elsif (/^Cannot display: file marked as a binary type.$/) {
 793             $isBinary = 1;
 794             $foundHeaderEnding = 1;
 795         }
 796
 797         $svnConvertedText .= "$_$eol"; # Also restore end-of-line characters.
 798
 799         $_ = <$fileHandle>; # Not defined if end-of-file reached.
 800
 801         last if (!defined($_) || /$svnDiffStartRegEx/ || $foundHeaderEnding);
 802     }
 803
 804     if (!$foundHeaderEnding) {
 805         die("Did not find end of header block corresponding to index path \"$indexPath\".");
 806     }
 807
 808     my %header;
 809
 810     $header{copiedFromPath} = $copiedFromPath if $copiedFromPath;
 811     $header{indexPath} = $indexPath;
 812     $header{isBinary} = $isBinary if $isBinary;
 813     $header{isNew} = $isNew if $isNew;
 814     $header{sourceRevision} = $sourceRevision if $sourceRevision;
 815     $header{svnConvertedText} = $svnConvertedText;
 816
 817     return (\%header, $_);
 818 }
 819
 820 # Parse the next diff header from the given file handle, and advance
 821 # the handle so the last line read is the first line after the header.
 822 #
 823 # This subroutine dies if given leading junk or if it could not detect
 824 # the end of the header block.
 825 #
 826 # Args:
 827 #   $fileHandle: advanced so the last line read from the handle is the first
 828 #                line of the header to parse.  For SVN-formatted diffs, this
 829 #                is a line beginning with "Index:".  For Git, this is a line
 830 #                beginning with "diff --git".
 831 #   $line: the line last read from $fileHandle
 832 #
 833 # Returns ($headerHashRef, $lastReadLine):
 834 #   $headerHashRef: a hash reference representing a diff header
 835 #     copiedFromPath: the path from which the file was copied if the diff
 836 #                     is a copy.
 837 #     executableBitDelta: the value 1 or -1 if the executable bit was added or
 838 #                         removed, respectively.  New and deleted files have
 839 #                         this value only if the file is executable, in which
 840 #                         case the value is 1 and -1, respectively.
 841 #     indexPath: the path of the target file.
 842 #     isBinary: the value 1 if the diff is for a binary file.
 843 #     isGit: the value 1 if the diff is Git-formatted.
 844 #     isSvn: the value 1 if the diff is SVN-formatted.
 845 #     sourceRevision: the revision number of the source, if it exists.  This
 846 #                     is the same as the revision number the file was copied
 847 #                     from, in the case of a file copy.
 848 #     svnConvertedText: the header text with some lines converted to SVN
 849 #                       format.  Git-specific lines are preserved.
 850 #   $lastReadLine: the line last read from $fileHandle.
 851 sub parseDiffHeader($$)
 852 {
 853     my ($fileHandle, $line) = @_;
 854
 855     my $header;  # This is a hash ref.
 856     my $isGit;
 857     my $isSvn;
 858     my $lastReadLine;
 859
 860     if ($line =~ $svnDiffStartRegEx) {
 861         $isSvn = 1;
 862         ($header, $lastReadLine) = parseSvnDiffHeader($fileHandle, $line);
 863     } elsif ($line =~ $gitDiffStartRegEx) {
 864         $isGit = 1;
 865         ($header, $lastReadLine) = parseGitDiffHeader($fileHandle, $line);
 866     } else {
 867         die("First line of diff does not begin with \"Index:\" or \"diff --git\": \"$line\"");
 868     }
 869
 870     $header->{isGit} = $isGit if $isGit;
 871     $header->{isSvn} = $isSvn if $isSvn;
 872
 873     return ($header, $lastReadLine);
 874 }
 875
 876 # FIXME: The %diffHash "object" should not have an svnConvertedText property.
 877 #        Instead, the hash object should store its information in a
 878 #        structured way as properties.  This should be done in a way so
 879 #        that, if necessary, the text of an SVN or Git patch can be
 880 #        reconstructed from the information in those hash properties.
 881 #
 882 # A %diffHash is a hash representing a source control diff of a single
 883 # file operation (e.g. a file modification, copy, or delete).
 884 #
 885 # These hashes appear, for example, in the parseDiff(), parsePatch(),
 886 # and prepareParsedPatch() subroutines of this package.
 887 #
 888 # The corresponding values are--
 889 #
 890 #   copiedFromPath: the path from which the file was copied if the diff
 891 #                   is a copy.
 892 #   executableBitDelta: the value 1 or -1 if the executable bit was added or
 893 #                       removed from the target file, respectively.
 894 #   indexPath: the path of the target file.  For SVN-formatted diffs,
 895 #              this is the same as the path in the "Index:" line.
 896 #   isBinary: the value 1 if the diff is for a binary file.
 897 #   isDeletion: the value 1 if the diff is known from the header to be a deletion.
 898 #   isGit: the value 1 if the diff is Git-formatted.
 899 #   isNew: the value 1 if the dif is known from the header to be a new file.
 900 #   isSvn: the value 1 if the diff is SVN-formatted.
 901 #   sourceRevision: the revision number of the source, if it exists.  This
 902 #                   is the same as the revision number the file was copied
 903 #                   from, in the case of a file copy.
 904 #   svnConvertedText: the diff with some lines converted to SVN format.
 905 #                     Git-specific lines are preserved.
 906
 907 # Parse one diff from a patch file created by svn-create-patch, and
 908 # advance the file handle so the last line read is the first line
 909 # of the next header block.
 910 #
 911 # This subroutine preserves any leading junk encountered before the header.
 912 #
 913 # Composition of an SVN diff
 914 #
 915 # There are three parts to an SVN diff: the header, the property change, and
 916 # the binary contents, in that order. Either the header or the property change
 917 # may be ommitted, but not both. If there are binary changes, then you always
 918 # have all three.
 919 #
 920 # Args:
 921 #   $fileHandle: a file handle advanced to the first line of the next
 922 #                header block. Leading junk is okay.
 923 #   $line: the line last read from $fileHandle.
 924 #   $optionsHashRef: a hash reference representing optional options to use
 925 #                    when processing a diff.
 926 #     shouldNotUseIndexPathEOL: whether to use the line endings in the diff instead
 927 #                               instead of the line endings in the target file; the
 928 #                               value of 1 if svnConvertedText should use the line
 929 #                               endings in the diff.
 930 #
 931 # Returns ($diffHashRefs, $lastReadLine):
 932 #   $diffHashRefs: A reference to an array of references to %diffHash hashes.
 933 #                  See the %diffHash documentation above.
 934 #   $lastReadLine: the line last read from $fileHandle
 935 sub parseDiff($$;$)
 936 {
 937     # FIXME: Adjust this method so that it dies if the first line does not
 938     #        match the start of a diff.  This will require a change to
 939     #        parsePatch() so that parsePatch() skips over leading junk.
 940     my ($fileHandle, $line, $optionsHashRef) = @_;
 941
 942     my $headerStartRegEx = $svnDiffStartRegEx; # SVN-style header for the default
 943
 944     my $headerHashRef; # Last header found, as returned by parseDiffHeader().
 945     my $svnPropertiesHashRef; # Last SVN properties diff found, as returned by parseSvnDiffProperties().
 946     my $svnText;
 947     my $indexPathEOL;
 948     my $numTextChunks = 0;
 949     while (defined($line)) {
 950         if (!$headerHashRef && ($line =~ $gitDiffStartRegEx)) {
 951             # Then assume all diffs in the patch are Git-formatted. This
 952             # block was made to be enterable at most once since we assume
 953             # all diffs in the patch are formatted the same (SVN or Git).
 954             $headerStartRegEx = $gitDiffStartRegEx;
 955         }
 956
 957         if ($line =~ $svnPropertiesStartRegEx) {
 958             my $propertyPath = $1;
 959             if ($svnPropertiesHashRef || $headerHashRef && ($propertyPath ne $headerHashRef->{indexPath})) {
 960                 # This is the start of the second diff in the while loop, which happens to
 961                 # be a property diff.  If $svnPropertiesHasRef is defined, then this is the
 962                 # second consecutive property diff, otherwise it's the start of a property
 963                 # diff for a file that only has property changes.
 964                 last;
 965             }
 966             ($svnPropertiesHashRef, $line) = parseSvnDiffProperties($fileHandle, $line);
 967             next;
 968         }
 969         if ($line !~ $headerStartRegEx) {
 970             # Then we are in the body of the diff.
 971             my $isChunkRange = defined(parseChunkRange($line));
 972             $numTextChunks += 1 if $isChunkRange;
 973             if ($indexPathEOL && !$isChunkRange) {
 974                 # The chunk range is part of the body of the diff, but its line endings should't be
 975                 # modified or patch(1) will complain. So, we only modify non-chunk range lines.
 976                 $line =~ s/\r\n|\r|\n/$indexPathEOL/g;
 977             }
 978             $svnText .= $line;
 979             $line = <$fileHandle>;
 980             next;
 981         } # Otherwise, we found a diff header.
 982
 983         if ($svnPropertiesHashRef || $headerHashRef) {
 984             # Then either we just processed an SVN property change or this
 985             # is the start of the second diff header of this while loop.
 986             last;
 987         }
 988
 989         ($headerHashRef, $line) = parseDiffHeader($fileHandle, $line);
 990         if (!$optionsHashRef || !$optionsHashRef->{shouldNotUseIndexPathEOL}) {
 991             $indexPathEOL = firstEOLInFile($headerHashRef->{indexPath}) if !$headerHashRef->{isNew} && !$headerHashRef->{isBinary};
 992         }
 993
 994         $svnText .= $headerHashRef->{svnConvertedText};
 995     }
 996
 997     my @diffHashRefs;
 998
 999     if ($headerHashRef->{shouldDeleteSource}) {
1000         my %deletionHash;
1001         $deletionHash{indexPath} = $headerHashRef->{copiedFromPath};
1002         $deletionHash{isDeletion} = 1;
1003         push @diffHashRefs, \%deletionHash;
1004     }
1005     if ($headerHashRef->{copiedFromPath}) {
1006         my %copyHash;
1007         $copyHash{copiedFromPath} = $headerHashRef->{copiedFromPath};
1008         $copyHash{indexPath} = $headerHashRef->{indexPath};
1009         $copyHash{sourceRevision} = $headerHashRef->{sourceRevision} if $headerHashRef->{sourceRevision};
1010         if ($headerHashRef->{isSvn}) {
1011             $copyHash{executableBitDelta} = $svnPropertiesHashRef->{executableBitDelta} if $svnPropertiesHashRef->{executableBitDelta};
1012         }
1013         push @diffHashRefs, \%copyHash;
1014     }
1015
1016     # Note, the order of evaluation for the following if conditional has been explicitly chosen so that
1017     # it evaluates to false when there is no headerHashRef (e.g. a property change diff for a file that
1018     # only has property changes).
1019     if ($headerHashRef->{isCopyWithChanges} || (%$headerHashRef && !$headerHashRef->{copiedFromPath})) {
1020         # Then add the usual file modification.
1021         my %diffHash;
1022         # FIXME: We should expand this code to support other properties.  In the future,
1023         #        parseSvnDiffProperties may return a hash whose keys are the properties.
1024         if ($headerHashRef->{isSvn}) {
1025             # SVN records the change to the executable bit in a separate property change diff
1026             # that follows the contents of the diff, except for binary diffs.  For binary
1027             # diffs, the property change diff follows the diff header.
1028             $diffHash{executableBitDelta} = $svnPropertiesHashRef->{executableBitDelta} if $svnPropertiesHashRef->{executableBitDelta};
1029         } elsif ($headerHashRef->{isGit}) {
1030             # Git records the change to the executable bit in the header of a diff.
1031             $diffHash{executableBitDelta} = $headerHashRef->{executableBitDelta} if $headerHashRef->{executableBitDelta};
1032         }
1033         $diffHash{indexPath} = $headerHashRef->{indexPath};
1034         $diffHash{isBinary} = $headerHashRef->{isBinary} if $headerHashRef->{isBinary};
1035         $diffHash{isDeletion} = $headerHashRef->{isDeletion} if $headerHashRef->{isDeletion};
1036         $diffHash{isGit} = $headerHashRef->{isGit} if $headerHashRef->{isGit};
1037         $diffHash{isNew} = $headerHashRef->{isNew} if $headerHashRef->{isNew};
1038         $diffHash{isSvn} = $headerHashRef->{isSvn} if $headerHashRef->{isSvn};
1039         if (!$headerHashRef->{copiedFromPath}) {
1040             # If the file was copied, then we have already incorporated the
1041             # sourceRevision information into the change.
1042             $diffHash{sourceRevision} = $headerHashRef->{sourceRevision} if $headerHashRef->{sourceRevision};
1043         }
1044         # FIXME: Remove the need for svnConvertedText.  See the %diffHash
1045         #        code comments above for more information.
1046         #
1047         # Note, we may not always have SVN converted text since we intend
1048         # to deprecate it in the future.  For example, a property change
1049         # diff for a file that only has property changes will not return
1050         # any SVN converted text.
1051         $diffHash{svnConvertedText} = $svnText if $svnText;
1052         $diffHash{numTextChunks} = $numTextChunks if $svnText && !$headerHashRef->{isBinary};
1053         push @diffHashRefs, \%diffHash;
1054     }
1055
1056     if (!%$headerHashRef && $svnPropertiesHashRef) {
1057         # A property change diff for a file that only has property changes.
1058         my %propertyChangeHash;
1059         $propertyChangeHash{executableBitDelta} = $svnPropertiesHashRef->{executableBitDelta} if $svnPropertiesHashRef->{executableBitDelta};
1060         $propertyChangeHash{indexPath} = $svnPropertiesHashRef->{propertyPath};
1061         $propertyChangeHash{isSvn} = 1;
1062         push @diffHashRefs, \%propertyChangeHash;
1063     }
1064
1065     return (\@diffHashRefs, $line);
1066 }
1067
1068 # Parse an SVN property change diff from the given file handle, and advance
1069 # the handle so the last line read is the first line after this diff.
1070 #
1071 # For the case of an SVN binary diff, the binary contents will follow the
1072 # the property changes.
1073 #
1074 # This subroutine dies if the first line does not begin with "Property changes on"
1075 # or if the separator line that follows this line is missing.
1076 #
1077 # Args:
1078 #   $fileHandle: advanced so the last line read from the handle is the first
1079 #                line of the footer to parse.  This line begins with
1080 #                "Property changes on".
1081 #   $line: the line last read from $fileHandle.
1082 #
1083 # Returns ($propertyHashRef, $lastReadLine):
1084 #   $propertyHashRef: a hash reference representing an SVN diff footer.
1085 #     propertyPath: the path of the target file.
1086 #     executableBitDelta: the value 1 or -1 if the executable bit was added or
1087 #                         removed from the target file, respectively.
1088 #   $lastReadLine: the line last read from $fileHandle.
1089 sub parseSvnDiffProperties($$)
1090 {
1091     my ($fileHandle, $line) = @_;
1092
1093     $_ = $line;
1094
1095     my %footer;
1096     if (/$svnPropertiesStartRegEx/) {
1097         $footer{propertyPath} = $1;
1098     } else {
1099         die("Failed to find start of SVN property change, \"Property changes on \": \"$_\"");
1100     }
1101
1102     # We advance $fileHandle two lines so that the next line that
1103     # we process is $svnPropertyStartRegEx in a well-formed footer.
1104     # A well-formed footer has the form:
1105     # Property changes on: FileA
1106     # ___________________________________________________________________
1107     # Added: svn:executable
1108     #    + *
1109     $_ = <$fileHandle>; # Not defined if end-of-file reached.
1110     my $separator = "_" x 67;
1111     if (defined($_) && /^$separator[\r\n]+$/) {
1112         $_ = <$fileHandle>;
1113     } else {
1114         die("Failed to find separator line: \"$_\".");
1115     }
1116
1117     # FIXME: We should expand this to support other SVN properties
1118     #        (e.g. return a hash of property key-values that represents
1119     #        all properties).
1120     #
1121     # Notice, we keep processing until we hit end-of-file or some
1122     # line that does not resemble $svnPropertyStartRegEx, such as
1123     # the empty line that precedes the start of the binary contents
1124     # of a patch, or the start of the next diff (e.g. "Index:").
1125     my $propertyHashRef;
1126     while (defined($_) && /$svnPropertyStartRegEx/) {
1127         ($propertyHashRef, $_) = parseSvnProperty($fileHandle, $_);
1128         if ($propertyHashRef->{name} eq "svn:executable") {
1129             # Notice, for SVN properties, propertyChangeDelta is always non-zero
1130             # because a property can only be added or removed.
1131             $footer{executableBitDelta} = $propertyHashRef->{propertyChangeDelta};
1132         }
1133     }
1134
1135     return(\%footer, $_);
1136 }
1137
1138 # Parse the next SVN property from the given file handle, and advance the handle so the last
1139 # line read is the first line after the property.
1140 #
1141 # This subroutine dies if the first line is not a valid start of an SVN property,
1142 # or the property is missing a value, or the property change type (e.g. "Added")
1143 # does not correspond to the property value type (e.g. "+").
1144 #
1145 # Args:
1146 #   $fileHandle: advanced so the last line read from the handle is the first
1147 #                line of the property to parse.  This should be a line
1148 #                that matches $svnPropertyStartRegEx.
1149 #   $line: the line last read from $fileHandle.
1150 #
1151 # Returns ($propertyHashRef, $lastReadLine):
1152 #   $propertyHashRef: a hash reference representing a SVN property.
1153 #     name: the name of the property.
1154 #     value: the last property value.  For instance, suppose the property is "Modified".
1155 #            Then it has both a '-' and '+' property value in that order.  Therefore,
1156 #            the value of this key is the value of the '+' property by ordering (since
1157 #            it is the last value).
1158 #     propertyChangeDelta: the value 1 or -1 if the property was added or
1159 #                          removed, respectively.
1160 #   $lastReadLine: the line last read from $fileHandle.
1161 sub parseSvnProperty($$)
1162 {
1163     my ($fileHandle, $line) = @_;
1164
1165     $_ = $line;
1166
1167     my $propertyName;
1168     my $propertyChangeType;
1169     if (/$svnPropertyStartRegEx/) {
1170         $propertyChangeType = $1;
1171         $propertyName = $2;
1172     } else {
1173         die("Failed to find SVN property: \"$_\".");
1174     }
1175
1176     $_ = <$fileHandle>; # Not defined if end-of-file reached.
1177
1178     # The "svn diff" command neither inserts newline characters between property values
1179     # nor between successive properties.
1180     #
1181     # FIXME: We do not support property values that contain tailing newline characters
1182     #        as it is difficult to disambiguate these trailing newlines from the empty
1183     #        line that precedes the contents of a binary patch.
1184     my $propertyValue;
1185     my $propertyValueType;
1186     while (defined($_) && /$svnPropertyValueStartRegEx/) {
1187         # Note, a '-' property may be followed by a '+' property in the case of a "Modified"
1188         # or "Name" property.  We only care about the ending value (i.e. the '+' property)
1189         # in such circumstances.  So, we take the property value for the property to be its
1190         # last parsed property value.
1191         #
1192         # FIXME: We may want to consider strictly enforcing a '-', '+' property ordering or
1193         #        add error checking to prevent '+', '+', ..., '+' and other invalid combinations.
1194         $propertyValueType = $1;
1195         ($propertyValue, $_) = parseSvnPropertyValue($fileHandle, $_);
1196     }
1197
1198     if (!$propertyValue) {
1199         die("Failed to find the property value for the SVN property \"$propertyName\": \"$_\".");
1200     }
1201
1202     my $propertyChangeDelta;
1203     if ($propertyValueType eq "+" || $propertyValueType eq "Merged") {
1204         $propertyChangeDelta = 1;
1205     } elsif ($propertyValueType eq "-" || $propertyValueType eq "Reverse-merged") {
1206         $propertyChangeDelta = -1;
1207     } else {
1208         die("Not reached.");
1209     }
1210
1211     # We perform a simple validation that an "Added" or "Deleted" property
1212     # change type corresponds with a "+" and "-" value type, respectively.
1213     my $expectedChangeDelta;
1214     if ($propertyChangeType eq "Added") {
1215         $expectedChangeDelta = 1;
1216     } elsif ($propertyChangeType eq "Deleted") {
1217         $expectedChangeDelta = -1;
1218     }
1219
1220     if ($expectedChangeDelta && $propertyChangeDelta != $expectedChangeDelta) {
1221         die("The final property value type found \"$propertyValueType\" does not " .
1222             "correspond to the property change type found \"$propertyChangeType\".");
1223     }
1224
1225     my %propertyHash;
1226     $propertyHash{name} = $propertyName;
1227     $propertyHash{propertyChangeDelta} = $propertyChangeDelta;
1228     $propertyHash{value} = $propertyValue;
1229     return (\%propertyHash, $_);
1230 }
1231
1232 # Parse the value of an SVN property from the given file handle, and advance
1233 # the handle so the last line read is the first line after the property value.
1234 #
1235 # This subroutine dies if the first line is an invalid SVN property value line
1236 # (i.e. a line that does not begin with "   +" or "   -").
1237 #
1238 # Args:
1239 #   $fileHandle: advanced so the last line read from the handle is the first
1240 #                line of the property value to parse.  This should be a line
1241 #                beginning with "   +" or "   -".
1242 #   $line: the line last read from $fileHandle.
1243 #
1244 # Returns ($propertyValue, $lastReadLine):
1245 #   $propertyValue: the value of the property.
1246 #   $lastReadLine: the line last read from $fileHandle.
1247 sub parseSvnPropertyValue($$)
1248 {
1249     my ($fileHandle, $line) = @_;
1250
1251     $_ = $line;
1252
1253     my $propertyValue;
1254     my $eol;
1255     if (/$svnPropertyValueStartRegEx/) {
1256         $propertyValue = $2; # Does not include the end-of-line character(s).
1257         $eol = $POSTMATCH;
1258     } else {
1259         die("Failed to find property value beginning with '+', '-', 'Merged', or 'Reverse-merged': \"$_\".");
1260     }
1261
1262     while (<$fileHandle>) {
1263         if (/^[\r\n]+$/ || /$svnPropertyValueStartRegEx/ || /$svnPropertyStartRegEx/) {
1264             # Note, we may encounter an empty line before the contents of a binary patch.
1265             # Also, we check for $svnPropertyValueStartRegEx because a '-' property may be
1266             # followed by a '+' property in the case of a "Modified" or "Name" property.
1267             # We check for $svnPropertyStartRegEx because it indicates the start of the
1268             # next property to parse.
1269             last;
1270         }
1271
1272         # Temporarily strip off any end-of-line characters. We add the end-of-line characters
1273         # from the previously processed line to the start of this line so that the last line
1274         # of the property value does not end in end-of-line characters.
1275         s/([\n\r]+)$//;
1276         $propertyValue .= "$eol$_";
1277         $eol = $1;
1278     }
1279
1280     return ($propertyValue, $_);
1281 }
1282
1283 # Parse a patch file created by svn-create-patch.
1284 #
1285 # Args:
1286 #   $fileHandle: A file handle to the patch file that has not yet been
1287 #                read from.
1288 #   $optionsHashRef: a hash reference representing optional options to use
1289 #                    when processing a diff.
1290 #     shouldNotUseIndexPathEOL: whether to use the line endings in the diff instead
1291 #                               instead of the line endings in the target file; the
1292 #                               value of 1 if svnConvertedText should use the line
1293 #                               endings in the diff.
1294 #
1295 # Returns:
1296 #   @diffHashRefs: an array of diff hash references.
1297 #                  See the %diffHash documentation above.
1298 sub parsePatch($;$)
1299 {
1300     my ($fileHandle, $optionsHashRef) = @_;
1301
1302     my $newDiffHashRefs;
1303     my @diffHashRefs; # return value
1304
1305     my $line = <$fileHandle>;
1306
1307     while (defined($line)) { # Otherwise, at EOF.
1308
1309         ($newDiffHashRefs, $line) = parseDiff($fileHandle, $line, $optionsHashRef);
1310
1311         push @diffHashRefs, @$newDiffHashRefs;
1312     }
1313
1314     return @diffHashRefs;
1315 }
1316
1317 # Prepare the results of parsePatch() for use in svn-apply and svn-unapply.
1318 #
1319 # Args:
1320 #   $shouldForce: Whether to continue processing if an unexpected
1321 #                 state occurs.
1322 #   @diffHashRefs: An array of references to %diffHashes.
1323 #                  See the %diffHash documentation above.
1324 #
1325 # Returns $preparedPatchHashRef:
1326 #   copyDiffHashRefs: A reference to an array of the $diffHashRefs in
1327 #                     @diffHashRefs that represent file copies. The original
1328 #                     ordering is preserved.
1329 #   nonCopyDiffHashRefs: A reference to an array of the $diffHashRefs in
1330 #                        @diffHashRefs that do not represent file copies.
1331 #                        The original ordering is preserved.
1332 #   sourceRevisionHash: A reference to a hash of source path to source
1333 #                       revision number.
1334 sub prepareParsedPatch($@)
1335 {
1336     my ($shouldForce, @diffHashRefs) = @_;
1337
1338     my %copiedFiles;
1339
1340     # Return values
1341     my @copyDiffHashRefs = ();
1342     my @nonCopyDiffHashRefs = ();
1343     my %sourceRevisionHash = ();
1344     for my $diffHashRef (@diffHashRefs) {
1345         my $copiedFromPath = $diffHashRef->{copiedFromPath};
1346         my $indexPath = $diffHashRef->{indexPath};
1347         my $sourceRevision = $diffHashRef->{sourceRevision};
1348         my $sourcePath;
1349
1350         if (defined($copiedFromPath)) {
1351             # Then the diff is a copy operation.
1352             $sourcePath = $copiedFromPath;
1353
1354             # FIXME: Consider printing a warning or exiting if
1355             #        exists($copiedFiles{$indexPath}) is true -- i.e. if
1356             #        $indexPath appears twice as a copy target.
1357             $copiedFiles{$indexPath} = $sourcePath;
1358
1359             push @copyDiffHashRefs, $diffHashRef;
1360         } else {
1361             # Then the diff is not a copy operation.
1362             $sourcePath = $indexPath;
1363
1364             push @nonCopyDiffHashRefs, $diffHashRef;
1365         }
1366
1367         if (defined($sourceRevision)) {
1368             if (exists($sourceRevisionHash{$sourcePath}) &&
1369                 ($sourceRevisionHash{$sourcePath} != $sourceRevision)) {
1370                 if (!$shouldForce) {
1371                     die "Two revisions of the same file required as a source:\n".
1372                         "    $sourcePath:$sourceRevisionHash{$sourcePath}\n".
1373                         "    $sourcePath:$sourceRevision";
1374                 }
1375             }
1376             $sourceRevisionHash{$sourcePath} = $sourceRevision;
1377         }
1378     }
1379
1380     my %preparedPatchHash;
1381
1382     $preparedPatchHash{copyDiffHashRefs} = \@copyDiffHashRefs;
1383     $preparedPatchHash{nonCopyDiffHashRefs} = \@nonCopyDiffHashRefs;
1384     $preparedPatchHash{sourceRevisionHash} = \%sourceRevisionHash;
1385
1386     return \%preparedPatchHash;
1387 }
1388
1389 # Return localtime() for the project's time zone, given an integer time as
1390 # returned by Perl's time() function.
1391 sub localTimeInProjectTimeZone($)
1392 {
1393     my $epochTime = shift;
1394
1395     # Change the time zone temporarily for the localtime() call.
1396     my $savedTimeZone = $ENV{'TZ'};
1397     $ENV{'TZ'} = $changeLogTimeZone;
1398     my @localTime = localtime($epochTime);
1399     if (defined $savedTimeZone) {
1400          $ENV{'TZ'} = $savedTimeZone;
1401     } else {
1402          delete $ENV{'TZ'};
1403     }
1404
1405     return @localTime;
1406 }
1407
1408 # Set the reviewer and date in a ChangeLog patch, and return the new patch.
1409 #
1410 # Args:
1411 #   $patch: a ChangeLog patch as a string.
1412 #   $reviewer: the name of the reviewer, or undef if the reviewer should not be set.
1413 #   $epochTime: an integer time as returned by Perl's time() function.
1414 sub setChangeLogDateAndReviewer($$$)
1415 {
1416     my ($patch, $reviewer, $epochTime) = @_;
1417
1418     my @localTime = localTimeInProjectTimeZone($epochTime);
1419     my $newDate = strftime("%Y-%m-%d", @localTime);
1420
1421     my $firstChangeLogLineRegEx = qr#(\n\+)\d{4}-[^-]{2}-[^-]{2}(  )#;
1422     $patch =~ s/$firstChangeLogLineRegEx/$1$newDate$2/;
1423
1424     if (defined($reviewer)) {
1425         # We include a leading plus ("+") in the regular expression to make
1426         # the regular expression less likely to match text in the leading junk
1427         # for the patch, if the patch has leading junk.
1428         $patch =~ s/(\n\+.*)NOBODY \(OOPS!\)/$1$reviewer/;
1429     }
1430
1431     return $patch;
1432 }
1433
1434 # If possible, returns a ChangeLog patch equivalent to the given one,
1435 # but with the newest ChangeLog entry inserted at the top of the
1436 # file -- i.e. no leading context and all lines starting with "+".
1437 #
1438 # If given a patch string not representable as a patch with the above
1439 # properties, it returns the input back unchanged.
1440 #
1441 # WARNING: This subroutine can return an inequivalent patch string if
1442 # both the beginning of the new ChangeLog file matches the beginning
1443 # of the source ChangeLog, and the source beginning was modified.
1444 # Otherwise, it is guaranteed to return an equivalent patch string,
1445 # if it returns.
1446 #
1447 # Applying this subroutine to ChangeLog patches allows svn-apply to
1448 # insert new ChangeLog entries at the top of the ChangeLog file.
1449 # svn-apply uses patch with --fuzz=3 to do this. We need to apply
1450 # this subroutine because the diff(1) command is greedy when matching
1451 # lines. A new ChangeLog entry with the same date and author as the
1452 # previous will match and cause the diff to have lines of starting
1453 # context.
1454 #
1455 # This subroutine has unit tests in VCSUtils_unittest.pl.
1456 #
1457 # Returns $changeLogHashRef:
1458 #   $changeLogHashRef: a hash reference representing a change log patch.
1459 #     patch: a ChangeLog patch equivalent to the given one, but with the
1460 #            newest ChangeLog entry inserted at the top of the file, if possible.
1461 sub fixChangeLogPatch($)
1462 {
1463     my $patch = shift; # $patch will only contain patch fragments for ChangeLog.
1464
1465     $patch =~ s|test_expectations.txt:|TestExpectations:|g;
1466
1467     $patch =~ /(\r?\n)/;
1468     my $lineEnding = $1;
1469     my @lines = split(/$lineEnding/, $patch);
1470
1471     my $i = 0; # We reuse the same index throughout.
1472
1473     # Skip to beginning of first chunk.
1474     for (; $i < @lines; ++$i) {
1475         if (substr($lines[$i], 0, 1) eq "@") {
1476             last;
1477         }
1478     }
1479     my $chunkStartIndex = ++$i;
1480     my %changeLogHashRef;
1481
1482     # Optimization: do not process if new lines already begin the chunk.
1483     if (substr($lines[$i], 0, 1) eq "+") {
1484         $changeLogHashRef{patch} = $patch;
1485         return \%changeLogHashRef;
1486     }
1487
1488     # Skip to first line of newly added ChangeLog entry.
1489     # For example, +2009-06-03  Eric Seidel  <eric@webkit.org>
1490     my $dateStartRegEx = '^\+(\d{4}-\d{2}-\d{2})' # leading "+" and date
1491                          . '\s+(.+)\s+' # name
1492                          . '<([^<>]+)>$'; # e-mail address
1493
1494     for (; $i < @lines; ++$i) {
1495         my $line = $lines[$i];
1496         my $firstChar = substr($line, 0, 1);
1497         if ($line =~ /$dateStartRegEx/) {
1498             last;
1499         } elsif ($firstChar eq " " or $firstChar eq "+") {
1500             next;
1501         }
1502         $changeLogHashRef{patch} = $patch; # Do not change if, for example, "-" or "@" found.
1503         return \%changeLogHashRef;
1504     }
1505     if ($i >= @lines) {
1506         $changeLogHashRef{patch} = $patch; # Do not change if date not found.
1507         return \%changeLogHashRef;
1508     }
1509     my $dateStartIndex = $i;
1510
1511     # Rewrite overlapping lines to lead with " ".
1512     my @overlappingLines = (); # These will include a leading "+".
1513     for (; $i < @lines; ++$i) {
1514         my $line = $lines[$i];
1515         if (substr($line, 0, 1) ne "+") {
1516           last;
1517         }
1518         push(@overlappingLines, $line);
1519         $lines[$i] = " " . substr($line, 1);
1520     }
1521
1522     # Remove excess ending context, if necessary.
1523     my $shouldTrimContext = 1;
1524     for (; $i < @lines; ++$i) {
1525         my $firstChar = substr($lines[$i], 0, 1);
1526         if ($firstChar eq " ") {
1527             next;
1528         } elsif ($firstChar eq "@") {
1529             last;
1530         }
1531         $shouldTrimContext = 0; # For example, if "+" or "-" encountered.
1532         last;
1533     }
1534     my $deletedLineCount = 0;
1535     if ($shouldTrimContext) { # Also occurs if end of file reached.
1536         splice(@lines, $i - @overlappingLines, @overlappingLines);
1537         $deletedLineCount = @overlappingLines;
1538     }
1539
1540     # Work backwards, shifting overlapping lines towards front
1541     # while checking that patch stays equivalent.
1542     for ($i = $dateStartIndex - 1; @overlappingLines && $i >= $chunkStartIndex; --$i) {
1543         my $line = $lines[$i];
1544         if (substr($line, 0, 1) ne " ") {
1545             next;
1546         }
1547         my $text = substr($line, 1);
1548         my $newLine = pop(@overlappingLines);
1549         if ($text ne substr($newLine, 1)) {
1550             $changeLogHashRef{patch} = $patch; # Unexpected difference.
1551             return \%changeLogHashRef;
1552         }
1553         $lines[$i] = "+$text";
1554     }
1555
1556     # If @overlappingLines > 0, this is where we make use of the
1557     # assumption that the beginning of the source file was not modified.
1558     splice(@lines, $chunkStartIndex, 0, @overlappingLines);
1559
1560     # Update the date start index as it may have changed after shifting
1561     # the overlapping lines towards the front.
1562     for ($i = $chunkStartIndex; $i < $dateStartIndex; ++$i) {
1563         $dateStartIndex = $i if $lines[$i] =~ /$dateStartRegEx/;
1564     }
1565     splice(@lines, $chunkStartIndex, $dateStartIndex - $chunkStartIndex); # Remove context of later entry.
1566     $deletedLineCount += $dateStartIndex - $chunkStartIndex;
1567
1568     # Update the initial chunk range.
1569     my $chunkRangeHashRef = parseChunkRange($lines[$chunkStartIndex - 1]);
1570     if (!$chunkRangeHashRef) {
1571         # FIXME: Handle errors differently from ChangeLog files that
1572         # are okay but should not be altered. That way we can find out
1573         # if improvements to the script ever become necessary.
1574         $changeLogHashRef{patch} = $patch; # Error: unexpected patch string format.
1575         return \%changeLogHashRef;
1576     }
1577     my $oldSourceLineCount = $chunkRangeHashRef->{lineCount};
1578     my $oldTargetLineCount = $chunkRangeHashRef->{newLineCount};
1579
1580     my $sourceLineCount = $oldSourceLineCount + @overlappingLines - $deletedLineCount;
1581     my $targetLineCount = $oldTargetLineCount + @overlappingLines - $deletedLineCount;
1582     $lines[$chunkStartIndex - 1] = "@@ -1,$sourceLineCount +1,$targetLineCount @@";
1583
1584     $changeLogHashRef{patch} = join($lineEnding, @lines) . "\n"; # patch(1) expects an extra trailing newline.
1585     return \%changeLogHashRef;
1586 }
1587
1588 # This is a supporting method for runPatchCommand.
1589 #
1590 # Arg: the optional $args parameter passed to runPatchCommand (can be undefined).
1591 #
1592 # Returns ($patchCommand, $isForcing).
1593 #
1594 # This subroutine has unit tests in VCSUtils_unittest.pl.
1595 sub generatePatchCommand($)
1596 {
1597     my ($passedArgsHashRef) = @_;
1598
1599     my $argsHashRef = { # Defaults
1600         ensureForce => 0,
1601         shouldReverse => 0,
1602         options => []
1603     };
1604
1605     # Merges hash references. It's okay here if passed hash reference is undefined.
1606     @{$argsHashRef}{keys %{$passedArgsHashRef}} = values %{$passedArgsHashRef};
1607
1608     my $ensureForce = $argsHashRef->{ensureForce};
1609     my $shouldReverse = $argsHashRef->{shouldReverse};
1610     my $options = $argsHashRef->{options};
1611
1612     if (! $options) {
1613         $options = [];
1614     } else {
1615         $options = [@{$options}]; # Copy to avoid side effects.
1616     }
1617
1618     my $isForcing = 0;
1619     if (grep /^--force$/, @{$options}) {
1620         $isForcing = 1;
1621     } elsif ($ensureForce) {
1622         push @{$options}, "--force";
1623         $isForcing = 1;
1624     }
1625
1626     if ($shouldReverse) { # No check: --reverse should never be passed explicitly.
1627         push @{$options}, "--reverse";
1628     }
1629
1630     @{$options} = sort(@{$options}); # For easier testing.
1631
1632     my $patchCommand = join(" ", "patch -p0", @{$options});
1633
1634     return ($patchCommand, $isForcing);
1635 }
1636
1637 # Apply the given patch using the patch(1) command.
1638 #
1639 # On success, return the resulting exit status. Otherwise, exit with the
1640 # exit status. If "--force" is passed as an option, however, then never
1641 # exit and always return the exit status.
1642 #
1643 # Args:
1644 #   $patch: a patch string.
1645 #   $repositoryRootPath: an absolute path to the repository root.
1646 #   $pathRelativeToRoot: the path of the file to be patched, relative to the
1647 #                        repository root. This should normally be the path
1648 #                        found in the patch's "Index:" line. It is passed
1649 #                        explicitly rather than reparsed from the patch
1650 #                        string for optimization purposes.
1651 #                            This is used only for error reporting. The
1652 #                        patch command gleans the actual file to patch
1653 #                        from the patch string.
1654 #   $args: a reference to a hash of optional arguments. The possible
1655 #          keys are --
1656 #            ensureForce: whether to ensure --force is passed (defaults to 0).
1657 #            shouldReverse: whether to pass --reverse (defaults to 0).
1658 #            options: a reference to an array of options to pass to the
1659 #                     patch command. The subroutine passes the -p0 option
1660 #                     no matter what. This should not include --reverse.
1661 #
1662 # This subroutine has unit tests in VCSUtils_unittest.pl.
1663 sub runPatchCommand($$$;$)
1664 {
1665     my ($patch, $repositoryRootPath, $pathRelativeToRoot, $args) = @_;
1666
1667     my ($patchCommand, $isForcing) = generatePatchCommand($args);
1668
1669     # Temporarily change the working directory since the path found
1670     # in the patch's "Index:" line is relative to the repository root
1671     # (i.e. the same as $pathRelativeToRoot).
1672     my $cwd = Cwd::getcwd();
1673     chdir $repositoryRootPath;
1674
1675     open PATCH, "| $patchCommand" or die "Could not call \"$patchCommand\" for file \"$pathRelativeToRoot\": $!";
1676     print PATCH $patch;
1677     close PATCH;
1678     my $exitStatus = exitStatus($?);
1679
1680     chdir $cwd;
1681
1682     if ($exitStatus && !$isForcing) {
1683         print "Calling \"$patchCommand\" for file \"$pathRelativeToRoot\" returned " .
1684               "status $exitStatus.  Pass --force to ignore patch failures.\n";
1685         exit $exitStatus;
1686     }
1687
1688     return $exitStatus;
1689 }
1690
1691 # Merge ChangeLog patches using a three-file approach.
1692 #
1693 # This is used by resolve-ChangeLogs when it's operated as a merge driver
1694 # and when it's used to merge conflicts after a patch is applied or after
1695 # an svn update.
1696 #
1697 # It's also used for traditional rejected patches.
1698 #
1699 # Args:
1700 #   $fileMine:  The merged version of the file.  Also known in git as the
1701 #               other branch's version (%B) or "ours".
1702 #               For traditional patch rejects, this is the *.rej file.
1703 #   $fileOlder: The base version of the file.  Also known in git as the
1704 #               ancestor version (%O) or "base".
1705 #               For traditional patch rejects, this is the *.orig file.
1706 #   $fileNewer: The current version of the file.  Also known in git as the
1707 #               current version (%A) or "theirs".
1708 #               For traditional patch rejects, this is the original-named
1709 #               file.
1710 #
1711 # Returns 1 if merge was successful, else 0.
1712 sub mergeChangeLogs($$$)
1713 {
1714     my ($fileMine, $fileOlder, $fileNewer) = @_;
1715
1716     my $traditionalReject = $fileMine =~ /\.rej$/ ? 1 : 0;
1717
1718     local $/ = undef;
1719
1720     my $patch;
1721     if ($traditionalReject) {
1722         open(DIFF, "<", $fileMine) or die $!;
1723         $patch = <DIFF>;
1724         close(DIFF);
1725         rename($fileMine, "$fileMine.save");
1726         rename($fileOlder, "$fileOlder.save");
1727     } else {
1728         open(DIFF, "diff -u -a --binary \"$fileOlder\" \"$fileMine\" |") or die $!;
1729         $patch = <DIFF>;
1730         close(DIFF);
1731     }
1732
1733     unlink("${fileNewer}.orig");
1734     unlink("${fileNewer}.rej");
1735
1736     open(PATCH, "| patch --force --fuzz=3 --binary \"$fileNewer\" > " . File::Spec->devnull()) or die $!;
1737     if ($traditionalReject) {
1738         print PATCH $patch;
1739     } else {
1740         my $changeLogHash = fixChangeLogPatch($patch);
1741         print PATCH $changeLogHash->{patch};
1742     }
1743     close(PATCH);
1744
1745     my $result = !exitStatus($?);
1746
1747     # Refuse to merge the patch if it did not apply cleanly
1748     if (-e "${fileNewer}.rej") {
1749         unlink("${fileNewer}.rej");
1750         if (-f "${fileNewer}.orig") {
1751             unlink($fileNewer);
1752             rename("${fileNewer}.orig", $fileNewer);
1753         }
1754     } else {
1755         unlink("${fileNewer}.orig");
1756     }
1757
1758     if ($traditionalReject) {
1759         rename("$fileMine.save", $fileMine);
1760         rename("$fileOlder.save", $fileOlder);
1761     }
1762
1763     return $result;
1764 }
1765
1766 sub gitConfig($)
1767 {
1768     return unless $isGit;
1769
1770     my ($config) = @_;
1771
1772     my $result = `git config $config`;
1773     if (($? >> 8)) {
1774         $result = `git repo-config $config`;
1775     }
1776     chomp $result;
1777     return $result;
1778 }
1779
1780 sub changeLogSuffix()
1781 {
1782     my $rootPath = determineVCSRoot();
1783     my $changeLogSuffixFile = File::Spec->catfile($rootPath, ".changeLogSuffix");
1784     return "" if ! -e $changeLogSuffixFile;
1785     open FILE, $changeLogSuffixFile or die "Could not open $changeLogSuffixFile: $!";
1786     my $changeLogSuffix = <FILE>;
1787     chomp $changeLogSuffix;
1788     close FILE;
1789     return $changeLogSuffix;
1790 }
1791
1792 sub changeLogFileName()
1793 {
1794     return "ChangeLog" . changeLogSuffix()
1795 }
1796
1797 sub changeLogNameError($)
1798 {
1799     my ($message) = @_;
1800     print STDERR "$message\nEither:\n";
1801     print STDERR "  set CHANGE_LOG_NAME in your environment\n";
1802     print STDERR "  OR pass --name= on the command line\n";
1803     print STDERR "  OR set REAL_NAME in your environment";
1804     print STDERR "  OR git users can set 'git config user.name'\n";
1805     exit(1);
1806 }
1807
1808 sub changeLogName()
1809 {
1810     my $name = $ENV{CHANGE_LOG_NAME} || $ENV{REAL_NAME} || gitConfig("user.name") || (split /\s*,\s*/, (getpwuid $<)[6])[0];
1811
1812     changeLogNameError("Failed to determine ChangeLog name.") unless $name;
1813     # getpwuid seems to always succeed on windows, returning the username instead of the full name.  This check will catch that case.
1814     changeLogNameError("'$name' does not contain a space!  ChangeLogs should contain your full name.") unless ($name =~ /\S\s\S/);
1815
1816     return $name;
1817 }
1818
1819 sub changeLogEmailAddressError($)
1820 {
1821     my ($message) = @_;
1822     print STDERR "$message\nEither:\n";
1823     print STDERR "  set CHANGE_LOG_EMAIL_ADDRESS in your environment\n";
1824     print STDERR "  OR pass --email= on the command line\n";
1825     print STDERR "  OR set EMAIL_ADDRESS in your environment\n";
1826     print STDERR "  OR git users can set 'git config user.email'\n";
1827     exit(1);
1828 }
1829
1830 sub changeLogEmailAddress()
1831 {
1832     my $emailAddress = $ENV{CHANGE_LOG_EMAIL_ADDRESS} || $ENV{EMAIL_ADDRESS} || gitConfig("user.email");
1833
1834     changeLogEmailAddressError("Failed to determine email address for ChangeLog.") unless $emailAddress;
1835     changeLogEmailAddressError("Email address '$emailAddress' does not contain '\@' and is likely invalid.") unless ($emailAddress =~ /\@/);
1836
1837     return $emailAddress;
1838 }
1839
1840 # http://tools.ietf.org/html/rfc1924
1841 sub decodeBase85($)
1842 {
1843     my ($encoded) = @_;
1844     my %table;
1845     my @characters = ('0'..'9', 'A'..'Z', 'a'..'z', '!', '#', '$', '%', '&', '(', ')', '*', '+', '-', ';', '<', '=', '>', '?', '@', '^', '_', '`', '{', '|', '}', '~');
1846     for (my $i = 0; $i < 85; $i++) {
1847         $table{$characters[$i]} = $i;
1848     }
1849
1850     my $decoded = '';
1851     my @encodedChars = $encoded =~ /./g;
1852
1853     for (my $encodedIter = 0; defined($encodedChars[$encodedIter]);) {
1854         my $digit = 0;
1855         for (my $i = 0; $i < 5; $i++) {
1856             $digit *= 85;
1857             my $char = $encodedChars[$encodedIter];
1858             $digit += $table{$char};
1859             $encodedIter++;
1860         }
1861
1862         for (my $i = 0; $i < 4; $i++) {
1863             $decoded .= chr(($digit >> (3 - $i) * 8) & 255);
1864         }
1865     }
1866
1867     return $decoded;
1868 }
1869
1870 sub decodeGitBinaryChunk($$)
1871 {
1872     my ($contents, $fullPath) = @_;
1873
1874     # Load this module lazily in case the user don't have this module
1875     # and won't handle git binary patches.
1876     require Compress::Zlib;
1877
1878     my $encoded = "";
1879     my $compressedSize = 0;
1880     while ($contents =~ /^([A-Za-z])(.*)$/gm) {
1881         my $line = $2;
1882         next if $line eq "";
1883         die "$fullPath: unexpected size of a line: $&" if length($2) % 5 != 0;
1884         my $actualSize = length($2) / 5 * 4;
1885         my $encodedExpectedSize = ord($1);
1886         my $expectedSize = $encodedExpectedSize <= ord("Z") ? $encodedExpectedSize - ord("A") + 1 : $encodedExpectedSize - ord("a") + 27;
1887
1888         die "$fullPath: unexpected size of a line: $&" if int(($expectedSize + 3) / 4) * 4 != $actualSize;
1889         $compressedSize += $expectedSize;
1890         $encoded .= $line;
1891     }
1892
1893     my $compressed = decodeBase85($encoded);
1894     $compressed = substr($compressed, 0, $compressedSize);
1895     return Compress::Zlib::uncompress($compressed);
1896 }
1897
1898 sub decodeGitBinaryPatch($$)
1899 {
1900     my ($contents, $fullPath) = @_;
1901
1902     # Git binary patch has two chunks. One is for the normal patching
1903     # and another is for the reverse patching.
1904     #
1905     # Each chunk a line which starts from either "literal" or "delta",
1906     # followed by a number which specifies decoded size of the chunk.
1907     #
1908     # Then, content of the chunk comes. To decode the content, we
1909     # need decode it with base85 first, and then zlib.
1910     my $gitPatchRegExp = '(literal|delta) ([0-9]+)\n([A-Za-z0-9!#$%&()*+-;<=>?@^_`{|}~\\n]*?)\n\n';
1911     if ($contents !~ m"\nGIT binary patch\n$gitPatchRegExp$gitPatchRegExp\Z") {
1912         die "$fullPath: unknown git binary patch format"
1913     }
1914
1915     my $binaryChunkType = $1;
1916     my $binaryChunkExpectedSize = $2;
1917     my $encodedChunk = $3;
1918     my $reverseBinaryChunkType = $4;
1919     my $reverseBinaryChunkExpectedSize = $5;
1920     my $encodedReverseChunk = $6;
1921
1922     my $binaryChunk = decodeGitBinaryChunk($encodedChunk, $fullPath);
1923     my $binaryChunkActualSize = length($binaryChunk);
1924     my $reverseBinaryChunk = decodeGitBinaryChunk($encodedReverseChunk, $fullPath);
1925     my $reverseBinaryChunkActualSize = length($reverseBinaryChunk);
1926
1927     die "$fullPath: unexpected size of the first chunk (expected $binaryChunkExpectedSize but was $binaryChunkActualSize" if ($binaryChunkType eq "literal" and $binaryChunkExpectedSize != $binaryChunkActualSize);
1928     die "$fullPath: unexpected size of the second chunk (expected $reverseBinaryChunkExpectedSize but was $reverseBinaryChunkActualSize" if ($reverseBinaryChunkType eq "literal" and $reverseBinaryChunkExpectedSize != $reverseBinaryChunkActualSize);
1929
1930     return ($binaryChunkType, $binaryChunk, $reverseBinaryChunkType, $reverseBinaryChunk);
1931 }
1932
1933 sub readByte($$)
1934 {
1935     my ($data, $location) = @_;
1936
1937     # Return the byte at $location in $data as a numeric value.
1938     return ord(substr($data, $location, 1));
1939 }
1940
1941 # The git binary delta format is undocumented, except in code:
1942 # - https://github.com/git/git/blob/master/delta.h:get_delta_hdr_size is the source
1943 #   of the algorithm in decodeGitBinaryPatchDeltaSize.
1944 # - https://github.com/git/git/blob/master/patch-delta.c:patch_delta is the source
1945 #   of the algorithm in applyGitBinaryPatchDelta.
1946 sub decodeGitBinaryPatchDeltaSize($)
1947 {
1948     my ($binaryChunk) = @_;
1949
1950     # Source and destination buffer sizes are stored in 7-bit chunks at the
1951     # start of the binary delta patch data.  The highest bit in each byte
1952     # except the last is set; the remaining 7 bits provide the next
1953     # chunk of the size.  The chunks are stored in ascending significance
1954     # order.
1955     my $cmd;
1956     my $size = 0;
1957     my $shift = 0;
1958     for (my $i = 0; $i < length($binaryChunk);) {
1959         $cmd = readByte($binaryChunk, $i++);
1960         $size |= ($cmd & 0x7f) << $shift;
1961         $shift += 7;
1962         if (!($cmd & 0x80)) {
1963             return ($size, $i);
1964         }
1965     }
1966 }
1967
1968 sub applyGitBinaryPatchDelta($$)
1969 {
1970     my ($binaryChunk, $originalContents) = @_;
1971
1972     # Git delta format consists of two headers indicating source buffer size
1973     # and result size, then a series of commands.  Each command is either
1974     # a copy-from-old-version (the 0x80 bit is set) or a copy-from-delta
1975     # command.  Commands are applied sequentially to generate the result.
1976     #
1977     # A copy-from-old-version command encodes an offset and size to copy
1978     # from in subsequent bits, while a copy-from-delta command consists only
1979     # of the number of bytes to copy from the delta.
1980
1981     # We don't use these values, but we need to know how big they are so that
1982     # we can skip to the diff data.
1983     my ($size, $bytesUsed) = decodeGitBinaryPatchDeltaSize($binaryChunk);
1984     $binaryChunk = substr($binaryChunk, $bytesUsed);
1985     ($size, $bytesUsed) = decodeGitBinaryPatchDeltaSize($binaryChunk);
1986     $binaryChunk = substr($binaryChunk, $bytesUsed);
1987
1988     my $out = "";
1989     for (my $i = 0; $i < length($binaryChunk); ) {
1990         my $cmd = ord(substr($binaryChunk, $i++, 1));
1991         if ($cmd & 0x80) {
1992             # Extract an offset and size from the delta data, then copy
1993             # $size bytes from $offset in the original data into the output.
1994             my $offset = 0;
1995             my $size = 0;
1996             if ($cmd & 0x01) { $offset = readByte($binaryChunk, $i++); }
1997             if ($cmd & 0x02) { $offset |= readByte($binaryChunk, $i++) << 8; }
1998             if ($cmd & 0x04) { $offset |= readByte($binaryChunk, $i++) << 16; }
1999             if ($cmd & 0x08) { $offset |= readByte($binaryChunk, $i++) << 24; }
2000             if ($cmd & 0x10) { $size = readByte($binaryChunk, $i++); }
2001             if ($cmd & 0x20) { $size |= readByte($binaryChunk, $i++) << 8; }
2002             if ($cmd & 0x40) { $size |= readByte($binaryChunk, $i++) << 16; }
2003             if ($size == 0) { $size = 0x10000; }
2004             $out .= substr($originalContents, $offset, $size);
2005         } elsif ($cmd) {
2006             # Copy $cmd bytes from the delta data into the output.
2007             $out .= substr($binaryChunk, $i, $cmd);
2008             $i += $cmd;
2009         } else {
2010             die "unexpected delta opcode 0";
2011         }
2012     }
2013
2014     return $out;
2015 }
2016
2017 sub escapeSubversionPath($)
2018 {
2019     my ($path) = @_;
2020     $path .= "@" if $path =~ /@/;
2021     return $path;
2022 }
2023
2024 sub runCommand(@)
2025 {
2026     my @args = @_;
2027     my $pid = open(CHILD, "-|");
2028     if (!defined($pid)) {
2029         die "Failed to fork(): $!";
2030     }
2031     if ($pid) {
2032         # Parent process
2033         my $childStdout;
2034         while (<CHILD>) {
2035             $childStdout .= $_;
2036         }
2037         close(CHILD);
2038         my %childOutput;
2039         $childOutput{exitStatus} = exitStatus($?);
2040         $childOutput{stdout} = $childStdout if $childStdout;
2041         return \%childOutput;
2042     }
2043     # Child process
2044     # FIXME: Consider further hardening of this function, including sanitizing the environment.
2045     exec { $args[0] } @args or die "Failed to exec(): $!";
2046 }
2047
2048 1;