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