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