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