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