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
 448     return $fullPath;
 449 }
 450
 451 sub canonicalizePath($)
 452 {
 453     my ($file) = @_;
 454
 455     # Remove extra slashes and '.' directories in path
 456     $file = File::Spec->canonpath($file);
 457
 458     # Remove '..' directories in path
 459     my @dirs = ();
 460     foreach my $dir (File::Spec->splitdir($file)) {
 461         if ($dir eq '..' && $#dirs >= 0 && $dirs[$#dirs] ne '..') {
 462             pop(@dirs);
 463         } else {
 464             push(@dirs, $dir);
 465         }
 466     }
 467     return ($#dirs >= 0) ? File::Spec->catdir(@dirs) : ".";
 468 }
 469
 470 sub removeEOL($)
 471 {
 472     my ($line) = @_;
 473     return "" unless $line;
 474
 475     $line =~ s/[\r\n]+$//g;
 476     return $line;
 477 }
 478
 479 sub parseFirstEOL($)
 480 {
 481     my ($fileHandle) = @_;
 482
 483     # Make input record separator the new-line character to simplify regex matching below.
 484     my $savedInputRecordSeparator = $INPUT_RECORD_SEPARATOR;
 485     $INPUT_RECORD_SEPARATOR = "\n";
 486     my $firstLine  = <$fileHandle>;
 487     $INPUT_RECORD_SEPARATOR = $savedInputRecordSeparator;
 488
 489     return unless defined($firstLine);
 490
 491     my $eol;
 492     if ($firstLine =~ /\r\n/) {
 493         $eol = "\r\n";
 494     } elsif ($firstLine =~ /\r/) {
 495         $eol = "\r";
 496     } elsif ($firstLine =~ /\n/) {
 497         $eol = "\n";
 498     }
 499     return $eol;
 500 }
 501
 502 sub firstEOLInFile($)
 503 {
 504     my ($file) = @_;
 505     my $eol;
 506     if (open(FILE, $file)) {
 507         $eol = parseFirstEOL(*FILE);
 508         close(FILE);
 509     }
 510     return $eol;
 511 }
 512
 513 # Parses a chunk range line into its components.
 514 #
 515 # A chunk range line has the form: @@ -L_1,N_1 +L_2,N_2 @@, where the pairs (L_1, N_1),
 516 # (L_2, N_2) are ranges that represent the starting line number and line count in the
 517 # original file and new file, respectively.
 518 #
 519 # Note, some versions of GNU diff may omit the comma and trailing line count (e.g. N_1),
 520 # in which case the omitted line count defaults to 1. For example, GNU diff may output
 521 # @@ -1 +1 @@, which is equivalent to @@ -1,1 +1,1 @@.
 522 #
 523 # This subroutine returns undef if given an invalid or malformed chunk range.
 524 #
 525 # Args:
 526 #   $line: the line to parse.
 527 #
 528 # Returns $chunkRangeHashRef
 529 #   $chunkRangeHashRef: a hash reference representing the parts of a chunk range, as follows--
 530 #     startingLine: the starting line in the original file.
 531 #     lineCount: the line count in the original file.
 532 #     newStartingLine: the new starting line in the new file.
 533 #     newLineCount: the new line count in the new file.
 534 sub parseChunkRange($)
 535 {
 536     my ($line) = @_;
 537     my $chunkRangeRegEx = qr#^\@\@ -(\d+)(,(\d+))? \+(\d+)(,(\d+))? \@\@#;
 538     if ($line !~ /$chunkRangeRegEx/) {
 539         return;
 540     }
 541     my %chunkRange;
 542     $chunkRange{startingLine} = $1;
 543     $chunkRange{lineCount} = defined($2) ? $3 : 1;
 544     $chunkRange{newStartingLine} = $4;
 545     $chunkRange{newLineCount} = defined($5) ? $6 : 1;
 546     return \%chunkRange;
 547 }
 548
 549 sub svnStatus($)
 550 {
 551     my ($fullPath) = @_;
 552     my $escapedFullPath = escapeSubversionPath($fullPath);
 553     my $svnStatus;
 554     open SVN, "svn status --non-interactive --non-recursive '$escapedFullPath' |" or die;
 555     if (-d $fullPath) {
 556         # When running "svn stat" on a directory, we can't assume that only one
 557         # status will be returned (since any files with a status below the
 558         # directory will be returned), and we can't assume that the directory will
 559         # be first (since any files with unknown status will be listed first).
 560         my $normalizedFullPath = File::Spec->catdir(File::Spec->splitdir($fullPath));
 561         while (<SVN>) {
 562             # Input may use a different EOL sequence than $/, so avoid chomp.
 563             $_ = removeEOL($_);
 564             my $normalizedStatPath = File::Spec->catdir(File::Spec->splitdir(substr($_, 7)));
 565             if ($normalizedFullPath eq $normalizedStatPath) {
 566                 $svnStatus = "$_\n";
 567                 last;
 568             }
 569         }
 570         # Read the rest of the svn command output to avoid a broken pipe warning.
 571         local $/ = undef;
 572         <SVN>;
 573     }
 574     else {
 575         # Files will have only one status returned.
 576         $svnStatus = removeEOL(<SVN>) . "\n";
 577     }
 578     close SVN;
 579     return $svnStatus;
 580 }
 581
 582 # Return whether the given file mode is executable in the source control
 583 # sense.  We make this determination based on whether the executable bit
 584 # is set for "others" rather than the stronger condition that it be set
 585 # for the user, group, and others.  This is sufficient for distinguishing
 586 # the default behavior in Git and SVN.
 587 #
 588 # Args:
 589 #   $fileMode: A number or string representing a file mode in octal notation.
 590 sub isExecutable($)
 591 {
 592     my $fileMode = shift;
 593
 594     return $fileMode % 2;
 595 }
 596
 597 # Parse the next Git diff header from the given file handle, and advance
 598 # the handle so the last line read is the first line after the header.
 599 #
 600 # This subroutine dies if given leading junk.
 601 #
 602 # Args:
 603 #   $fileHandle: advanced so the last line read from the handle is the first
 604 #                line of the header to parse.  This should be a line
 605 #                beginning with "diff --git".
 606 #   $line: the line last read from $fileHandle
 607 #
 608 # Returns ($headerHashRef, $lastReadLine):
 609 #   $headerHashRef: a hash reference representing a diff header, as follows--
 610 #     copiedFromPath: the path from which the file was copied or moved if
 611 #                     the diff is a copy or move.
 612 #     executableBitDelta: the value 1 or -1 if the executable bit was added or
 613 #                         removed, respectively.  New and deleted files have
 614 #                         this value only if the file is executable, in which
 615 #                         case the value is 1 and -1, respectively.
 616 #     indexPath: the path of the target file.
 617 #     isBinary: the value 1 if the diff is for a binary file.
 618 #     isDeletion: the value 1 if the diff is a file deletion.
 619 #     isCopyWithChanges: the value 1 if the file was copied or moved and
 620 #                        the target file was changed in some way after being
 621 #                        copied or moved (e.g. if its contents or executable
 622 #                        bit were changed).
 623 #     isNew: the value 1 if the diff is for a new file.
 624 #     shouldDeleteSource: the value 1 if the file was copied or moved and
 625 #                         the source file was deleted -- i.e. if the copy
 626 #                         was actually a move.
 627 #     svnConvertedText: the header text with some lines converted to SVN
 628 #                       format.  Git-specific lines are preserved.
 629 #   $lastReadLine: the line last read from $fileHandle.
 630 sub parseGitDiffHeader($$)
 631 {
 632     my ($fileHandle, $line) = @_;
 633
 634     $_ = $line;
 635
 636     my $indexPath;
 637     if (/$gitDiffStartRegEx/) {
 638         # The first and second paths can differ in the case of copies
 639         # and renames.  We use the second file path because it is the
 640         # destination path.
 641         $indexPath = adjustPathForRecentRenamings($4);
 642         # Use $POSTMATCH to preserve the end-of-line character.
 643         $_ = "Index: $indexPath$POSTMATCH"; # Convert to SVN format.
 644     } else {
 645         die("Could not parse leading \"diff --git\" line: \"$line\".");
 646     }
 647
 648     my $copiedFromPath;
 649     my $foundHeaderEnding;
 650     my $isBinary;
 651     my $isDeletion;
 652     my $isNew;
 653     my $newExecutableBit = 0;
 654     my $oldExecutableBit = 0;
 655     my $shouldDeleteSource = 0;
 656     my $similarityIndex = 0;
 657     my $svnConvertedText;
 658     while (1) {
 659         # Temporarily strip off any end-of-line characters to simplify
 660         # regex matching below.
 661         s/([\n\r]+)$//;
 662         my $eol = $1;
 663
 664         if (/^(deleted file|old) mode (\d+)/) {
 665             $oldExecutableBit = (isExecutable($2) ? 1 : 0);
 666             $isDeletion = 1 if $1 eq "deleted file";
 667         } elsif (/^new( file)? mode (\d+)/) {
 668             $newExecutableBit = (isExecutable($2) ? 1 : 0);
 669             $isNew = 1 if $1;
 670         } elsif (/^similarity index (\d+)%/) {
 671             $similarityIndex = $1;
 672         } elsif (/^copy from (\S+)/) {
 673             $copiedFromPath = $1;
 674         } elsif (/^rename from (\S+)/) {
 675             # FIXME: Record this as a move rather than as a copy-and-delete.
 676             #        This will simplify adding rename support to svn-unapply.
 677             #        Otherwise, the hash for a deletion would have to know
 678             #        everything about the file being deleted in order to
 679             #        support undoing itself.  Recording as a move will also
 680             #        permit us to use "svn move" and "git move".
 681             $copiedFromPath = $1;
 682             $shouldDeleteSource = 1;
 683         } elsif (/^--- \S+/) {
 684             $_ = "--- $indexPath"; # Convert to SVN format.
 685         } elsif (/^\+\+\+ \S+/) {
 686             $_ = "+++ $indexPath"; # Convert to SVN format.
 687             $foundHeaderEnding = 1;
 688         } elsif (/^GIT binary patch$/ ) {
 689             $isBinary = 1;
 690             $foundHeaderEnding = 1;
 691         # The "git diff" command includes a line of the form "Binary files
 692         # <path1> and <path2> differ" if the --binary flag is not used.
 693         } elsif (/^Binary files / ) {
 694             die("Error: the Git diff contains a binary file without the binary data in ".
 695                 "line: \"$_\".  Be sure to use the --binary flag when invoking \"git diff\" ".
 696                 "with diffs containing binary files.");
 697         }
 698
 699         $svnConvertedText .= "$_$eol"; # Also restore end-of-line characters.
 700
 701         $_ = <$fileHandle>; # Not defined if end-of-file reached.
 702
 703         last if (!defined($_) || /$gitDiffStartRegEx/ || $foundHeaderEnding);
 704     }
 705
 706     my $executableBitDelta = $newExecutableBit - $oldExecutableBit;
 707
 708     my %header;
 709
 710     $header{copiedFromPath} = $copiedFromPath if $copiedFromPath;
 711     $header{executableBitDelta} = $executableBitDelta if $executableBitDelta;
 712     $header{indexPath} = $indexPath;
 713     $header{isBinary} = $isBinary if $isBinary;
 714     $header{isCopyWithChanges} = 1 if ($copiedFromPath && ($similarityIndex != 100 || $executableBitDelta));
 715     $header{isDeletion} = $isDeletion if $isDeletion;
 716     $header{isNew} = $isNew if $isNew;
 717     $header{shouldDeleteSource} = $shouldDeleteSource if $shouldDeleteSource;
 718     $header{svnConvertedText} = $svnConvertedText;
 719
 720     return (\%header, $_);
 721 }
 722
 723 # Parse the next SVN diff header from the given file handle, and advance
 724 # the handle so the last line read is the first line after the header.
 725 #
 726 # This subroutine dies if given leading junk or if it could not detect
 727 # the end of the header block.
 728 #
 729 # Args:
 730 #   $fileHandle: advanced so the last line read from the handle is the first
 731 #                line of the header to parse.  This should be a line
 732 #                beginning with "Index:".
 733 #   $line: the line last read from $fileHandle
 734 #
 735 # Returns ($headerHashRef, $lastReadLine):
 736 #   $headerHashRef: a hash reference representing a diff header, as follows--
 737 #     copiedFromPath: the path from which the file was copied if the diff
 738 #                     is a copy.
 739 #     indexPath: the path of the target file, which is the path found in
 740 #                the "Index:" line.
 741 #     isBinary: the value 1 if the diff is for a binary file.
 742 #     isNew: the value 1 if the diff is for a new file.
 743 #     sourceRevision: the revision number of the source, if it exists.  This
 744 #                     is the same as the revision number the file was copied
 745 #                     from, in the case of a file copy.
 746 #     svnConvertedText: the header text converted to a header with the paths
 747 #                       in some lines corrected.
 748 #   $lastReadLine: the line last read from $fileHandle.
 749 sub parseSvnDiffHeader($$)
 750 {
 751     my ($fileHandle, $line) = @_;
 752
 753     $_ = $line;
 754
 755     my $indexPath;
 756     if (/$svnDiffStartRegEx/) {
 757         $indexPath = adjustPathForRecentRenamings($1);
 758     } else {
 759         die("First line of SVN diff does not begin with \"Index \": \"$_\"");
 760     }
 761
 762     my $copiedFromPath;
 763     my $foundHeaderEnding;
 764     my $isBinary;
 765     my $isNew;
 766     my $sourceRevision;
 767     my $svnConvertedText;
 768     while (1) {
 769         # Temporarily strip off any end-of-line characters to simplify
 770         # regex matching below.
 771         s/([\n\r]+)$//;
 772         my $eol = $1;
 773
 774         # Fix paths on "---" and "+++" lines to match the leading
 775         # index line.
 776         if (s/^--- [^\t\n\r]+/--- $indexPath/) {
 777             # ---
 778             if (/^--- .+\(revision (\d+)\)/) {
 779                 $sourceRevision = $1;
 780                 $isNew = 1 if !$sourceRevision; # if revision 0.
 781                 if (/\(from (\S+):(\d+)\)$/) {
 782                     # The "from" clause is created by svn-create-patch, in
 783                     # which case there is always also a "revision" clause.
 784                     $copiedFromPath = $1;
 785                     die("Revision number \"$2\" in \"from\" clause does not match " .
 786                         "source revision number \"$sourceRevision\".") if ($2 != $sourceRevision);
 787                 }
 788             }
 789         } elsif (s/^\+\+\+ [^\t\n\r]+/+++ $indexPath/) {
 790             $foundHeaderEnding = 1;
 791         } elsif (/^Cannot display: file marked as a binary type.$/) {
 792             $isBinary = 1;
 793             $foundHeaderEnding = 1;
 794         }
 795
 796         $svnConvertedText .= "$_$eol"; # Also restore end-of-line characters.
 797
 798         $_ = <$fileHandle>; # Not defined if end-of-file reached.
 799
 800         last if (!defined($_) || /$svnDiffStartRegEx/ || $foundHeaderEnding);
 801     }
 802
 803     if (!$foundHeaderEnding) {
 804         die("Did not find end of header block corresponding to index path \"$indexPath\".");
 805     }
 806
 807     my %header;
 808
 809     $header{copiedFromPath} = $copiedFromPath if $copiedFromPath;
 810     $header{indexPath} = $indexPath;
 811     $header{isBinary} = $isBinary if $isBinary;
 812     $header{isNew} = $isNew if $isNew;
 813     $header{sourceRevision} = $sourceRevision if $sourceRevision;
 814     $header{svnConvertedText} = $svnConvertedText;
 815
 816     return (\%header, $_);
 817 }
 818
 819 # Parse the next diff header from the given file handle, and advance
 820 # the handle so the last line read is the first line after the header.
 821 #
 822 # This subroutine dies if given leading junk or if it could not detect
 823 # the end of the header block.
 824 #
 825 # Args:
 826 #   $fileHandle: advanced so the last line read from the handle is the first
 827 #                line of the header to parse.  For SVN-formatted diffs, this
 828 #                is a line beginning with "Index:".  For Git, this is a line
 829 #                beginning with "diff --git".
 830 #   $line: the line last read from $fileHandle
 831 #
 832 # Returns ($headerHashRef, $lastReadLine):
 833 #   $headerHashRef: a hash reference representing a diff header
 834 #     copiedFromPath: the path from which the file was copied if the diff
 835 #                     is a copy.
 836 #     executableBitDelta: the value 1 or -1 if the executable bit was added or
 837 #                         removed, respectively.  New and deleted files have
 838 #                         this value only if the file is executable, in which
 839 #                         case the value is 1 and -1, respectively.
 840 #     indexPath: the path of the target file.
 841 #     isBinary: the value 1 if the diff is for a binary file.
 842 #     isGit: the value 1 if the diff is Git-formatted.
 843 #     isSvn: the value 1 if the diff is SVN-formatted.
 844 #     sourceRevision: the revision number of the source, if it exists.  This
 845 #                     is the same as the revision number the file was copied
 846 #                     from, in the case of a file copy.
 847 #     svnConvertedText: the header text with some lines converted to SVN
 848 #                       format.  Git-specific lines are preserved.
 849 #   $lastReadLine: the line last read from $fileHandle.
 850 sub parseDiffHeader($$)
 851 {
 852     my ($fileHandle, $line) = @_;
 853
 854     my $header;  # This is a hash ref.
 855     my $isGit;
 856     my $isSvn;
 857     my $lastReadLine;
 858
 859     if ($line =~ $svnDiffStartRegEx) {
 860         $isSvn = 1;
 861         ($header, $lastReadLine) = parseSvnDiffHeader($fileHandle, $line);
 862     } elsif ($line =~ $gitDiffStartRegEx) {
 863         $isGit = 1;
 864         ($header, $lastReadLine) = parseGitDiffHeader($fileHandle, $line);
 865     } else {
 866         die("First line of diff does not begin with \"Index:\" or \"diff --git\": \"$line\"");
 867     }
 868
 869     $header->{isGit} = $isGit if $isGit;
 870     $header->{isSvn} = $isSvn if $isSvn;
 871
 872     return ($header, $lastReadLine);
 873 }
 874
 875 # FIXME: The %diffHash "object" should not have an svnConvertedText property.
 876 #        Instead, the hash object should store its information in a
 877 #        structured way as properties.  This should be done in a way so
 878 #        that, if necessary, the text of an SVN or Git patch can be
 879 #        reconstructed from the information in those hash properties.
 880 #
 881 # A %diffHash is a hash representing a source control diff of a single
 882 # file operation (e.g. a file modification, copy, or delete).
 883 #
 884 # These hashes appear, for example, in the parseDiff(), parsePatch(),
 885 # and prepareParsedPatch() subroutines of this package.
 886 #
 887 # The corresponding values are--
 888 #
 889 #   copiedFromPath: the path from which the file was copied if the diff
 890 #                   is a copy.
 891 #   executableBitDelta: the value 1 or -1 if the executable bit was added or
 892 #                       removed from the target file, respectively.
 893 #   indexPath: the path of the target file.  For SVN-formatted diffs,
 894 #              this is the same as the path in the "Index:" line.
 895 #   isBinary: the value 1 if the diff is for a binary file.
 896 #   isDeletion: the value 1 if the diff is known from the header to be a deletion.
 897 #   isGit: the value 1 if the diff is Git-formatted.
 898 #   isNew: the value 1 if the dif is known from the header to be a new file.
 899 #   isSvn: the value 1 if the diff is SVN-formatted.
 900 #   sourceRevision: the revision number of the source, if it exists.  This
 901 #                   is the same as the revision number the file was copied
 902 #                   from, in the case of a file copy.
 903 #   svnConvertedText: the diff with some lines converted to SVN format.
 904 #                     Git-specific lines are preserved.
 905
 906 # Parse one diff from a patch file created by svn-create-patch, and
 907 # advance the file handle so the last line read is the first line
 908 # of the next header block.
 909 #
 910 # This subroutine preserves any leading junk encountered before the header.
 911 #
 912 # Composition of an SVN diff
 913 #
 914 # There are three parts to an SVN diff: the header, the property change, and
 915 # the binary contents, in that order. Either the header or the property change
 916 # may be ommitted, but not both. If there are binary changes, then you always
 917 # have all three.
 918 #
 919 # Args:
 920 #   $fileHandle: a file handle advanced to the first line of the next
 921 #                header block. Leading junk is okay.
 922 #   $line: the line last read from $fileHandle.
 923 #   $optionsHashRef: a hash reference representing optional options to use
 924 #                    when processing a diff.
 925 #     shouldNotUseIndexPathEOL: whether to use the line endings in the diff instead
 926 #                               instead of the line endings in the target file; the
 927 #                               value of 1 if svnConvertedText should use the line
 928 #                               endings in the diff.
 929 #
 930 # Returns ($diffHashRefs, $lastReadLine):
 931 #   $diffHashRefs: A reference to an array of references to %diffHash hashes.
 932 #                  See the %diffHash documentation above.
 933 #   $lastReadLine: the line last read from $fileHandle
 934 sub parseDiff($$;$)
 935 {
 936     # FIXME: Adjust this method so that it dies if the first line does not
 937     #        match the start of a diff.  This will require a change to
 938     #        parsePatch() so that parsePatch() skips over leading junk.
 939     my ($fileHandle, $line, $optionsHashRef) = @_;
 940
 941     my $headerStartRegEx = $svnDiffStartRegEx; # SVN-style header for the default
 942
 943     my $headerHashRef; # Last header found, as returned by parseDiffHeader().
 944     my $svnPropertiesHashRef; # Last SVN properties diff found, as returned by parseSvnDiffProperties().
 945     my $svnText;
 946     my $indexPathEOL;
 947     my $numTextChunks = 0;
 948     while (defined($line)) {
 949         if (!$headerHashRef && ($line =~ $gitDiffStartRegEx)) {
 950             # Then assume all diffs in the patch are Git-formatted. This
 951             # block was made to be enterable at most once since we assume
 952             # all diffs in the patch are formatted the same (SVN or Git).
 953             $headerStartRegEx = $gitDiffStartRegEx;
 954         }
 955
 956         if ($line =~ $svnPropertiesStartRegEx) {
 957             my $propertyPath = $1;
 958             if ($svnPropertiesHashRef || $headerHashRef && ($propertyPath ne $headerHashRef->{indexPath})) {
 959                 # This is the start of the second diff in the while loop, which happens to
 960                 # be a property diff.  If $svnPropertiesHasRef is defined, then this is the
 961                 # second consecutive property diff, otherwise it's the start of a property
 962                 # diff for a file that only has property changes.
 963                 last;
 964             }
 965             ($svnPropertiesHashRef, $line) = parseSvnDiffProperties($fileHandle, $line);
 966             next;
 967         }
 968         if ($line !~ $headerStartRegEx) {
 969             # Then we are in the body of the diff.
 970             my $isChunkRange = defined(parseChunkRange($line));
 971             $numTextChunks += 1 if $isChunkRange;
 972             if ($indexPathEOL && !$isChunkRange) {
 973                 # The chunk range is part of the body of the diff, but its line endings should't be
 974                 # modified or patch(1) will complain. So, we only modify non-chunk range lines.
 975                 $line =~ s/\r\n|\r|\n/$indexPathEOL/g;
 976             }
 977             $svnText .= $line;
 978             $line = <$fileHandle>;
 979             next;
 980         } # Otherwise, we found a diff header.
 981
 982         if ($svnPropertiesHashRef || $headerHashRef) {
 983             # Then either we just processed an SVN property change or this
 984             # is the start of the second diff header of this while loop.
 985             last;
 986         }
 987
 988         ($headerHashRef, $line) = parseDiffHeader($fileHandle, $line);
 989         if (!$optionsHashRef || !$optionsHashRef->{shouldNotUseIndexPathEOL}) {
 990             $indexPathEOL = firstEOLInFile($headerHashRef->{indexPath}) if !$headerHashRef->{isNew} && !$headerHashRef->{isBinary};
 991         }
 992
 993         $svnText .= $headerHashRef->{svnConvertedText};
 994     }
 995
 996     my @diffHashRefs;
 997
 998     if ($headerHashRef->{shouldDeleteSource}) {
 999         my %deletionHash;
1000         $deletionHash{indexPath} = $headerHashRef->{copiedFromPath};
1001         $deletionHash{isDeletion} = 1;
1002         push @diffHashRefs, \%deletionHash;
1003     }
1004     if ($headerHashRef->{copiedFromPath}) {
1005         my %copyHash;
1006         $copyHash{copiedFromPath} = $headerHashRef->{copiedFromPath};
1007         $copyHash{indexPath} = $headerHashRef->{indexPath};
1008         $copyHash{sourceRevision} = $headerHashRef->{sourceRevision} if $headerHashRef->{sourceRevision};
1009         if ($headerHashRef->{isSvn}) {
1010             $copyHash{executableBitDelta} = $svnPropertiesHashRef->{executableBitDelta} if $svnPropertiesHashRef->{executableBitDelta};
1011         }
1012         push @diffHashRefs, \%copyHash;
1013     }
1014
1015     # Note, the order of evaluation for the following if conditional has been explicitly chosen so that
1016     # it evaluates to false when there is no headerHashRef (e.g. a property change diff for a file that
1017     # only has property changes).
1018     if ($headerHashRef->{isCopyWithChanges} || (%$headerHashRef && !$headerHashRef->{copiedFromPath})) {
1019         # Then add the usual file modification.
1020         my %diffHash;
1021         # FIXME: We should expand this code to support other properties.  In the future,
1022         #        parseSvnDiffProperties may return a hash whose keys are the properties.
1023         if ($headerHashRef->{isSvn}) {
1024             # SVN records the change to the executable bit in a separate property change diff
1025             # that follows the contents of the diff, except for binary diffs.  For binary
1026             # diffs, the property change diff follows the diff header.
1027             $diffHash{executableBitDelta} = $svnPropertiesHashRef->{executableBitDelta} if $svnPropertiesHashRef->{executableBitDelta};
1028         } elsif ($headerHashRef->{isGit}) {
1029             # Git records the change to the executable bit in the header of a diff.
1030             $diffHash{executableBitDelta} = $headerHashRef->{executableBitDelta} if $headerHashRef->{executableBitDelta};
1031         }
1032         $diffHash{indexPath} = $headerHashRef->{indexPath};
1033         $diffHash{isBinary} = $headerHashRef->{isBinary} if $headerHashRef->{isBinary};
1034         $diffHash{isDeletion} = $headerHashRef->{isDeletion} if $headerHashRef->{isDeletion};
1035         $diffHash{isGit} = $headerHashRef->{isGit} if $headerHashRef->{isGit};
1036         $diffHash{isNew} = $headerHashRef->{isNew} if $headerHashRef->{isNew};
1037         $diffHash{isSvn} = $headerHashRef->{isSvn} if $headerHashRef->{isSvn};
1038         if (!$headerHashRef->{copiedFromPath}) {
1039             # If the file was copied, then we have already incorporated the
1040             # sourceRevision information into the change.
1041             $diffHash{sourceRevision} = $headerHashRef->{sourceRevision} if $headerHashRef->{sourceRevision};
1042         }
1043         # FIXME: Remove the need for svnConvertedText.  See the %diffHash
1044         #        code comments above for more information.
1045         #
1046         # Note, we may not always have SVN converted text since we intend
1047         # to deprecate it in the future.  For example, a property change
1048         # diff for a file that only has property changes will not return
1049         # any SVN converted text.
1050         $diffHash{svnConvertedText} = $svnText if $svnText;
1051         $diffHash{numTextChunks} = $numTextChunks if $svnText && !$headerHashRef->{isBinary};
1052         push @diffHashRefs, \%diffHash;
1053     }
1054
1055     if (!%$headerHashRef && $svnPropertiesHashRef) {
1056         # A property change diff for a file that only has property changes.
1057         my %propertyChangeHash;
1058         $propertyChangeHash{executableBitDelta} = $svnPropertiesHashRef->{executableBitDelta} if $svnPropertiesHashRef->{executableBitDelta};
1059         $propertyChangeHash{indexPath} = $svnPropertiesHashRef->{propertyPath};
1060         $propertyChangeHash{isSvn} = 1;
1061         push @diffHashRefs, \%propertyChangeHash;
1062     }
1063
1064     return (\@diffHashRefs, $line);
1065 }
1066
1067 # Parse an SVN property change diff from the given file handle, and advance
1068 # the handle so the last line read is the first line after this diff.
1069 #
1070 # For the case of an SVN binary diff, the binary contents will follow the
1071 # the property changes.
1072 #
1073 # This subroutine dies if the first line does not begin with "Property changes on"
1074 # or if the separator line that follows this line is missing.
1075 #
1076 # Args:
1077 #   $fileHandle: advanced so the last line read from the handle is the first
1078 #                line of the footer to parse.  This line begins with
1079 #                "Property changes on".
1080 #   $line: the line last read from $fileHandle.
1081 #
1082 # Returns ($propertyHashRef, $lastReadLine):
1083 #   $propertyHashRef: a hash reference representing an SVN diff footer.
1084 #     propertyPath: the path of the target file.
1085 #     executableBitDelta: the value 1 or -1 if the executable bit was added or
1086 #                         removed from the target file, respectively.
1087 #   $lastReadLine: the line last read from $fileHandle.
1088 sub parseSvnDiffProperties($$)
1089 {
1090     my ($fileHandle, $line) = @_;
1091
1092     $_ = $line;
1093
1094     my %footer;
1095     if (/$svnPropertiesStartRegEx/) {
1096         $footer{propertyPath} = $1;
1097     } else {
1098         die("Failed to find start of SVN property change, \"Property changes on \": \"$_\"");
1099     }
1100
1101     # We advance $fileHandle two lines so that the next line that
1102     # we process is $svnPropertyStartRegEx in a well-formed footer.
1103     # A well-formed footer has the form:
1104     # Property changes on: FileA
1105     # ___________________________________________________________________
1106     # Added: svn:executable
1107     #    + *
1108     $_ = <$fileHandle>; # Not defined if end-of-file reached.
1109     my $separator = "_" x 67;
1110     if (defined($_) && /^$separator[\r\n]+$/) {
1111         $_ = <$fileHandle>;
1112     } else {
1113         die("Failed to find separator line: \"$_\".");
1114     }
1115
1116     # FIXME: We should expand this to support other SVN properties
1117     #        (e.g. return a hash of property key-values that represents
1118     #        all properties).
1119     #
1120     # Notice, we keep processing until we hit end-of-file or some
1121     # line that does not resemble $svnPropertyStartRegEx, such as
1122     # the empty line that precedes the start of the binary contents
1123     # of a patch, or the start of the next diff (e.g. "Index:").
1124     my $propertyHashRef;
1125     while (defined($_) && /$svnPropertyStartRegEx/) {
1126         ($propertyHashRef, $_) = parseSvnProperty($fileHandle, $_);
1127         if ($propertyHashRef->{name} eq "svn:executable") {
1128             # Notice, for SVN properties, propertyChangeDelta is always non-zero
1129             # because a property can only be added or removed.
1130             $footer{executableBitDelta} = $propertyHashRef->{propertyChangeDelta};
1131         }
1132     }
1133
1134     return(\%footer, $_);
1135 }
1136
1137 # Parse the next SVN property from the given file handle, and advance the handle so the last
1138 # line read is the first line after the property.
1139 #
1140 # This subroutine dies if the first line is not a valid start of an SVN property,
1141 # or the property is missing a value, or the property change type (e.g. "Added")
1142 # does not correspond to the property value type (e.g. "+").
1143 #
1144 # Args:
1145 #   $fileHandle: advanced so the last line read from the handle is the first
1146 #                line of the property to parse.  This should be a line
1147 #                that matches $svnPropertyStartRegEx.
1148 #   $line: the line last read from $fileHandle.
1149 #
1150 # Returns ($propertyHashRef, $lastReadLine):
1151 #   $propertyHashRef: a hash reference representing a SVN property.
1152 #     name: the name of the property.
1153 #     value: the last property value.  For instance, suppose the property is "Modified".
1154 #            Then it has both a '-' and '+' property value in that order.  Therefore,
1155 #            the value of this key is the value of the '+' property by ordering (since
1156 #            it is the last value).
1157 #     propertyChangeDelta: the value 1 or -1 if the property was added or
1158 #                          removed, respectively.
1159 #   $lastReadLine: the line last read from $fileHandle.
1160 sub parseSvnProperty($$)
1161 {
1162     my ($fileHandle, $line) = @_;
1163
1164     $_ = $line;
1165
1166     my $propertyName;
1167     my $propertyChangeType;
1168     if (/$svnPropertyStartRegEx/) {
1169         $propertyChangeType = $1;
1170         $propertyName = $2;
1171     } else {
1172         die("Failed to find SVN property: \"$_\".");
1173     }
1174
1175     $_ = <$fileHandle>; # Not defined if end-of-file reached.
1176
1177     # The "svn diff" command neither inserts newline characters between property values
1178     # nor between successive properties.
1179     #
1180     # FIXME: We do not support property values that contain tailing newline characters
1181     #        as it is difficult to disambiguate these trailing newlines from the empty
1182     #        line that precedes the contents of a binary patch.
1183     my $propertyValue;
1184     my $propertyValueType;
1185     while (defined($_) && /$svnPropertyValueStartRegEx/) {
1186         # Note, a '-' property may be followed by a '+' property in the case of a "Modified"
1187         # or "Name" property.  We only care about the ending value (i.e. the '+' property)
1188         # in such circumstances.  So, we take the property value for the property to be its
1189         # last parsed property value.
1190         #
1191         # FIXME: We may want to consider strictly enforcing a '-', '+' property ordering or
1192         #        add error checking to prevent '+', '+', ..., '+' and other invalid combinations.
1193         $propertyValueType = $1;
1194         ($propertyValue, $_) = parseSvnPropertyValue($fileHandle, $_);
1195     }
1196
1197     if (!$propertyValue) {
1198         die("Failed to find the property value for the SVN property \"$propertyName\": \"$_\".");
1199     }
1200
1201     my $propertyChangeDelta;
1202     if ($propertyValueType eq "+" || $propertyValueType eq "Merged") {
1203         $propertyChangeDelta = 1;
1204     } elsif ($propertyValueType eq "-" || $propertyValueType eq "Reverse-merged") {
1205         $propertyChangeDelta = -1;
1206     } else {
1207         die("Not reached.");
1208     }
1209
1210     # We perform a simple validation that an "Added" or "Deleted" property
1211     # change type corresponds with a "+" and "-" value type, respectively.
1212     my $expectedChangeDelta;
1213     if ($propertyChangeType eq "Added") {
1214         $expectedChangeDelta = 1;
1215     } elsif ($propertyChangeType eq "Deleted") {
1216         $expectedChangeDelta = -1;
1217     }
1218
1219     if ($expectedChangeDelta && $propertyChangeDelta != $expectedChangeDelta) {
1220         die("The final property value type found \"$propertyValueType\" does not " .
1221             "correspond to the property change type found \"$propertyChangeType\".");
1222     }
1223
1224     my %propertyHash;
1225     $propertyHash{name} = $propertyName;
1226     $propertyHash{propertyChangeDelta} = $propertyChangeDelta;
1227     $propertyHash{value} = $propertyValue;
1228     return (\%propertyHash, $_);
1229 }
1230
1231 # Parse the value of an SVN property from the given file handle, and advance
1232 # the handle so the last line read is the first line after the property value.
1233 #
1234 # This subroutine dies if the first line is an invalid SVN property value line
1235 # (i.e. a line that does not begin with "   +" or "   -").
1236 #
1237 # Args:
1238 #   $fileHandle: advanced so the last line read from the handle is the first
1239 #                line of the property value to parse.  This should be a line
1240 #                beginning with "   +" or "   -".
1241 #   $line: the line last read from $fileHandle.
1242 #
1243 # Returns ($propertyValue, $lastReadLine):
1244 #   $propertyValue: the value of the property.
1245 #   $lastReadLine: the line last read from $fileHandle.
1246 sub parseSvnPropertyValue($$)
1247 {
1248     my ($fileHandle, $line) = @_;
1249
1250     $_ = $line;
1251
1252     my $propertyValue;
1253     my $eol;
1254     if (/$svnPropertyValueStartRegEx/) {
1255         $propertyValue = $2; # Does not include the end-of-line character(s).
1256         $eol = $POSTMATCH;
1257     } else {
1258         die("Failed to find property value beginning with '+', '-', 'Merged', or 'Reverse-merged': \"$_\".");
1259     }
1260
1261     while (<$fileHandle>) {
1262         if (/^[\r\n]+$/ || /$svnPropertyValueStartRegEx/ || /$svnPropertyStartRegEx/) {
1263             # Note, we may encounter an empty line before the contents of a binary patch.
1264             # Also, we check for $svnPropertyValueStartRegEx because a '-' property may be
1265             # followed by a '+' property in the case of a "Modified" or "Name" property.
1266             # We check for $svnPropertyStartRegEx because it indicates the start of the
1267             # next property to parse.
1268             last;
1269         }
1270
1271         # Temporarily strip off any end-of-line characters. We add the end-of-line characters
1272         # from the previously processed line to the start of this line so that the last line
1273         # of the property value does not end in end-of-line characters.
1274         s/([\n\r]+)$//;
1275         $propertyValue .= "$eol$_";
1276         $eol = $1;
1277     }
1278
1279     return ($propertyValue, $_);
1280 }
1281
1282 # Parse a patch file created by svn-create-patch.
1283 #
1284 # Args:
1285 #   $fileHandle: A file handle to the patch file that has not yet been
1286 #                read from.
1287 #   $optionsHashRef: a hash reference representing optional options to use
1288 #                    when processing a diff.
1289 #     shouldNotUseIndexPathEOL: whether to use the line endings in the diff instead
1290 #                               instead of the line endings in the target file; the
1291 #                               value of 1 if svnConvertedText should use the line
1292 #                               endings in the diff.
1293 #
1294 # Returns:
1295 #   @diffHashRefs: an array of diff hash references.
1296 #                  See the %diffHash documentation above.
1297 sub parsePatch($;$)
1298 {
1299     my ($fileHandle, $optionsHashRef) = @_;
1300
1301     my $newDiffHashRefs;
1302     my @diffHashRefs; # return value
1303
1304     my $line = <$fileHandle>;
1305
1306     while (defined($line)) { # Otherwise, at EOF.
1307
1308         ($newDiffHashRefs, $line) = parseDiff($fileHandle, $line, $optionsHashRef);
1309
1310         push @diffHashRefs, @$newDiffHashRefs;
1311     }
1312
1313     return @diffHashRefs;
1314 }
1315
1316 # Prepare the results of parsePatch() for use in svn-apply and svn-unapply.
1317 #
1318 # Args:
1319 #   $shouldForce: Whether to continue processing if an unexpected
1320 #                 state occurs.
1321 #   @diffHashRefs: An array of references to %diffHashes.
1322 #                  See the %diffHash documentation above.
1323 #
1324 # Returns $preparedPatchHashRef:
1325 #   copyDiffHashRefs: A reference to an array of the $diffHashRefs in
1326 #                     @diffHashRefs that represent file copies. The original
1327 #                     ordering is preserved.
1328 #   nonCopyDiffHashRefs: A reference to an array of the $diffHashRefs in
1329 #                        @diffHashRefs that do not represent file copies.
1330 #                        The original ordering is preserved.
1331 #   sourceRevisionHash: A reference to a hash of source path to source
1332 #                       revision number.
1333 sub prepareParsedPatch($@)
1334 {
1335     my ($shouldForce, @diffHashRefs) = @_;
1336
1337     my %copiedFiles;
1338
1339     # Return values
1340     my @copyDiffHashRefs = ();
1341     my @nonCopyDiffHashRefs = ();
1342     my %sourceRevisionHash = ();
1343     for my $diffHashRef (@diffHashRefs) {
1344         my $copiedFromPath = $diffHashRef->{copiedFromPath};
1345         my $indexPath = $diffHashRef->{indexPath};
1346         my $sourceRevision = $diffHashRef->{sourceRevision};
1347         my $sourcePath;
1348
1349         if (defined($copiedFromPath)) {
1350             # Then the diff is a copy operation.
1351             $sourcePath = $copiedFromPath;
1352
1353             # FIXME: Consider printing a warning or exiting if
1354             #        exists($copiedFiles{$indexPath}) is true -- i.e. if
1355             #        $indexPath appears twice as a copy target.
1356             $copiedFiles{$indexPath} = $sourcePath;
1357
1358             push @copyDiffHashRefs, $diffHashRef;
1359         } else {
1360             # Then the diff is not a copy operation.
1361             $sourcePath = $indexPath;
1362
1363             push @nonCopyDiffHashRefs, $diffHashRef;
1364         }
1365
1366         if (defined($sourceRevision)) {
1367             if (exists($sourceRevisionHash{$sourcePath}) &&
1368                 ($sourceRevisionHash{$sourcePath} != $sourceRevision)) {
1369                 if (!$shouldForce) {
1370                     die "Two revisions of the same file required as a source:\n".
1371                         "    $sourcePath:$sourceRevisionHash{$sourcePath}\n".
1372                         "    $sourcePath:$sourceRevision";
1373                 }
1374             }
1375             $sourceRevisionHash{$sourcePath} = $sourceRevision;
1376         }
1377     }
1378
1379     my %preparedPatchHash;
1380
1381     $preparedPatchHash{copyDiffHashRefs} = \@copyDiffHashRefs;
1382     $preparedPatchHash{nonCopyDiffHashRefs} = \@nonCopyDiffHashRefs;
1383     $preparedPatchHash{sourceRevisionHash} = \%sourceRevisionHash;
1384
1385     return \%preparedPatchHash;
1386 }
1387
1388 # Return localtime() for the project's time zone, given an integer time as
1389 # returned by Perl's time() function.
1390 sub localTimeInProjectTimeZone($)
1391 {
1392     my $epochTime = shift;
1393
1394     # Change the time zone temporarily for the localtime() call.
1395     my $savedTimeZone = $ENV{'TZ'};
1396     $ENV{'TZ'} = $changeLogTimeZone;
1397     my @localTime = localtime($epochTime);
1398     if (defined $savedTimeZone) {
1399          $ENV{'TZ'} = $savedTimeZone;
1400     } else {
1401          delete $ENV{'TZ'};
1402     }
1403
1404     return @localTime;
1405 }
1406
1407 # Set the reviewer and date in a ChangeLog patch, and return the new patch.
1408 #
1409 # Args:
1410 #   $patch: a ChangeLog patch as a string.
1411 #   $reviewer: the name of the reviewer, or undef if the reviewer should not be set.
1412 #   $epochTime: an integer time as returned by Perl's time() function.
1413 sub setChangeLogDateAndReviewer($$$)
1414 {
1415     my ($patch, $reviewer, $epochTime) = @_;
1416
1417     my @localTime = localTimeInProjectTimeZone($epochTime);
1418     my $newDate = strftime("%Y-%m-%d", @localTime);
1419
1420     my $firstChangeLogLineRegEx = qr#(\n\+)\d{4}-[^-]{2}-[^-]{2}(  )#;
1421     $patch =~ s/$firstChangeLogLineRegEx/$1$newDate$2/;
1422
1423     if (defined($reviewer)) {
1424         # We include a leading plus ("+") in the regular expression to make
1425         # the regular expression less likely to match text in the leading junk
1426         # for the patch, if the patch has leading junk.
1427         $patch =~ s/(\n\+.*)NOBODY \(OOPS!\)/$1$reviewer/;
1428     }
1429
1430     return $patch;
1431 }
1432
1433 # If possible, returns a ChangeLog patch equivalent to the given one,
1434 # but with the newest ChangeLog entry inserted at the top of the
1435 # file -- i.e. no leading context and all lines starting with "+".
1436 #
1437 # If given a patch string not representable as a patch with the above
1438 # properties, it returns the input back unchanged.
1439 #
1440 # WARNING: This subroutine can return an inequivalent patch string if
1441 # both the beginning of the new ChangeLog file matches the beginning
1442 # of the source ChangeLog, and the source beginning was modified.
1443 # Otherwise, it is guaranteed to return an equivalent patch string,
1444 # if it returns.
1445 #
1446 # Applying this subroutine to ChangeLog patches allows svn-apply to
1447 # insert new ChangeLog entries at the top of the ChangeLog file.
1448 # svn-apply uses patch with --fuzz=3 to do this. We need to apply
1449 # this subroutine because the diff(1) command is greedy when matching
1450 # lines. A new ChangeLog entry with the same date and author as the
1451 # previous will match and cause the diff to have lines of starting
1452 # context.
1453 #
1454 # This subroutine has unit tests in VCSUtils_unittest.pl.
1455 #
1456 # Returns $changeLogHashRef:
1457 #   $changeLogHashRef: a hash reference representing a change log patch.
1458 #     patch: a ChangeLog patch equivalent to the given one, but with the
1459 #            newest ChangeLog entry inserted at the top of the file, if possible.
1460 sub fixChangeLogPatch($)
1461 {
1462     my $patch = shift; # $patch will only contain patch fragments for ChangeLog.
1463
1464     $patch =~ /(\r?\n)/;
1465     my $lineEnding = $1;
1466     my @lines = split(/$lineEnding/, $patch);
1467
1468     my $i = 0; # We reuse the same index throughout.
1469
1470     # Skip to beginning of first chunk.
1471     for (; $i < @lines; ++$i) {
1472         if (substr($lines[$i], 0, 1) eq "@") {
1473             last;
1474         }
1475     }
1476     my $chunkStartIndex = ++$i;
1477     my %changeLogHashRef;
1478
1479     # Optimization: do not process if new lines already begin the chunk.
1480     if (substr($lines[$i], 0, 1) eq "+") {
1481         $changeLogHashRef{patch} = $patch;
1482         return \%changeLogHashRef;
1483     }
1484
1485     # Skip to first line of newly added ChangeLog entry.
1486     # For example, +2009-06-03  Eric Seidel  <eric@webkit.org>
1487     my $dateStartRegEx = '^\+(\d{4}-\d{2}-\d{2})' # leading "+" and date
1488                          . '\s+(.+)\s+' # name
1489                          . '<([^<>]+)>$'; # e-mail address
1490
1491     for (; $i < @lines; ++$i) {
1492         my $line = $lines[$i];
1493         my $firstChar = substr($line, 0, 1);
1494         if ($line =~ /$dateStartRegEx/) {
1495             last;
1496         } elsif ($firstChar eq " " or $firstChar eq "+") {
1497             next;
1498         }
1499         $changeLogHashRef{patch} = $patch; # Do not change if, for example, "-" or "@" found.
1500         return \%changeLogHashRef;
1501     }
1502     if ($i >= @lines) {
1503         $changeLogHashRef{patch} = $patch; # Do not change if date not found.
1504         return \%changeLogHashRef;
1505     }
1506     my $dateStartIndex = $i;
1507
1508     # Rewrite overlapping lines to lead with " ".
1509     my @overlappingLines = (); # These will include a leading "+".
1510     for (; $i < @lines; ++$i) {
1511         my $line = $lines[$i];
1512         if (substr($line, 0, 1) ne "+") {
1513           last;
1514         }
1515         push(@overlappingLines, $line);
1516         $lines[$i] = " " . substr($line, 1);
1517     }
1518
1519     # Remove excess ending context, if necessary.
1520     my $shouldTrimContext = 1;
1521     for (; $i < @lines; ++$i) {
1522         my $firstChar = substr($lines[$i], 0, 1);
1523         if ($firstChar eq " ") {
1524             next;
1525         } elsif ($firstChar eq "@") {
1526             last;
1527         }
1528         $shouldTrimContext = 0; # For example, if "+" or "-" encountered.
1529         last;
1530     }
1531     my $deletedLineCount = 0;
1532     if ($shouldTrimContext) { # Also occurs if end of file reached.
1533         splice(@lines, $i - @overlappingLines, @overlappingLines);
1534         $deletedLineCount = @overlappingLines;
1535     }
1536
1537     # Work backwards, shifting overlapping lines towards front
1538     # while checking that patch stays equivalent.
1539     for ($i = $dateStartIndex - 1; @overlappingLines && $i >= $chunkStartIndex; --$i) {
1540         my $line = $lines[$i];
1541         if (substr($line, 0, 1) ne " ") {
1542             next;
1543         }
1544         my $text = substr($line, 1);
1545         my $newLine = pop(@overlappingLines);
1546         if ($text ne substr($newLine, 1)) {
1547             $changeLogHashRef{patch} = $patch; # Unexpected difference.
1548             return \%changeLogHashRef;
1549         }
1550         $lines[$i] = "+$text";
1551     }
1552
1553     # If @overlappingLines > 0, this is where we make use of the
1554     # assumption that the beginning of the source file was not modified.
1555     splice(@lines, $chunkStartIndex, 0, @overlappingLines);
1556
1557     # Update the date start index as it may have changed after shifting
1558     # the overlapping lines towards the front.
1559     for ($i = $chunkStartIndex; $i < $dateStartIndex; ++$i) {
1560         $dateStartIndex = $i if $lines[$i] =~ /$dateStartRegEx/;
1561     }
1562     splice(@lines, $chunkStartIndex, $dateStartIndex - $chunkStartIndex); # Remove context of later entry.
1563     $deletedLineCount += $dateStartIndex - $chunkStartIndex;
1564
1565     # Update the initial chunk range.
1566     my $chunkRangeHashRef = parseChunkRange($lines[$chunkStartIndex - 1]);
1567     if (!$chunkRangeHashRef) {
1568         # FIXME: Handle errors differently from ChangeLog files that
1569         # are okay but should not be altered. That way we can find out
1570         # if improvements to the script ever become necessary.
1571         $changeLogHashRef{patch} = $patch; # Error: unexpected patch string format.
1572         return \%changeLogHashRef;
1573     }
1574     my $oldSourceLineCount = $chunkRangeHashRef->{lineCount};
1575     my $oldTargetLineCount = $chunkRangeHashRef->{newLineCount};
1576
1577     my $sourceLineCount = $oldSourceLineCount + @overlappingLines - $deletedLineCount;
1578     my $targetLineCount = $oldTargetLineCount + @overlappingLines - $deletedLineCount;
1579     $lines[$chunkStartIndex - 1] = "@@ -1,$sourceLineCount +1,$targetLineCount @@";
1580
1581     $changeLogHashRef{patch} = join($lineEnding, @lines) . "\n"; # patch(1) expects an extra trailing newline.
1582     return \%changeLogHashRef;
1583 }
1584
1585 # This is a supporting method for runPatchCommand.
1586 #
1587 # Arg: the optional $args parameter passed to runPatchCommand (can be undefined).
1588 #
1589 # Returns ($patchCommand, $isForcing).
1590 #
1591 # This subroutine has unit tests in VCSUtils_unittest.pl.
1592 sub generatePatchCommand($)
1593 {
1594     my ($passedArgsHashRef) = @_;
1595
1596     my $argsHashRef = { # Defaults
1597         ensureForce => 0,
1598         shouldReverse => 0,
1599         options => []
1600     };
1601
1602     # Merges hash references. It's okay here if passed hash reference is undefined.
1603     @{$argsHashRef}{keys %{$passedArgsHashRef}} = values %{$passedArgsHashRef};
1604
1605     my $ensureForce = $argsHashRef->{ensureForce};
1606     my $shouldReverse = $argsHashRef->{shouldReverse};
1607     my $options = $argsHashRef->{options};
1608
1609     if (! $options) {
1610         $options = [];
1611     } else {
1612         $options = [@{$options}]; # Copy to avoid side effects.
1613     }
1614
1615     my $isForcing = 0;
1616     if (grep /^--force$/, @{$options}) {
1617         $isForcing = 1;
1618     } elsif ($ensureForce) {
1619         push @{$options}, "--force";
1620         $isForcing = 1;
1621     }
1622
1623     if ($shouldReverse) { # No check: --reverse should never be passed explicitly.
1624         push @{$options}, "--reverse";
1625     }
1626
1627     @{$options} = sort(@{$options}); # For easier testing.
1628
1629     my $patchCommand = join(" ", "patch -p0", @{$options});
1630
1631     return ($patchCommand, $isForcing);
1632 }
1633
1634 # Apply the given patch using the patch(1) command.
1635 #
1636 # On success, return the resulting exit status. Otherwise, exit with the
1637 # exit status. If "--force" is passed as an option, however, then never
1638 # exit and always return the exit status.
1639 #
1640 # Args:
1641 #   $patch: a patch string.
1642 #   $repositoryRootPath: an absolute path to the repository root.
1643 #   $pathRelativeToRoot: the path of the file to be patched, relative to the
1644 #                        repository root. This should normally be the path
1645 #                        found in the patch's "Index:" line. It is passed
1646 #                        explicitly rather than reparsed from the patch
1647 #                        string for optimization purposes.
1648 #                            This is used only for error reporting. The
1649 #                        patch command gleans the actual file to patch
1650 #                        from the patch string.
1651 #   $args: a reference to a hash of optional arguments. The possible
1652 #          keys are --
1653 #            ensureForce: whether to ensure --force is passed (defaults to 0).
1654 #            shouldReverse: whether to pass --reverse (defaults to 0).
1655 #            options: a reference to an array of options to pass to the
1656 #                     patch command. The subroutine passes the -p0 option
1657 #                     no matter what. This should not include --reverse.
1658 #
1659 # This subroutine has unit tests in VCSUtils_unittest.pl.
1660 sub runPatchCommand($$$;$)
1661 {
1662     my ($patch, $repositoryRootPath, $pathRelativeToRoot, $args) = @_;
1663
1664     my ($patchCommand, $isForcing) = generatePatchCommand($args);
1665
1666     # Temporarily change the working directory since the path found
1667     # in the patch's "Index:" line is relative to the repository root
1668     # (i.e. the same as $pathRelativeToRoot).
1669     my $cwd = Cwd::getcwd();
1670     chdir $repositoryRootPath;
1671
1672     open PATCH, "| $patchCommand" or die "Could not call \"$patchCommand\" for file \"$pathRelativeToRoot\": $!";
1673     print PATCH $patch;
1674     close PATCH;
1675     my $exitStatus = exitStatus($?);
1676
1677     chdir $cwd;
1678
1679     if ($exitStatus && !$isForcing) {
1680         print "Calling \"$patchCommand\" for file \"$pathRelativeToRoot\" returned " .
1681               "status $exitStatus.  Pass --force to ignore patch failures.\n";
1682         exit $exitStatus;
1683     }
1684
1685     return $exitStatus;
1686 }
1687
1688 # Merge ChangeLog patches using a three-file approach.
1689 #
1690 # This is used by resolve-ChangeLogs when it's operated as a merge driver
1691 # and when it's used to merge conflicts after a patch is applied or after
1692 # an svn update.
1693 #
1694 # It's also used for traditional rejected patches.
1695 #
1696 # Args:
1697 #   $fileMine:  The merged version of the file.  Also known in git as the
1698 #               other branch's version (%B) or "ours".
1699 #               For traditional patch rejects, this is the *.rej file.
1700 #   $fileOlder: The base version of the file.  Also known in git as the
1701 #               ancestor version (%O) or "base".
1702 #               For traditional patch rejects, this is the *.orig file.
1703 #   $fileNewer: The current version of the file.  Also known in git as the
1704 #               current version (%A) or "theirs".
1705 #               For traditional patch rejects, this is the original-named
1706 #               file.
1707 #
1708 # Returns 1 if merge was successful, else 0.
1709 sub mergeChangeLogs($$$)
1710 {
1711     my ($fileMine, $fileOlder, $fileNewer) = @_;
1712
1713     my $traditionalReject = $fileMine =~ /\.rej$/ ? 1 : 0;
1714
1715     local $/ = undef;
1716
1717     my $patch;
1718     if ($traditionalReject) {
1719         open(DIFF, "<", $fileMine) or die $!;
1720         $patch = <DIFF>;
1721         close(DIFF);
1722         rename($fileMine, "$fileMine.save");
1723         rename($fileOlder, "$fileOlder.save");
1724     } else {
1725         open(DIFF, "diff -u -a --binary \"$fileOlder\" \"$fileMine\" |") or die $!;
1726         $patch = <DIFF>;
1727         close(DIFF);
1728     }
1729
1730     unlink("${fileNewer}.orig");
1731     unlink("${fileNewer}.rej");
1732
1733     open(PATCH, "| patch --force --fuzz=3 --binary \"$fileNewer\" > " . File::Spec->devnull()) or die $!;
1734     if ($traditionalReject) {
1735         print PATCH $patch;
1736     } else {
1737         my $changeLogHash = fixChangeLogPatch($patch);
1738         print PATCH $changeLogHash->{patch};
1739     }
1740     close(PATCH);
1741
1742     my $result = !exitStatus($?);
1743
1744     # Refuse to merge the patch if it did not apply cleanly
1745     if (-e "${fileNewer}.rej") {
1746         unlink("${fileNewer}.rej");
1747         if (-f "${fileNewer}.orig") {
1748             unlink($fileNewer);
1749             rename("${fileNewer}.orig", $fileNewer);
1750         }
1751     } else {
1752         unlink("${fileNewer}.orig");
1753     }
1754
1755     if ($traditionalReject) {
1756         rename("$fileMine.save", $fileMine);
1757         rename("$fileOlder.save", $fileOlder);
1758     }
1759
1760     return $result;
1761 }
1762
1763 sub gitConfig($)
1764 {
1765     return unless $isGit;
1766
1767     my ($config) = @_;
1768
1769     my $result = `git config $config`;
1770     if (($? >> 8)) {
1771         $result = `git repo-config $config`;
1772     }
1773     chomp $result;
1774     return $result;
1775 }
1776
1777 sub changeLogSuffix()
1778 {
1779     my $rootPath = determineVCSRoot();
1780     my $changeLogSuffixFile = File::Spec->catfile($rootPath, ".changeLogSuffix");
1781     return "" if ! -e $changeLogSuffixFile;
1782     open FILE, $changeLogSuffixFile or die "Could not open $changeLogSuffixFile: $!";
1783     my $changeLogSuffix = <FILE>;
1784     chomp $changeLogSuffix;
1785     close FILE;
1786     return $changeLogSuffix;
1787 }
1788
1789 sub changeLogFileName()
1790 {
1791     return "ChangeLog" . changeLogSuffix()
1792 }
1793
1794 sub changeLogNameError($)
1795 {
1796     my ($message) = @_;
1797     print STDERR "$message\nEither:\n";
1798     print STDERR "  set CHANGE_LOG_NAME in your environment\n";
1799     print STDERR "  OR pass --name= on the command line\n";
1800     print STDERR "  OR set REAL_NAME in your environment";
1801     print STDERR "  OR git users can set 'git config user.name'\n";
1802     exit(1);
1803 }
1804
1805 sub changeLogName()
1806 {
1807     my $name = $ENV{CHANGE_LOG_NAME} || $ENV{REAL_NAME} || gitConfig("user.name") || (split /\s*,\s*/, (getpwuid $<)[6])[0];
1808
1809     changeLogNameError("Failed to determine ChangeLog name.") unless $name;
1810     # getpwuid seems to always succeed on windows, returning the username instead of the full name.  This check will catch that case.
1811     changeLogNameError("'$name' does not contain a space!  ChangeLogs should contain your full name.") unless ($name =~ /\S\s\S/);
1812
1813     return $name;
1814 }
1815
1816 sub changeLogEmailAddressError($)
1817 {
1818     my ($message) = @_;
1819     print STDERR "$message\nEither:\n";
1820     print STDERR "  set CHANGE_LOG_EMAIL_ADDRESS in your environment\n";
1821     print STDERR "  OR pass --email= on the command line\n";
1822     print STDERR "  OR set EMAIL_ADDRESS in your environment\n";
1823     print STDERR "  OR git users can set 'git config user.email'\n";
1824     exit(1);
1825 }
1826
1827 sub changeLogEmailAddress()
1828 {
1829     my $emailAddress = $ENV{CHANGE_LOG_EMAIL_ADDRESS} || $ENV{EMAIL_ADDRESS} || gitConfig("user.email");
1830
1831     changeLogEmailAddressError("Failed to determine email address for ChangeLog.") unless $emailAddress;
1832     changeLogEmailAddressError("Email address '$emailAddress' does not contain '\@' and is likely invalid.") unless ($emailAddress =~ /\@/);
1833
1834     return $emailAddress;
1835 }
1836
1837 # http://tools.ietf.org/html/rfc1924
1838 sub decodeBase85($)
1839 {
1840     my ($encoded) = @_;
1841     my %table;
1842     my @characters = ('0'..'9', 'A'..'Z', 'a'..'z', '!', '#', '$', '%', '&', '(', ')', '*', '+', '-', ';', '<', '=', '>', '?', '@', '^', '_', '`', '{', '|', '}', '~');
1843     for (my $i = 0; $i < 85; $i++) {
1844         $table{$characters[$i]} = $i;
1845     }
1846
1847     my $decoded = '';
1848     my @encodedChars = $encoded =~ /./g;
1849
1850     for (my $encodedIter = 0; defined($encodedChars[$encodedIter]);) {
1851         my $digit = 0;
1852         for (my $i = 0; $i < 5; $i++) {
1853             $digit *= 85;
1854             my $char = $encodedChars[$encodedIter];
1855             $digit += $table{$char};
1856             $encodedIter++;
1857         }
1858
1859         for (my $i = 0; $i < 4; $i++) {
1860             $decoded .= chr(($digit >> (3 - $i) * 8) & 255);
1861         }
1862     }
1863
1864     return $decoded;
1865 }
1866
1867 sub decodeGitBinaryChunk($$)
1868 {
1869     my ($contents, $fullPath) = @_;
1870
1871     # Load this module lazily in case the user don't have this module
1872     # and won't handle git binary patches.
1873     require Compress::Zlib;
1874
1875     my $encoded = "";
1876     my $compressedSize = 0;
1877     while ($contents =~ /^([A-Za-z])(.*)$/gm) {
1878         my $line = $2;
1879         next if $line eq "";
1880         die "$fullPath: unexpected size of a line: $&" if length($2) % 5 != 0;
1881         my $actualSize = length($2) / 5 * 4;
1882         my $encodedExpectedSize = ord($1);
1883         my $expectedSize = $encodedExpectedSize <= ord("Z") ? $encodedExpectedSize - ord("A") + 1 : $encodedExpectedSize - ord("a") + 27;
1884
1885         die "$fullPath: unexpected size of a line: $&" if int(($expectedSize + 3) / 4) * 4 != $actualSize;
1886         $compressedSize += $expectedSize;
1887         $encoded .= $line;
1888     }
1889
1890     my $compressed = decodeBase85($encoded);
1891     $compressed = substr($compressed, 0, $compressedSize);
1892     return Compress::Zlib::uncompress($compressed);
1893 }
1894
1895 sub decodeGitBinaryPatch($$)
1896 {
1897     my ($contents, $fullPath) = @_;
1898
1899     # Git binary patch has two chunks. One is for the normal patching
1900     # and another is for the reverse patching.
1901     #
1902     # Each chunk a line which starts from either "literal" or "delta",
1903     # followed by a number which specifies decoded size of the chunk.
1904     #
1905     # Then, content of the chunk comes. To decode the content, we
1906     # need decode it with base85 first, and then zlib.
1907     my $gitPatchRegExp = '(literal|delta) ([0-9]+)\n([A-Za-z0-9!#$%&()*+-;<=>?@^_`{|}~\\n]*?)\n\n';
1908     if ($contents !~ m"\nGIT binary patch\n$gitPatchRegExp$gitPatchRegExp\Z") {
1909         die "$fullPath: unknown git binary patch format"
1910     }
1911
1912     my $binaryChunkType = $1;
1913     my $binaryChunkExpectedSize = $2;
1914     my $encodedChunk = $3;
1915     my $reverseBinaryChunkType = $4;
1916     my $reverseBinaryChunkExpectedSize = $5;
1917     my $encodedReverseChunk = $6;
1918
1919     my $binaryChunk = decodeGitBinaryChunk($encodedChunk, $fullPath);
1920     my $binaryChunkActualSize = length($binaryChunk);
1921     my $reverseBinaryChunk = decodeGitBinaryChunk($encodedReverseChunk, $fullPath);
1922     my $reverseBinaryChunkActualSize = length($reverseBinaryChunk);
1923
1924     die "$fullPath: unexpected size of the first chunk (expected $binaryChunkExpectedSize but was $binaryChunkActualSize" if ($binaryChunkType eq "literal" and $binaryChunkExpectedSize != $binaryChunkActualSize);
1925     die "$fullPath: unexpected size of the second chunk (expected $reverseBinaryChunkExpectedSize but was $reverseBinaryChunkActualSize" if ($reverseBinaryChunkType eq "literal" and $reverseBinaryChunkExpectedSize != $reverseBinaryChunkActualSize);
1926
1927     return ($binaryChunkType, $binaryChunk, $reverseBinaryChunkType, $reverseBinaryChunk);
1928 }
1929
1930 sub readByte($$)
1931 {
1932     my ($data, $location) = @_;
1933
1934     # Return the byte at $location in $data as a numeric value.
1935     return ord(substr($data, $location, 1));
1936 }
1937
1938 # The git binary delta format is undocumented, except in code:
1939 # - https://github.com/git/git/blob/master/delta.h:get_delta_hdr_size is the source
1940 #   of the algorithm in decodeGitBinaryPatchDeltaSize.
1941 # - https://github.com/git/git/blob/master/patch-delta.c:patch_delta is the source
1942 #   of the algorithm in applyGitBinaryPatchDelta.
1943 sub decodeGitBinaryPatchDeltaSize($)
1944 {
1945     my ($binaryChunk) = @_;
1946
1947     # Source and destination buffer sizes are stored in 7-bit chunks at the
1948     # start of the binary delta patch data.  The highest bit in each byte
1949     # except the last is set; the remaining 7 bits provide the next
1950     # chunk of the size.  The chunks are stored in ascending significance
1951     # order.
1952     my $cmd;
1953     my $size = 0;
1954     my $shift = 0;
1955     for (my $i = 0; $i < length($binaryChunk);) {
1956         $cmd = readByte($binaryChunk, $i++);
1957         $size |= ($cmd & 0x7f) << $shift;
1958         $shift += 7;
1959         if (!($cmd & 0x80)) {
1960             return ($size, $i);
1961         }
1962     }
1963 }
1964
1965 sub applyGitBinaryPatchDelta($$)
1966 {
1967     my ($binaryChunk, $originalContents) = @_;
1968
1969     # Git delta format consists of two headers indicating source buffer size
1970     # and result size, then a series of commands.  Each command is either
1971     # a copy-from-old-version (the 0x80 bit is set) or a copy-from-delta
1972     # command.  Commands are applied sequentially to generate the result.
1973     #
1974     # A copy-from-old-version command encodes an offset and size to copy
1975     # from in subsequent bits, while a copy-from-delta command consists only
1976     # of the number of bytes to copy from the delta.
1977
1978     # We don't use these values, but we need to know how big they are so that
1979     # we can skip to the diff data.
1980     my ($size, $bytesUsed) = decodeGitBinaryPatchDeltaSize($binaryChunk);
1981     $binaryChunk = substr($binaryChunk, $bytesUsed);
1982     ($size, $bytesUsed) = decodeGitBinaryPatchDeltaSize($binaryChunk);
1983     $binaryChunk = substr($binaryChunk, $bytesUsed);
1984
1985     my $out = "";
1986     for (my $i = 0; $i < length($binaryChunk); ) {
1987         my $cmd = ord(substr($binaryChunk, $i++, 1));
1988         if ($cmd & 0x80) {
1989             # Extract an offset and size from the delta data, then copy
1990             # $size bytes from $offset in the original data into the output.
1991             my $offset = 0;
1992             my $size = 0;
1993             if ($cmd & 0x01) { $offset = readByte($binaryChunk, $i++); }
1994             if ($cmd & 0x02) { $offset |= readByte($binaryChunk, $i++) << 8; }
1995             if ($cmd & 0x04) { $offset |= readByte($binaryChunk, $i++) << 16; }
1996             if ($cmd & 0x08) { $offset |= readByte($binaryChunk, $i++) << 24; }
1997             if ($cmd & 0x10) { $size = readByte($binaryChunk, $i++); }
1998             if ($cmd & 0x20) { $size |= readByte($binaryChunk, $i++) << 8; }
1999             if ($cmd & 0x40) { $size |= readByte($binaryChunk, $i++) << 16; }
2000             if ($size == 0) { $size = 0x10000; }
2001             $out .= substr($originalContents, $offset, $size);
2002         } elsif ($cmd) {
2003             # Copy $cmd bytes from the delta data into the output.
2004             $out .= substr($binaryChunk, $i, $cmd);
2005             $i += $cmd;
2006         } else {
2007             die "unexpected delta opcode 0";
2008         }
2009     }
2010
2011     return $out;
2012 }
2013
2014 sub escapeSubversionPath($)
2015 {
2016     my ($path) = @_;
2017     $path .= "@" if $path =~ /@/;
2018     return $path;
2019 }
2020
2021 sub runCommand(@)
2022 {
2023     my @args = @_;
2024     my $pid = open(CHILD, "-|");
2025     if (!defined($pid)) {
2026         die "Failed to fork(): $!";
2027     }
2028     if ($pid) {
2029         # Parent process
2030         my $childStdout;
2031         while (<CHILD>) {
2032             $childStdout .= $_;
2033         }
2034         close(CHILD);
2035         my %childOutput;
2036         $childOutput{exitStatus} = exitStatus($?);
2037         $childOutput{stdout} = $childStdout if $childStdout;
2038         return \%childOutput;
2039     }
2040     # Child process
2041     # FIXME: Consider further hardening of this function, including sanitizing the environment.
2042     exec { $args[0] } @args or die "Failed to exec(): $!";
2043 }
2044
2045 1;