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