Rename WebKitTools to Tools
[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 canonicalizePath($)
396 {
397     my ($file) = @_;
398
399     # Remove extra slashes and '.' directories in path
400     $file = File::Spec->canonpath($file);
401
402     # Remove '..' directories in path
403     my @dirs = ();
404     foreach my $dir (File::Spec->splitdir($file)) {
405         if ($dir eq '..' && $#dirs >= 0 && $dirs[$#dirs] ne '..') {
406             pop(@dirs);
407         } else {
408             push(@dirs, $dir);
409         }
410     }
411     return ($#dirs >= 0) ? File::Spec->catdir(@dirs) : ".";
412 }
413
414 sub removeEOL($)
415 {
416     my ($line) = @_;
417     return "" unless $line;
418
419     $line =~ s/[\r\n]+$//g;
420     return $line;
421 }
422
423 sub svnStatus($)
424 {
425     my ($fullPath) = @_;
426     my $svnStatus;
427     open SVN, "svn status --non-interactive --non-recursive '$fullPath' |" or die;
428     if (-d $fullPath) {
429         # When running "svn stat" on a directory, we can't assume that only one
430         # status will be returned (since any files with a status below the
431         # directory will be returned), and we can't assume that the directory will
432         # be first (since any files with unknown status will be listed first).
433         my $normalizedFullPath = File::Spec->catdir(File::Spec->splitdir($fullPath));
434         while (<SVN>) {
435             # Input may use a different EOL sequence than $/, so avoid chomp.
436             $_ = removeEOL($_);
437             my $normalizedStatPath = File::Spec->catdir(File::Spec->splitdir(substr($_, 7)));
438             if ($normalizedFullPath eq $normalizedStatPath) {
439                 $svnStatus = "$_\n";
440                 last;
441             }
442         }
443         # Read the rest of the svn command output to avoid a broken pipe warning.
444         local $/ = undef;
445         <SVN>;
446     }
447     else {
448         # Files will have only one status returned.
449         $svnStatus = removeEOL(<SVN>) . "\n";
450     }
451     close SVN;
452     return $svnStatus;
453 }
454
455 # Return whether the given file mode is executable in the source control
456 # sense.  We make this determination based on whether the executable bit
457 # is set for "others" rather than the stronger condition that it be set
458 # for the user, group, and others.  This is sufficient for distinguishing
459 # the default behavior in Git and SVN.
460 #
461 # Args:
462 #   $fileMode: A number or string representing a file mode in octal notation.
463 sub isExecutable($)
464 {
465     my $fileMode = shift;
466
467     return $fileMode % 2;
468 }
469
470 # Parse the next Git diff header from the given file handle, and advance
471 # the handle so the last line read is the first line after the header.
472 #
473 # This subroutine dies if given leading junk.
474 #
475 # Args:
476 #   $fileHandle: advanced so the last line read from the handle is the first
477 #                line of the header to parse.  This should be a line
478 #                beginning with "diff --git".
479 #   $line: the line last read from $fileHandle
480 #
481 # Returns ($headerHashRef, $lastReadLine):
482 #   $headerHashRef: a hash reference representing a diff header, as follows--
483 #     copiedFromPath: the path from which the file was copied or moved if
484 #                     the diff is a copy or move.
485 #     executableBitDelta: the value 1 or -1 if the executable bit was added or
486 #                         removed, respectively.  New and deleted files have
487 #                         this value only if the file is executable, in which
488 #                         case the value is 1 and -1, respectively.
489 #     indexPath: the path of the target file.
490 #     isBinary: the value 1 if the diff is for a binary file.
491 #     isDeletion: the value 1 if the diff is a file deletion.
492 #     isCopyWithChanges: the value 1 if the file was copied or moved and
493 #                        the target file was changed in some way after being
494 #                        copied or moved (e.g. if its contents or executable
495 #                        bit were changed).
496 #     isNew: the value 1 if the diff is for a new file.
497 #     shouldDeleteSource: the value 1 if the file was copied or moved and
498 #                         the source file was deleted -- i.e. if the copy
499 #                         was actually a move.
500 #     svnConvertedText: the header text with some lines converted to SVN
501 #                       format.  Git-specific lines are preserved.
502 #   $lastReadLine: the line last read from $fileHandle.
503 sub parseGitDiffHeader($$)
504 {
505     my ($fileHandle, $line) = @_;
506
507     $_ = $line;
508
509     my $indexPath;
510     if (/$gitDiffStartRegEx/) {
511         # The first and second paths can differ in the case of copies
512         # and renames.  We use the second file path because it is the
513         # destination path.
514         $indexPath = $4;
515         # Use $POSTMATCH to preserve the end-of-line character.
516         $_ = "Index: $indexPath$POSTMATCH"; # Convert to SVN format.
517     } else {
518         die("Could not parse leading \"diff --git\" line: \"$line\".");
519     }
520
521     my $copiedFromPath;
522     my $foundHeaderEnding;
523     my $isBinary;
524     my $isDeletion;
525     my $isNew;
526     my $newExecutableBit = 0;
527     my $oldExecutableBit = 0;
528     my $shouldDeleteSource = 0;
529     my $similarityIndex = 0;
530     my $svnConvertedText;
531     while (1) {
532         # Temporarily strip off any end-of-line characters to simplify
533         # regex matching below.
534         s/([\n\r]+)$//;
535         my $eol = $1;
536
537         if (/^(deleted file|old) mode (\d+)/) {
538             $oldExecutableBit = (isExecutable($2) ? 1 : 0);
539             $isDeletion = 1 if $1 eq "deleted file";
540         } elsif (/^new( file)? mode (\d+)/) {
541             $newExecutableBit = (isExecutable($2) ? 1 : 0);
542             $isNew = 1 if $1;
543         } elsif (/^similarity index (\d+)%/) {
544             $similarityIndex = $1;
545         } elsif (/^copy from (\S+)/) {
546             $copiedFromPath = $1;
547         } elsif (/^rename from (\S+)/) {
548             # FIXME: Record this as a move rather than as a copy-and-delete.
549             #        This will simplify adding rename support to svn-unapply.
550             #        Otherwise, the hash for a deletion would have to know
551             #        everything about the file being deleted in order to
552             #        support undoing itself.  Recording as a move will also
553             #        permit us to use "svn move" and "git move".
554             $copiedFromPath = $1;
555             $shouldDeleteSource = 1;
556         } elsif (/^--- \S+/) {
557             $_ = "--- $indexPath"; # Convert to SVN format.
558         } elsif (/^\+\+\+ \S+/) {
559             $_ = "+++ $indexPath"; # Convert to SVN format.
560             $foundHeaderEnding = 1;
561         } elsif (/^GIT binary patch$/ ) {
562             $isBinary = 1;
563             $foundHeaderEnding = 1;
564         # The "git diff" command includes a line of the form "Binary files
565         # <path1> and <path2> differ" if the --binary flag is not used.
566         } elsif (/^Binary files / ) {
567             die("Error: the Git diff contains a binary file without the binary data in ".
568                 "line: \"$_\".  Be sure to use the --binary flag when invoking \"git diff\" ".
569                 "with diffs containing binary files.");
570         }
571
572         $svnConvertedText .= "$_$eol"; # Also restore end-of-line characters.
573
574         $_ = <$fileHandle>; # Not defined if end-of-file reached.
575
576         last if (!defined($_) || /$gitDiffStartRegEx/ || $foundHeaderEnding);
577     }
578
579     my $executableBitDelta = $newExecutableBit - $oldExecutableBit;
580
581     my %header;
582
583     $header{copiedFromPath} = $copiedFromPath if $copiedFromPath;
584     $header{executableBitDelta} = $executableBitDelta if $executableBitDelta;
585     $header{indexPath} = $indexPath;
586     $header{isBinary} = $isBinary if $isBinary;
587     $header{isCopyWithChanges} = 1 if ($copiedFromPath && ($similarityIndex != 100 || $executableBitDelta));
588     $header{isDeletion} = $isDeletion if $isDeletion;
589     $header{isNew} = $isNew if $isNew;
590     $header{shouldDeleteSource} = $shouldDeleteSource if $shouldDeleteSource;
591     $header{svnConvertedText} = $svnConvertedText;
592
593     return (\%header, $_);
594 }
595
596 # Parse the next SVN diff header from the given file handle, and advance
597 # the handle so the last line read is the first line after the header.
598 #
599 # This subroutine dies if given leading junk or if it could not detect
600 # the end of the header block.
601 #
602 # Args:
603 #   $fileHandle: advanced so the last line read from the handle is the first
604 #                line of the header to parse.  This should be a line
605 #                beginning with "Index:".
606 #   $line: the line last read from $fileHandle
607 #
608 # Returns ($headerHashRef, $lastReadLine):
609 #   $headerHashRef: a hash reference representing a diff header, as follows--
610 #     copiedFromPath: the path from which the file was copied if the diff
611 #                     is a copy.
612 #     indexPath: the path of the target file, which is the path found in
613 #                the "Index:" line.
614 #     isBinary: the value 1 if the diff is for a binary file.
615 #     isNew: the value 1 if the diff is for a new file.
616 #     sourceRevision: the revision number of the source, if it exists.  This
617 #                     is the same as the revision number the file was copied
618 #                     from, in the case of a file copy.
619 #     svnConvertedText: the header text converted to a header with the paths
620 #                       in some lines corrected.
621 #   $lastReadLine: the line last read from $fileHandle.
622 sub parseSvnDiffHeader($$)
623 {
624     my ($fileHandle, $line) = @_;
625
626     $_ = $line;
627
628     my $indexPath;
629     if (/$svnDiffStartRegEx/) {
630         $indexPath = $1;
631     } else {
632         die("First line of SVN diff does not begin with \"Index \": \"$_\"");
633     }
634
635     my $copiedFromPath;
636     my $foundHeaderEnding;
637     my $isBinary;
638     my $isNew;
639     my $sourceRevision;
640     my $svnConvertedText;
641     while (1) {
642         # Temporarily strip off any end-of-line characters to simplify
643         # regex matching below.
644         s/([\n\r]+)$//;
645         my $eol = $1;
646
647         # Fix paths on ""---" and "+++" lines to match the leading
648         # index line.
649         if (s/^--- \S+/--- $indexPath/) {
650             # ---
651             if (/^--- .+\(revision (\d+)\)/) {
652                 $sourceRevision = $1;
653                 $isNew = 1 if !$sourceRevision; # if revision 0.
654                 if (/\(from (\S+):(\d+)\)$/) {
655                     # The "from" clause is created by svn-create-patch, in
656                     # which case there is always also a "revision" clause.
657                     $copiedFromPath = $1;
658                     die("Revision number \"$2\" in \"from\" clause does not match " .
659                         "source revision number \"$sourceRevision\".") if ($2 != $sourceRevision);
660                 }
661             }
662         } elsif (s/^\+\+\+ \S+/+++ $indexPath/) {
663             $foundHeaderEnding = 1;
664         } elsif (/^Cannot display: file marked as a binary type.$/) {
665             $isBinary = 1;
666             $foundHeaderEnding = 1;
667         }
668
669         $svnConvertedText .= "$_$eol"; # Also restore end-of-line characters.
670
671         $_ = <$fileHandle>; # Not defined if end-of-file reached.
672
673         last if (!defined($_) || /$svnDiffStartRegEx/ || $foundHeaderEnding);
674     }
675
676     if (!$foundHeaderEnding) {
677         die("Did not find end of header block corresponding to index path \"$indexPath\".");
678     }
679
680     my %header;
681
682     $header{copiedFromPath} = $copiedFromPath if $copiedFromPath;
683     $header{indexPath} = $indexPath;
684     $header{isBinary} = $isBinary if $isBinary;
685     $header{isNew} = $isNew if $isNew;
686     $header{sourceRevision} = $sourceRevision if $sourceRevision;
687     $header{svnConvertedText} = $svnConvertedText;
688
689     return (\%header, $_);
690 }
691
692 # Parse the next diff header from the given file handle, and advance
693 # the handle so the last line read is the first line after the header.
694 #
695 # This subroutine dies if given leading junk or if it could not detect
696 # the end of the header block.
697 #
698 # Args:
699 #   $fileHandle: advanced so the last line read from the handle is the first
700 #                line of the header to parse.  For SVN-formatted diffs, this
701 #                is a line beginning with "Index:".  For Git, this is a line
702 #                beginning with "diff --git".
703 #   $line: the line last read from $fileHandle
704 #
705 # Returns ($headerHashRef, $lastReadLine):
706 #   $headerHashRef: a hash reference representing a diff header
707 #     copiedFromPath: the path from which the file was copied if the diff
708 #                     is a copy.
709 #     executableBitDelta: the value 1 or -1 if the executable bit was added or
710 #                         removed, respectively.  New and deleted files have
711 #                         this value only if the file is executable, in which
712 #                         case the value is 1 and -1, respectively.
713 #     indexPath: the path of the target file.
714 #     isBinary: the value 1 if the diff is for a binary file.
715 #     isGit: the value 1 if the diff is Git-formatted.
716 #     isSvn: the value 1 if the diff is SVN-formatted.
717 #     sourceRevision: the revision number of the source, if it exists.  This
718 #                     is the same as the revision number the file was copied
719 #                     from, in the case of a file copy.
720 #     svnConvertedText: the header text with some lines converted to SVN
721 #                       format.  Git-specific lines are preserved.
722 #   $lastReadLine: the line last read from $fileHandle.
723 sub parseDiffHeader($$)
724 {
725     my ($fileHandle, $line) = @_;
726
727     my $header;  # This is a hash ref.
728     my $isGit;
729     my $isSvn;
730     my $lastReadLine;
731
732     if ($line =~ $svnDiffStartRegEx) {
733         $isSvn = 1;
734         ($header, $lastReadLine) = parseSvnDiffHeader($fileHandle, $line);
735     } elsif ($line =~ $gitDiffStartRegEx) {
736         $isGit = 1;
737         ($header, $lastReadLine) = parseGitDiffHeader($fileHandle, $line);
738     } else {
739         die("First line of diff does not begin with \"Index:\" or \"diff --git\": \"$line\"");
740     }
741
742     $header->{isGit} = $isGit if $isGit;
743     $header->{isSvn} = $isSvn if $isSvn;
744
745     return ($header, $lastReadLine);
746 }
747
748 # FIXME: The %diffHash "object" should not have an svnConvertedText property.
749 #        Instead, the hash object should store its information in a
750 #        structured way as properties.  This should be done in a way so
751 #        that, if necessary, the text of an SVN or Git patch can be
752 #        reconstructed from the information in those hash properties.
753 #
754 # A %diffHash is a hash representing a source control diff of a single
755 # file operation (e.g. a file modification, copy, or delete).
756 #
757 # These hashes appear, for example, in the parseDiff(), parsePatch(),
758 # and prepareParsedPatch() subroutines of this package.
759 #
760 # The corresponding values are--
761 #
762 #   copiedFromPath: the path from which the file was copied if the diff
763 #                   is a copy.
764 #   executableBitDelta: the value 1 or -1 if the executable bit was added or
765 #                       removed from the target file, respectively.
766 #   indexPath: the path of the target file.  For SVN-formatted diffs,
767 #              this is the same as the path in the "Index:" line.
768 #   isBinary: the value 1 if the diff is for a binary file.
769 #   isDeletion: the value 1 if the diff is known from the header to be a deletion.
770 #   isGit: the value 1 if the diff is Git-formatted.
771 #   isNew: the value 1 if the dif is known from the header to be a new file.
772 #   isSvn: the value 1 if the diff is SVN-formatted.
773 #   sourceRevision: the revision number of the source, if it exists.  This
774 #                   is the same as the revision number the file was copied
775 #                   from, in the case of a file copy.
776 #   svnConvertedText: the diff with some lines converted to SVN format.
777 #                     Git-specific lines are preserved.
778
779 # Parse one diff from a patch file created by svn-create-patch, and
780 # advance the file handle so the last line read is the first line
781 # of the next header block.
782 #
783 # This subroutine preserves any leading junk encountered before the header.
784 #
785 # Composition of an SVN diff
786 #
787 # There are three parts to an SVN diff: the header, the property change, and
788 # the binary contents, in that order. Either the header or the property change
789 # may be ommitted, but not both. If there are binary changes, then you always
790 # have all three.
791 #
792 # Args:
793 #   $fileHandle: a file handle advanced to the first line of the next
794 #                header block. Leading junk is okay.
795 #   $line: the line last read from $fileHandle.
796 #
797 # Returns ($diffHashRefs, $lastReadLine):
798 #   $diffHashRefs: A reference to an array of references to %diffHash hashes.
799 #                  See the %diffHash documentation above.
800 #   $lastReadLine: the line last read from $fileHandle
801 sub parseDiff($$)
802 {
803     # FIXME: Adjust this method so that it dies if the first line does not
804     #        match the start of a diff.  This will require a change to
805     #        parsePatch() so that parsePatch() skips over leading junk.
806     my ($fileHandle, $line) = @_;
807
808     my $headerStartRegEx = $svnDiffStartRegEx; # SVN-style header for the default
809
810     my $headerHashRef; # Last header found, as returned by parseDiffHeader().
811     my $svnPropertiesHashRef; # Last SVN properties diff found, as returned by parseSvnDiffProperties().
812     my $svnText;
813     while (defined($line)) {
814         if (!$headerHashRef && ($line =~ $gitDiffStartRegEx)) {
815             # Then assume all diffs in the patch are Git-formatted. This
816             # block was made to be enterable at most once since we assume
817             # all diffs in the patch are formatted the same (SVN or Git).
818             $headerStartRegEx = $gitDiffStartRegEx;
819         }
820
821         if ($line =~ $svnPropertiesStartRegEx) {
822             my $propertyPath = $1;
823             if ($svnPropertiesHashRef || $headerHashRef && ($propertyPath ne $headerHashRef->{indexPath})) {
824                 # This is the start of the second diff in the while loop, which happens to
825                 # be a property diff.  If $svnPropertiesHasRef is defined, then this is the
826                 # second consecutive property diff, otherwise it's the start of a property
827                 # diff for a file that only has property changes.
828                 last;
829             }
830             ($svnPropertiesHashRef, $line) = parseSvnDiffProperties($fileHandle, $line);
831             next;
832         }
833         if ($line !~ $headerStartRegEx) {
834             # Then we are in the body of the diff.
835             $svnText .= $line;
836             $line = <$fileHandle>;
837             next;
838         } # Otherwise, we found a diff header.
839
840         if ($svnPropertiesHashRef || $headerHashRef) {
841             # Then either we just processed an SVN property change or this
842             # is the start of the second diff header of this while loop.
843             last;
844         }
845
846         ($headerHashRef, $line) = parseDiffHeader($fileHandle, $line);
847
848         $svnText .= $headerHashRef->{svnConvertedText};
849     }
850
851     my @diffHashRefs;
852
853     if ($headerHashRef->{shouldDeleteSource}) {
854         my %deletionHash;
855         $deletionHash{indexPath} = $headerHashRef->{copiedFromPath};
856         $deletionHash{isDeletion} = 1;
857         push @diffHashRefs, \%deletionHash;
858     }
859     if ($headerHashRef->{copiedFromPath}) {
860         my %copyHash;
861         $copyHash{copiedFromPath} = $headerHashRef->{copiedFromPath};
862         $copyHash{indexPath} = $headerHashRef->{indexPath};
863         $copyHash{sourceRevision} = $headerHashRef->{sourceRevision} if $headerHashRef->{sourceRevision};
864         if ($headerHashRef->{isSvn}) {
865             $copyHash{executableBitDelta} = $svnPropertiesHashRef->{executableBitDelta} if $svnPropertiesHashRef->{executableBitDelta};
866         }
867         push @diffHashRefs, \%copyHash;
868     }
869
870     # Note, the order of evaluation for the following if conditional has been explicitly chosen so that
871     # it evaluates to false when there is no headerHashRef (e.g. a property change diff for a file that
872     # only has property changes).
873     if ($headerHashRef->{isCopyWithChanges} || (%$headerHashRef && !$headerHashRef->{copiedFromPath})) {
874         # Then add the usual file modification.
875         my %diffHash;
876         # FIXME: We should expand this code to support other properties.  In the future,
877         #        parseSvnDiffProperties may return a hash whose keys are the properties.
878         if ($headerHashRef->{isSvn}) {
879             # SVN records the change to the executable bit in a separate property change diff
880             # that follows the contents of the diff, except for binary diffs.  For binary
881             # diffs, the property change diff follows the diff header.
882             $diffHash{executableBitDelta} = $svnPropertiesHashRef->{executableBitDelta} if $svnPropertiesHashRef->{executableBitDelta};
883         } elsif ($headerHashRef->{isGit}) {
884             # Git records the change to the executable bit in the header of a diff.
885             $diffHash{executableBitDelta} = $headerHashRef->{executableBitDelta} if $headerHashRef->{executableBitDelta};
886         }
887         $diffHash{indexPath} = $headerHashRef->{indexPath};
888         $diffHash{isBinary} = $headerHashRef->{isBinary} if $headerHashRef->{isBinary};
889         $diffHash{isDeletion} = $headerHashRef->{isDeletion} if $headerHashRef->{isDeletion};
890         $diffHash{isGit} = $headerHashRef->{isGit} if $headerHashRef->{isGit};
891         $diffHash{isNew} = $headerHashRef->{isNew} if $headerHashRef->{isNew};
892         $diffHash{isSvn} = $headerHashRef->{isSvn} if $headerHashRef->{isSvn};
893         if (!$headerHashRef->{copiedFromPath}) {
894             # If the file was copied, then we have already incorporated the
895             # sourceRevision information into the change.
896             $diffHash{sourceRevision} = $headerHashRef->{sourceRevision} if $headerHashRef->{sourceRevision};
897         }
898         # FIXME: Remove the need for svnConvertedText.  See the %diffHash
899         #        code comments above for more information.
900         #
901         # Note, we may not always have SVN converted text since we intend
902         # to deprecate it in the future.  For example, a property change
903         # diff for a file that only has property changes will not return
904         # any SVN converted text.
905         $diffHash{svnConvertedText} = $svnText if $svnText;
906         push @diffHashRefs, \%diffHash;
907     }
908
909     if (!%$headerHashRef && $svnPropertiesHashRef) {
910         # A property change diff for a file that only has property changes.
911         my %propertyChangeHash;
912         $propertyChangeHash{executableBitDelta} = $svnPropertiesHashRef->{executableBitDelta} if $svnPropertiesHashRef->{executableBitDelta};
913         $propertyChangeHash{indexPath} = $svnPropertiesHashRef->{propertyPath};
914         $propertyChangeHash{isSvn} = 1;
915         push @diffHashRefs, \%propertyChangeHash;
916     }
917
918     return (\@diffHashRefs, $line);
919 }
920
921 # Parse an SVN property change diff from the given file handle, and advance
922 # the handle so the last line read is the first line after this diff.
923 #
924 # For the case of an SVN binary diff, the binary contents will follow the
925 # the property changes.
926 #
927 # This subroutine dies if the first line does not begin with "Property changes on"
928 # or if the separator line that follows this line is missing.
929 #
930 # Args:
931 #   $fileHandle: advanced so the last line read from the handle is the first
932 #                line of the footer to parse.  This line begins with
933 #                "Property changes on".
934 #   $line: the line last read from $fileHandle.
935 #
936 # Returns ($propertyHashRef, $lastReadLine):
937 #   $propertyHashRef: a hash reference representing an SVN diff footer.
938 #     propertyPath: the path of the target file.
939 #     executableBitDelta: the value 1 or -1 if the executable bit was added or
940 #                         removed from the target file, respectively.
941 #   $lastReadLine: the line last read from $fileHandle.
942 sub parseSvnDiffProperties($$)
943 {
944     my ($fileHandle, $line) = @_;
945
946     $_ = $line;
947
948     my %footer;
949     if (/$svnPropertiesStartRegEx/) {
950         $footer{propertyPath} = $1;
951     } else {
952         die("Failed to find start of SVN property change, \"Property changes on \": \"$_\"");
953     }
954
955     # We advance $fileHandle two lines so that the next line that
956     # we process is $svnPropertyStartRegEx in a well-formed footer.
957     # A well-formed footer has the form:
958     # Property changes on: FileA
959     # ___________________________________________________________________
960     # Added: svn:executable
961     #    + *
962     $_ = <$fileHandle>; # Not defined if end-of-file reached.
963     my $separator = "_" x 67;
964     if (defined($_) && /^$separator[\r\n]+$/) {
965         $_ = <$fileHandle>;
966     } else {
967         die("Failed to find separator line: \"$_\".");
968     }
969
970     # FIXME: We should expand this to support other SVN properties
971     #        (e.g. return a hash of property key-values that represents
972     #        all properties).
973     #
974     # Notice, we keep processing until we hit end-of-file or some
975     # line that does not resemble $svnPropertyStartRegEx, such as
976     # the empty line that precedes the start of the binary contents
977     # of a patch, or the start of the next diff (e.g. "Index:").
978     my $propertyHashRef;
979     while (defined($_) && /$svnPropertyStartRegEx/) {
980         ($propertyHashRef, $_) = parseSvnProperty($fileHandle, $_);
981         if ($propertyHashRef->{name} eq "svn:executable") {
982             # Notice, for SVN properties, propertyChangeDelta is always non-zero
983             # because a property can only be added or removed.
984             $footer{executableBitDelta} = $propertyHashRef->{propertyChangeDelta};   
985         }
986     }
987
988     return(\%footer, $_);
989 }
990
991 # Parse the next SVN property from the given file handle, and advance the handle so the last
992 # line read is the first line after the property.
993 #
994 # This subroutine dies if the first line is not a valid start of an SVN property,
995 # or the property is missing a value, or the property change type (e.g. "Added")
996 # does not correspond to the property value type (e.g. "+").
997 #
998 # Args:
999 #   $fileHandle: advanced so the last line read from the handle is the first
1000 #                line of the property to parse.  This should be a line
1001 #                that matches $svnPropertyStartRegEx.
1002 #   $line: the line last read from $fileHandle.
1003 #
1004 # Returns ($propertyHashRef, $lastReadLine):
1005 #   $propertyHashRef: a hash reference representing a SVN property.
1006 #     name: the name of the property.
1007 #     value: the last property value.  For instance, suppose the property is "Modified".
1008 #            Then it has both a '-' and '+' property value in that order.  Therefore,
1009 #            the value of this key is the value of the '+' property by ordering (since
1010 #            it is the last value).
1011 #     propertyChangeDelta: the value 1 or -1 if the property was added or
1012 #                          removed, respectively.
1013 #   $lastReadLine: the line last read from $fileHandle.
1014 sub parseSvnProperty($$)
1015 {
1016     my ($fileHandle, $line) = @_;
1017
1018     $_ = $line;
1019
1020     my $propertyName;
1021     my $propertyChangeType;
1022     if (/$svnPropertyStartRegEx/) {
1023         $propertyChangeType = $1;
1024         $propertyName = $2;
1025     } else {
1026         die("Failed to find SVN property: \"$_\".");
1027     }
1028
1029     $_ = <$fileHandle>; # Not defined if end-of-file reached.
1030
1031     # The "svn diff" command neither inserts newline characters between property values
1032     # nor between successive properties.
1033     #
1034     # FIXME: We do not support property values that contain tailing newline characters
1035     #        as it is difficult to disambiguate these trailing newlines from the empty
1036     #        line that precedes the contents of a binary patch.
1037     my $propertyValue;
1038     my $propertyValueType;
1039     while (defined($_) && /$svnPropertyValueStartRegEx/) {
1040         # Note, a '-' property may be followed by a '+' property in the case of a "Modified"
1041         # or "Name" property.  We only care about the ending value (i.e. the '+' property)
1042         # in such circumstances.  So, we take the property value for the property to be its
1043         # last parsed property value.
1044         #
1045         # FIXME: We may want to consider strictly enforcing a '-', '+' property ordering or
1046         #        add error checking to prevent '+', '+', ..., '+' and other invalid combinations.
1047         $propertyValueType = $1;
1048         ($propertyValue, $_) = parseSvnPropertyValue($fileHandle, $_);
1049     }
1050
1051     if (!$propertyValue) {
1052         die("Failed to find the property value for the SVN property \"$propertyName\": \"$_\".");
1053     }
1054
1055     my $propertyChangeDelta;
1056     if ($propertyValueType eq "+" || $propertyValueType eq "Merged") {
1057         $propertyChangeDelta = 1;
1058     } elsif ($propertyValueType eq "-" || $propertyValueType eq "Reverse-merged") {
1059         $propertyChangeDelta = -1;
1060     } else {
1061         die("Not reached.");
1062     }
1063
1064     # We perform a simple validation that an "Added" or "Deleted" property
1065     # change type corresponds with a "+" and "-" value type, respectively.
1066     my $expectedChangeDelta;
1067     if ($propertyChangeType eq "Added") {
1068         $expectedChangeDelta = 1;
1069     } elsif ($propertyChangeType eq "Deleted") {
1070         $expectedChangeDelta = -1;
1071     }
1072
1073     if ($expectedChangeDelta && $propertyChangeDelta != $expectedChangeDelta) {
1074         die("The final property value type found \"$propertyValueType\" does not " .
1075             "correspond to the property change type found \"$propertyChangeType\".");
1076     }
1077
1078     my %propertyHash;
1079     $propertyHash{name} = $propertyName;
1080     $propertyHash{propertyChangeDelta} = $propertyChangeDelta;
1081     $propertyHash{value} = $propertyValue;
1082     return (\%propertyHash, $_);
1083 }
1084
1085 # Parse the value of an SVN property from the given file handle, and advance
1086 # the handle so the last line read is the first line after the property value.
1087 #
1088 # This subroutine dies if the first line is an invalid SVN property value line
1089 # (i.e. a line that does not begin with "   +" or "   -").
1090 #
1091 # Args:
1092 #   $fileHandle: advanced so the last line read from the handle is the first
1093 #                line of the property value to parse.  This should be a line
1094 #                beginning with "   +" or "   -".
1095 #   $line: the line last read from $fileHandle.
1096 #
1097 # Returns ($propertyValue, $lastReadLine):
1098 #   $propertyValue: the value of the property.
1099 #   $lastReadLine: the line last read from $fileHandle.
1100 sub parseSvnPropertyValue($$)
1101 {
1102     my ($fileHandle, $line) = @_;
1103
1104     $_ = $line;
1105
1106     my $propertyValue;
1107     my $eol;
1108     if (/$svnPropertyValueStartRegEx/) {
1109         $propertyValue = $2; # Does not include the end-of-line character(s).
1110         $eol = $POSTMATCH;
1111     } else {
1112         die("Failed to find property value beginning with '+', '-', 'Merged', or 'Reverse-merged': \"$_\".");
1113     }
1114
1115     while (<$fileHandle>) {
1116         if (/^[\r\n]+$/ || /$svnPropertyValueStartRegEx/ || /$svnPropertyStartRegEx/) {
1117             # Note, we may encounter an empty line before the contents of a binary patch.
1118             # Also, we check for $svnPropertyValueStartRegEx because a '-' property may be
1119             # followed by a '+' property in the case of a "Modified" or "Name" property.
1120             # We check for $svnPropertyStartRegEx because it indicates the start of the
1121             # next property to parse.
1122             last;
1123         }
1124
1125         # Temporarily strip off any end-of-line characters. We add the end-of-line characters
1126         # from the previously processed line to the start of this line so that the last line
1127         # of the property value does not end in end-of-line characters.
1128         s/([\n\r]+)$//;
1129         $propertyValue .= "$eol$_";
1130         $eol = $1;
1131     }
1132
1133     return ($propertyValue, $_);
1134 }
1135
1136 # Parse a patch file created by svn-create-patch.
1137 #
1138 # Args:
1139 #   $fileHandle: A file handle to the patch file that has not yet been
1140 #                read from.
1141 #
1142 # Returns:
1143 #   @diffHashRefs: an array of diff hash references.
1144 #                  See the %diffHash documentation above.
1145 sub parsePatch($)
1146 {
1147     my ($fileHandle) = @_;
1148
1149     my $newDiffHashRefs;
1150     my @diffHashRefs; # return value
1151
1152     my $line = <$fileHandle>;
1153
1154     while (defined($line)) { # Otherwise, at EOF.
1155
1156         ($newDiffHashRefs, $line) = parseDiff($fileHandle, $line);
1157
1158         push @diffHashRefs, @$newDiffHashRefs;
1159     }
1160
1161     return @diffHashRefs;
1162 }
1163
1164 # Prepare the results of parsePatch() for use in svn-apply and svn-unapply.
1165 #
1166 # Args:
1167 #   $shouldForce: Whether to continue processing if an unexpected
1168 #                 state occurs.
1169 #   @diffHashRefs: An array of references to %diffHashes.
1170 #                  See the %diffHash documentation above.
1171 #
1172 # Returns $preparedPatchHashRef:
1173 #   copyDiffHashRefs: A reference to an array of the $diffHashRefs in
1174 #                     @diffHashRefs that represent file copies. The original
1175 #                     ordering is preserved.
1176 #   nonCopyDiffHashRefs: A reference to an array of the $diffHashRefs in
1177 #                        @diffHashRefs that do not represent file copies.
1178 #                        The original ordering is preserved.
1179 #   sourceRevisionHash: A reference to a hash of source path to source
1180 #                       revision number.
1181 sub prepareParsedPatch($@)
1182 {
1183     my ($shouldForce, @diffHashRefs) = @_;
1184
1185     my %copiedFiles;
1186
1187     # Return values
1188     my @copyDiffHashRefs = ();
1189     my @nonCopyDiffHashRefs = ();
1190     my %sourceRevisionHash = ();
1191     for my $diffHashRef (@diffHashRefs) {
1192         my $copiedFromPath = $diffHashRef->{copiedFromPath};
1193         my $indexPath = $diffHashRef->{indexPath};
1194         my $sourceRevision = $diffHashRef->{sourceRevision};
1195         my $sourcePath;
1196
1197         if (defined($copiedFromPath)) {
1198             # Then the diff is a copy operation.
1199             $sourcePath = $copiedFromPath;
1200
1201             # FIXME: Consider printing a warning or exiting if
1202             #        exists($copiedFiles{$indexPath}) is true -- i.e. if
1203             #        $indexPath appears twice as a copy target.
1204             $copiedFiles{$indexPath} = $sourcePath;
1205
1206             push @copyDiffHashRefs, $diffHashRef;
1207         } else {
1208             # Then the diff is not a copy operation.
1209             $sourcePath = $indexPath;
1210
1211             push @nonCopyDiffHashRefs, $diffHashRef;
1212         }
1213
1214         if (defined($sourceRevision)) {
1215             if (exists($sourceRevisionHash{$sourcePath}) &&
1216                 ($sourceRevisionHash{$sourcePath} != $sourceRevision)) {
1217                 if (!$shouldForce) {
1218                     die "Two revisions of the same file required as a source:\n".
1219                         "    $sourcePath:$sourceRevisionHash{$sourcePath}\n".
1220                         "    $sourcePath:$sourceRevision";
1221                 }
1222             }
1223             $sourceRevisionHash{$sourcePath} = $sourceRevision;
1224         }
1225     }
1226
1227     my %preparedPatchHash;
1228
1229     $preparedPatchHash{copyDiffHashRefs} = \@copyDiffHashRefs;
1230     $preparedPatchHash{nonCopyDiffHashRefs} = \@nonCopyDiffHashRefs;
1231     $preparedPatchHash{sourceRevisionHash} = \%sourceRevisionHash;
1232
1233     return \%preparedPatchHash;
1234 }
1235
1236 # Return localtime() for the project's time zone, given an integer time as
1237 # returned by Perl's time() function.
1238 sub localTimeInProjectTimeZone($)
1239 {
1240     my $epochTime = shift;
1241
1242     # Change the time zone temporarily for the localtime() call.
1243     my $savedTimeZone = $ENV{'TZ'};
1244     $ENV{'TZ'} = $changeLogTimeZone;
1245     my @localTime = localtime($epochTime);
1246     if (defined $savedTimeZone) {
1247          $ENV{'TZ'} = $savedTimeZone;
1248     } else {
1249          delete $ENV{'TZ'};
1250     }
1251
1252     return @localTime;
1253 }
1254
1255 # Set the reviewer and date in a ChangeLog patch, and return the new patch.
1256 #
1257 # Args:
1258 #   $patch: a ChangeLog patch as a string.
1259 #   $reviewer: the name of the reviewer, or undef if the reviewer should not be set.
1260 #   $epochTime: an integer time as returned by Perl's time() function.
1261 sub setChangeLogDateAndReviewer($$$)
1262 {
1263     my ($patch, $reviewer, $epochTime) = @_;
1264
1265     my @localTime = localTimeInProjectTimeZone($epochTime);
1266     my $newDate = strftime("%Y-%m-%d", @localTime);
1267
1268     my $firstChangeLogLineRegEx = qr#(\n\+)\d{4}-[^-]{2}-[^-]{2}(  )#;
1269     $patch =~ s/$firstChangeLogLineRegEx/$1$newDate$2/;
1270
1271     if (defined($reviewer)) {
1272         # We include a leading plus ("+") in the regular expression to make
1273         # the regular expression less likely to match text in the leading junk
1274         # for the patch, if the patch has leading junk.
1275         $patch =~ s/(\n\+.*)NOBODY \(OOPS!\)/$1$reviewer/;
1276     }
1277
1278     return $patch;
1279 }
1280
1281 # If possible, returns a ChangeLog patch equivalent to the given one,
1282 # but with the newest ChangeLog entry inserted at the top of the
1283 # file -- i.e. no leading context and all lines starting with "+".
1284 #
1285 # If given a patch string not representable as a patch with the above
1286 # properties, it returns the input back unchanged.
1287 #
1288 # WARNING: This subroutine can return an inequivalent patch string if
1289 # both the beginning of the new ChangeLog file matches the beginning
1290 # of the source ChangeLog, and the source beginning was modified.
1291 # Otherwise, it is guaranteed to return an equivalent patch string,
1292 # if it returns.
1293 #
1294 # Applying this subroutine to ChangeLog patches allows svn-apply to
1295 # insert new ChangeLog entries at the top of the ChangeLog file.
1296 # svn-apply uses patch with --fuzz=3 to do this. We need to apply
1297 # this subroutine because the diff(1) command is greedy when matching
1298 # lines. A new ChangeLog entry with the same date and author as the
1299 # previous will match and cause the diff to have lines of starting
1300 # context.
1301 #
1302 # This subroutine has unit tests in VCSUtils_unittest.pl.
1303 #
1304 # Returns $changeLogHashRef:
1305 #   $changeLogHashRef: a hash reference representing a change log patch.
1306 #     patch: a ChangeLog patch equivalent to the given one, but with the
1307 #            newest ChangeLog entry inserted at the top of the file, if possible.
1308 #     hasOverlappingLines: the value 1 if the change log entry overlaps
1309 #                          some lines of another change log entry. This can
1310 #                          happen when deliberately inserting a new ChangeLog
1311 #                          entry earlier in the file above an entry with
1312 #                          the same date and author.                     
1313 sub fixChangeLogPatch($)
1314 {
1315     my $patch = shift; # $patch will only contain patch fragments for ChangeLog.
1316
1317     $patch =~ /(\r?\n)/;
1318     my $lineEnding = $1;
1319     my @lines = split(/$lineEnding/, $patch);
1320
1321     my $i = 0; # We reuse the same index throughout.
1322
1323     # Skip to beginning of first chunk.
1324     for (; $i < @lines; ++$i) {
1325         if (substr($lines[$i], 0, 1) eq "@") {
1326             last;
1327         }
1328     }
1329     my $chunkStartIndex = ++$i;
1330     my %changeLogHashRef;
1331
1332     # Optimization: do not process if new lines already begin the chunk.
1333     if (substr($lines[$i], 0, 1) eq "+") {
1334         $changeLogHashRef{patch} = $patch;
1335         return \%changeLogHashRef;
1336     }
1337
1338     # Skip to first line of newly added ChangeLog entry.
1339     # For example, +2009-06-03  Eric Seidel  <eric@webkit.org>
1340     my $dateStartRegEx = '^\+(\d{4}-\d{2}-\d{2})' # leading "+" and date
1341                          . '\s+(.+)\s+' # name
1342                          . '<([^<>]+)>$'; # e-mail address
1343
1344     for (; $i < @lines; ++$i) {
1345         my $line = $lines[$i];
1346         my $firstChar = substr($line, 0, 1);
1347         if ($line =~ /$dateStartRegEx/) {
1348             last;
1349         } elsif ($firstChar eq " " or $firstChar eq "+") {
1350             next;
1351         }
1352         $changeLogHashRef{patch} = $patch; # Do not change if, for example, "-" or "@" found.
1353         return \%changeLogHashRef;
1354     }
1355     if ($i >= @lines) {
1356         $changeLogHashRef{patch} = $patch; # Do not change if date not found.
1357         return \%changeLogHashRef;
1358     }
1359     my $dateStartIndex = $i;
1360
1361     # Rewrite overlapping lines to lead with " ".
1362     my @overlappingLines = (); # These will include a leading "+".
1363     for (; $i < @lines; ++$i) {
1364         my $line = $lines[$i];
1365         if (substr($line, 0, 1) ne "+") {
1366           last;
1367         }
1368         push(@overlappingLines, $line);
1369         $lines[$i] = " " . substr($line, 1);
1370     }
1371
1372     # Remove excess ending context, if necessary.
1373     my $shouldTrimContext = 1;
1374     for (; $i < @lines; ++$i) {
1375         my $firstChar = substr($lines[$i], 0, 1);
1376         if ($firstChar eq " ") {
1377             next;
1378         } elsif ($firstChar eq "@") {
1379             last;
1380         }
1381         $shouldTrimContext = 0; # For example, if "+" or "-" encountered.
1382         last;
1383     }
1384     my $deletedLineCount = 0;
1385     if ($shouldTrimContext) { # Also occurs if end of file reached.
1386         splice(@lines, $i - @overlappingLines, @overlappingLines);
1387         $deletedLineCount = @overlappingLines;
1388     }
1389
1390     # Work backwards, shifting overlapping lines towards front
1391     # while checking that patch stays equivalent.
1392     for ($i = $dateStartIndex - 1; @overlappingLines && $i >= $chunkStartIndex; --$i) {
1393         my $line = $lines[$i];
1394         if (substr($line, 0, 1) ne " ") {
1395             next;
1396         }
1397         my $text = substr($line, 1);
1398         my $newLine = pop(@overlappingLines);
1399         if ($text ne substr($newLine, 1)) {
1400             $changeLogHashRef{patch} = $patch; # Unexpected difference.
1401             return \%changeLogHashRef;
1402         }
1403         $lines[$i] = "+$text";
1404     }
1405
1406     # Finish moving whatever overlapping lines remain, and update
1407     # the initial chunk range.
1408     my $chunkRangeRegEx = '^\@\@ -(\d+),(\d+) \+\d+,(\d+) \@\@$'; # e.g. @@ -2,6 +2,18 @@
1409     if ($lines[$chunkStartIndex - 1] !~ /$chunkRangeRegEx/) {
1410         # FIXME: Handle errors differently from ChangeLog files that
1411         # are okay but should not be altered. That way we can find out
1412         # if improvements to the script ever become necessary.
1413         $changeLogHashRef{patch} = $patch; # Error: unexpected patch string format.
1414         return \%changeLogHashRef;
1415     }
1416     my $skippedFirstLineCount = $1 - 1;
1417     my $oldSourceLineCount = $2;
1418     my $oldTargetLineCount = $3;
1419
1420     if (@overlappingLines != $skippedFirstLineCount) {
1421         # This can happen, for example, when deliberately inserting
1422         # a new ChangeLog entry earlier in the file.
1423         $changeLogHashRef{hasOverlappingLines} = 1;
1424         $changeLogHashRef{patch} = $patch;
1425         return \%changeLogHashRef;
1426     }
1427     # If @overlappingLines > 0, this is where we make use of the
1428     # assumption that the beginning of the source file was not modified.
1429     splice(@lines, $chunkStartIndex, 0, @overlappingLines);
1430
1431     my $sourceLineCount = $oldSourceLineCount + @overlappingLines - $deletedLineCount;
1432     my $targetLineCount = $oldTargetLineCount + @overlappingLines - $deletedLineCount;
1433     $lines[$chunkStartIndex - 1] = "@@ -1,$sourceLineCount +1,$targetLineCount @@";
1434
1435     $changeLogHashRef{patch} = join($lineEnding, @lines) . "\n"; # patch(1) expects an extra trailing newline.
1436     return \%changeLogHashRef;
1437 }
1438
1439 # This is a supporting method for runPatchCommand.
1440 #
1441 # Arg: the optional $args parameter passed to runPatchCommand (can be undefined).
1442 #
1443 # Returns ($patchCommand, $isForcing).
1444 #
1445 # This subroutine has unit tests in VCSUtils_unittest.pl.
1446 sub generatePatchCommand($)
1447 {
1448     my ($passedArgsHashRef) = @_;
1449
1450     my $argsHashRef = { # Defaults
1451         ensureForce => 0,
1452         shouldReverse => 0,
1453         options => []
1454     };
1455     
1456     # Merges hash references. It's okay here if passed hash reference is undefined.
1457     @{$argsHashRef}{keys %{$passedArgsHashRef}} = values %{$passedArgsHashRef};
1458     
1459     my $ensureForce = $argsHashRef->{ensureForce};
1460     my $shouldReverse = $argsHashRef->{shouldReverse};
1461     my $options = $argsHashRef->{options};
1462
1463     if (! $options) {
1464         $options = [];
1465     } else {
1466         $options = [@{$options}]; # Copy to avoid side effects.
1467     }
1468
1469     my $isForcing = 0;
1470     if (grep /^--force$/, @{$options}) {
1471         $isForcing = 1;
1472     } elsif ($ensureForce) {
1473         push @{$options}, "--force";
1474         $isForcing = 1;
1475     }
1476
1477     if ($shouldReverse) { # No check: --reverse should never be passed explicitly.
1478         push @{$options}, "--reverse";
1479     }
1480
1481     @{$options} = sort(@{$options}); # For easier testing.
1482
1483     my $patchCommand = join(" ", "patch -p0", @{$options});
1484
1485     return ($patchCommand, $isForcing);
1486 }
1487
1488 # Apply the given patch using the patch(1) command.
1489 #
1490 # On success, return the resulting exit status. Otherwise, exit with the
1491 # exit status. If "--force" is passed as an option, however, then never
1492 # exit and always return the exit status.
1493 #
1494 # Args:
1495 #   $patch: a patch string.
1496 #   $repositoryRootPath: an absolute path to the repository root.
1497 #   $pathRelativeToRoot: the path of the file to be patched, relative to the
1498 #                        repository root. This should normally be the path
1499 #                        found in the patch's "Index:" line. It is passed
1500 #                        explicitly rather than reparsed from the patch
1501 #                        string for optimization purposes.
1502 #                            This is used only for error reporting. The
1503 #                        patch command gleans the actual file to patch
1504 #                        from the patch string.
1505 #   $args: a reference to a hash of optional arguments. The possible
1506 #          keys are --
1507 #            ensureForce: whether to ensure --force is passed (defaults to 0).
1508 #            shouldReverse: whether to pass --reverse (defaults to 0).
1509 #            options: a reference to an array of options to pass to the
1510 #                     patch command. The subroutine passes the -p0 option
1511 #                     no matter what. This should not include --reverse.
1512 #
1513 # This subroutine has unit tests in VCSUtils_unittest.pl.
1514 sub runPatchCommand($$$;$)
1515 {
1516     my ($patch, $repositoryRootPath, $pathRelativeToRoot, $args) = @_;
1517
1518     my ($patchCommand, $isForcing) = generatePatchCommand($args);
1519
1520     # Temporarily change the working directory since the path found
1521     # in the patch's "Index:" line is relative to the repository root
1522     # (i.e. the same as $pathRelativeToRoot).
1523     my $cwd = Cwd::getcwd();
1524     chdir $repositoryRootPath;
1525
1526     open PATCH, "| $patchCommand" or die "Could not call \"$patchCommand\" for file \"$pathRelativeToRoot\": $!";
1527     print PATCH $patch;
1528     close PATCH;
1529     my $exitStatus = exitStatus($?);
1530
1531     chdir $cwd;
1532
1533     if ($exitStatus && !$isForcing) {
1534         print "Calling \"$patchCommand\" for file \"$pathRelativeToRoot\" returned " .
1535               "status $exitStatus.  Pass --force to ignore patch failures.\n";
1536         exit $exitStatus;
1537     }
1538
1539     return $exitStatus;
1540 }
1541
1542 # Merge ChangeLog patches using a three-file approach.
1543 #
1544 # This is used by resolve-ChangeLogs when it's operated as a merge driver
1545 # and when it's used to merge conflicts after a patch is applied or after
1546 # an svn update.
1547 #
1548 # It's also used for traditional rejected patches.
1549 #
1550 # Args:
1551 #   $fileMine:  The merged version of the file.  Also known in git as the
1552 #               other branch's version (%B) or "ours".
1553 #               For traditional patch rejects, this is the *.rej file.
1554 #   $fileOlder: The base version of the file.  Also known in git as the
1555 #               ancestor version (%O) or "base".
1556 #               For traditional patch rejects, this is the *.orig file.
1557 #   $fileNewer: The current version of the file.  Also known in git as the
1558 #               current version (%A) or "theirs".
1559 #               For traditional patch rejects, this is the original-named
1560 #               file.
1561 #
1562 # Returns 1 if merge was successful, else 0.
1563 sub mergeChangeLogs($$$)
1564 {
1565     my ($fileMine, $fileOlder, $fileNewer) = @_;
1566
1567     my $traditionalReject = $fileMine =~ /\.rej$/ ? 1 : 0;
1568
1569     local $/ = undef;
1570
1571     my $patch;
1572     if ($traditionalReject) {
1573         open(DIFF, "<", $fileMine) or die $!;
1574         $patch = <DIFF>;
1575         close(DIFF);
1576         rename($fileMine, "$fileMine.save");
1577         rename($fileOlder, "$fileOlder.save");
1578     } else {
1579         open(DIFF, "-|", qw(diff -u -a --binary), $fileOlder, $fileMine) or die $!;
1580         $patch = <DIFF>;
1581         close(DIFF);
1582     }
1583
1584     unlink("${fileNewer}.orig");
1585     unlink("${fileNewer}.rej");
1586
1587     open(PATCH, "| patch --force --fuzz=3 --binary $fileNewer > " . File::Spec->devnull()) or die $!;
1588     if ($traditionalReject) {
1589         print PATCH $patch;
1590     } else {
1591         my $changeLogHash = fixChangeLogPatch($patch);
1592         print PATCH $changeLogHash->{patch};
1593     }
1594     close(PATCH);
1595
1596     my $result = !exitStatus($?);
1597
1598     # Refuse to merge the patch if it did not apply cleanly
1599     if (-e "${fileNewer}.rej") {
1600         unlink("${fileNewer}.rej");
1601         if (-f "${fileNewer}.orig") {
1602             unlink($fileNewer);
1603             rename("${fileNewer}.orig", $fileNewer);
1604         }
1605     } else {
1606         unlink("${fileNewer}.orig");
1607     }
1608
1609     if ($traditionalReject) {
1610         rename("$fileMine.save", $fileMine);
1611         rename("$fileOlder.save", $fileOlder);
1612     }
1613
1614     return $result;
1615 }
1616
1617 sub gitConfig($)
1618 {
1619     return unless $isGit;
1620
1621     my ($config) = @_;
1622
1623     my $result = `git config $config`;
1624     if (($? >> 8)) {
1625         $result = `git repo-config $config`;
1626     }
1627     chomp $result;
1628     return $result;
1629 }
1630
1631 sub changeLogNameError($)
1632 {
1633     my ($message) = @_;
1634     print STDERR "$message\nEither:\n";
1635     print STDERR "  set CHANGE_LOG_NAME in your environment\n";
1636     print STDERR "  OR pass --name= on the command line\n";
1637     print STDERR "  OR set REAL_NAME in your environment";
1638     print STDERR "  OR git users can set 'git config user.name'\n";
1639     exit(1);
1640 }
1641
1642 sub changeLogName()
1643 {
1644     my $name = $ENV{CHANGE_LOG_NAME} || $ENV{REAL_NAME} || gitConfig("user.name") || (split /\s*,\s*/, (getpwuid $<)[6])[0];
1645
1646     changeLogNameError("Failed to determine ChangeLog name.") unless $name;
1647     # getpwuid seems to always succeed on windows, returning the username instead of the full name.  This check will catch that case.
1648     changeLogNameError("'$name' does not contain a space!  ChangeLogs should contain your full name.") unless ($name =~ /\w \w/);
1649
1650     return $name;
1651 }
1652
1653 sub changeLogEmailAddressError($)
1654 {
1655     my ($message) = @_;
1656     print STDERR "$message\nEither:\n";
1657     print STDERR "  set CHANGE_LOG_EMAIL_ADDRESS in your environment\n";
1658     print STDERR "  OR pass --email= on the command line\n";
1659     print STDERR "  OR set EMAIL_ADDRESS in your environment\n";
1660     print STDERR "  OR git users can set 'git config user.email'\n";
1661     exit(1);
1662 }
1663
1664 sub changeLogEmailAddress()
1665 {
1666     my $emailAddress = $ENV{CHANGE_LOG_EMAIL_ADDRESS} || $ENV{EMAIL_ADDRESS} || gitConfig("user.email");
1667
1668     changeLogEmailAddressError("Failed to determine email address for ChangeLog.") unless $emailAddress;
1669     changeLogEmailAddressError("Email address '$emailAddress' does not contain '\@' and is likely invalid.") unless ($emailAddress =~ /\@/);
1670
1671     return $emailAddress;
1672 }
1673
1674 # http://tools.ietf.org/html/rfc1924
1675 sub decodeBase85($)
1676 {
1677     my ($encoded) = @_;
1678     my %table;
1679     my @characters = ('0'..'9', 'A'..'Z', 'a'..'z', '!', '#', '$', '%', '&', '(', ')', '*', '+', '-', ';', '<', '=', '>', '?', '@', '^', '_', '`', '{', '|', '}', '~');
1680     for (my $i = 0; $i < 85; $i++) {
1681         $table{$characters[$i]} = $i;
1682     }
1683
1684     my $decoded = '';
1685     my @encodedChars = $encoded =~ /./g;
1686
1687     for (my $encodedIter = 0; defined($encodedChars[$encodedIter]);) {
1688         my $digit = 0;
1689         for (my $i = 0; $i < 5; $i++) {
1690             $digit *= 85;
1691             my $char = $encodedChars[$encodedIter];
1692             $digit += $table{$char};
1693             $encodedIter++;
1694         }
1695
1696         for (my $i = 0; $i < 4; $i++) {
1697             $decoded .= chr(($digit >> (3 - $i) * 8) & 255);
1698         }
1699     }
1700
1701     return $decoded;
1702 }
1703
1704 sub decodeGitBinaryChunk($$)
1705 {
1706     my ($contents, $fullPath) = @_;
1707
1708     # Load this module lazily in case the user don't have this module
1709     # and won't handle git binary patches.
1710     require Compress::Zlib;
1711
1712     my $encoded = "";
1713     my $compressedSize = 0;
1714     while ($contents =~ /^([A-Za-z])(.*)$/gm) {
1715         my $line = $2;
1716         next if $line eq "";
1717         die "$fullPath: unexpected size of a line: $&" if length($2) % 5 != 0;
1718         my $actualSize = length($2) / 5 * 4;
1719         my $encodedExpectedSize = ord($1);
1720         my $expectedSize = $encodedExpectedSize <= ord("Z") ? $encodedExpectedSize - ord("A") + 1 : $encodedExpectedSize - ord("a") + 27;
1721
1722         die "$fullPath: unexpected size of a line: $&" if int(($expectedSize + 3) / 4) * 4 != $actualSize;
1723         $compressedSize += $expectedSize;
1724         $encoded .= $line;
1725     }
1726
1727     my $compressed = decodeBase85($encoded);
1728     $compressed = substr($compressed, 0, $compressedSize);
1729     return Compress::Zlib::uncompress($compressed);
1730 }
1731
1732 sub decodeGitBinaryPatch($$)
1733 {
1734     my ($contents, $fullPath) = @_;
1735
1736     # Git binary patch has two chunks. One is for the normal patching
1737     # and another is for the reverse patching.
1738     #
1739     # Each chunk a line which starts from either "literal" or "delta",
1740     # followed by a number which specifies decoded size of the chunk.
1741     # The "delta" type chunks aren't supported by this function yet.
1742     #
1743     # Then, content of the chunk comes. To decode the content, we
1744     # need decode it with base85 first, and then zlib.
1745     my $gitPatchRegExp = '(literal|delta) ([0-9]+)\n([A-Za-z0-9!#$%&()*+-;<=>?@^_`{|}~\\n]*?)\n\n';
1746     if ($contents !~ m"\nGIT binary patch\n$gitPatchRegExp$gitPatchRegExp\Z") {
1747         die "$fullPath: unknown git binary patch format"
1748     }
1749
1750     my $binaryChunkType = $1;
1751     my $binaryChunkExpectedSize = $2;
1752     my $encodedChunk = $3;
1753     my $reverseBinaryChunkType = $4;
1754     my $reverseBinaryChunkExpectedSize = $5;
1755     my $encodedReverseChunk = $6;
1756
1757     my $binaryChunk = decodeGitBinaryChunk($encodedChunk, $fullPath);
1758     my $binaryChunkActualSize = length($binaryChunk);
1759     my $reverseBinaryChunk = decodeGitBinaryChunk($encodedReverseChunk, $fullPath);
1760     my $reverseBinaryChunkActualSize = length($reverseBinaryChunk);
1761
1762     die "$fullPath: unexpected size of the first chunk (expected $binaryChunkExpectedSize but was $binaryChunkActualSize" if ($binaryChunkExpectedSize != $binaryChunkActualSize);
1763     die "$fullPath: unexpected size of the second chunk (expected $reverseBinaryChunkExpectedSize but was $reverseBinaryChunkActualSize" if ($reverseBinaryChunkExpectedSize != $reverseBinaryChunkActualSize);
1764
1765     return ($binaryChunkType, $binaryChunk, $reverseBinaryChunkType, $reverseBinaryChunk);
1766 }
1767
1768 1;