1 # Copyright (C) 2007, 2008, 2009 Apple Inc. All rights reserved.
2 # Copyright (C) 2009, 2010 Chris Jerdonek (chris.jerdonek@gmail.com)
3 # Copyright (C) 2010, 2011 Research In Motion Limited. All rights reserved.
5 # Redistribution and use in source and binary forms, with or without
6 # modification, are permitted provided that the following conditions
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.
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.
29 # Module to share code to work with various version control systems.
35 use Cwd qw(); # "qw()" prevents warnings about redefining getcwd() with "use POSIX;"
36 use English; # for $POSTMATCH, etc.
40 use Term::ANSIColor qw(colored);
44 our ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS);
48 &applyGitBinaryPatchDelta
51 &changeLogEmailAddress
54 &chdirReturningRelativePath
70 &isSVNVersion16OrNewer
77 &pathRelativeToSVNRepositoryRootForPath
84 &scmToggleExecutableBit
85 &setChangeLogDateAndReviewer
86 &svnRevisionForDirectory
100 my $isGitBranchBuild;
104 # Project time zone for Cupertino, CA, US
105 my $changeLogTimeZone = "PST8PDT";
107 my $gitDiffStartRegEx = qr#^diff --git (\w/)?(.+) (\w/)?([^\r\n]+)#;
108 my $svnDiffStartRegEx = qr#^Index: ([^\r\n]+)#;
109 my $svnPropertiesStartRegEx = qr#^Property changes on: ([^\r\n]+)#; # $1 is normally the same as the index path.
110 my $svnPropertyStartRegEx = qr#^(Modified|Name|Added|Deleted): ([^\r\n]+)#; # $2 is the name of the property.
111 my $svnPropertyValueStartRegEx = qr#^ (\+|-|Merged|Reverse-merged) ([^\r\n]+)#; # $2 is the start of the property's value (which may span multiple lines).
113 # This method is for portability. Return the system-appropriate exit
114 # status of a child process.
116 # Args: pass the child error status returned by the last pipe close,
120 my ($returnvalue) = @_;
121 if ($^O eq "MSWin32") {
122 return $returnvalue >> 8;
124 if (!WIFEXITED($returnvalue)) {
127 return WEXITSTATUS($returnvalue);
130 # Call a function while suppressing STDERR, and return the return values
132 sub callSilently($@) {
133 my ($func, @args) = @_;
135 # The following pattern was taken from here:
136 # http://www.sdsc.edu/~moreland/courses/IntroPerl/docs/manual/pod/perlfunc/open.html
138 # Also see this Perl documentation (search for "open OLDERR"):
139 # http://perldoc.perl.org/functions/open.html
140 open(OLDERR, ">&STDERR");
142 my @returnValue = &$func(@args);
143 open(STDERR, ">&OLDERR");
149 sub toWindowsLineEndings
152 $text =~ s/\n/\r\n/g;
156 # Note, this method will not error if the file corresponding to the $source path does not exist.
157 sub scmMoveOrRenameFile
159 my ($source, $destination) = @_;
160 return if ! -e $source;
162 my $escapedDestination = escapeSubversionPath($destination);
163 my $escapedSource = escapeSubversionPath($source);
164 system("svn", "move", $escapedSource, $escapedDestination);
166 system("git", "mv", $source, $destination);
170 # Note, this method will not error if the file corresponding to the path does not exist.
171 sub scmToggleExecutableBit
173 my ($path, $executableBitDelta) = @_;
174 return if ! -e $path;
175 if ($executableBitDelta == 1) {
176 scmAddExecutableBit($path);
177 } elsif ($executableBitDelta == -1) {
178 scmRemoveExecutableBit($path);
182 sub scmAddExecutableBit($)
187 my $escapedPath = escapeSubversionPath($path);
188 system("svn", "propset", "svn:executable", "on", $escapedPath) == 0 or die "Failed to run 'svn propset svn:executable on $escapedPath'.";
194 sub scmRemoveExecutableBit($)
199 my $escapedPath = escapeSubversionPath($path);
200 system("svn", "propdel", "svn:executable", $escapedPath) == 0 or die "Failed to run 'svn propdel svn:executable $escapedPath'.";
206 sub isGitDirectory($)
209 return system("cd $dir && git rev-parse > " . File::Spec->devnull() . " 2>&1") == 0;
214 return $isGit if defined $isGit;
216 $isGit = isGitDirectory(".");
222 return $isGitSVN if defined $isGitSVN;
224 # There doesn't seem to be an officially documented way to determine
225 # if you're in a git-svn checkout. The best suggestions seen so far
226 # all use something like the following:
227 my $output = `git config --get svn-remote.svn.fetch 2>& 1`;
228 $isGitSVN = $output ne '';
234 unless (defined $gitBranch) {
235 chomp($gitBranch = `git symbolic-ref -q HEAD`);
236 $gitBranch = "" if exitStatus($?);
237 $gitBranch =~ s#^refs/heads/##;
238 $gitBranch = "" if $gitBranch eq "master";
244 sub isGitBranchBuild()
246 my $branch = gitBranch();
247 chomp(my $override = `git config --bool branch.$branch.webKitBranchBuild`);
248 return 1 if $override eq "true";
249 return 0 if $override eq "false";
251 unless (defined $isGitBranchBuild) {
252 chomp(my $gitBranchBuild = `git config --bool core.webKitBranchBuild`);
253 $isGitBranchBuild = $gitBranchBuild eq "true";
256 return $isGitBranchBuild;
259 sub isSVNDirectory($)
262 return system("cd $dir && svn info > " . File::Spec->devnull() . " 2>&1") == 0;
267 return $isSVN if defined $isSVN;
269 $isSVN = isSVNDirectory(".");
275 return $svnVersion if defined $svnVersion;
280 chomp($svnVersion = `svn --version --quiet`);
285 sub isSVNVersion16OrNewer()
287 my $version = svnVersion();
288 return eval "v$version" ge v1.6;
291 sub chdirReturningRelativePath($)
293 my ($directory) = @_;
294 my $previousDirectory = Cwd::getcwd();
296 my $newDirectory = Cwd::getcwd();
297 return "." if $newDirectory eq $previousDirectory;
298 return File::Spec->abs2rel($previousDirectory, $newDirectory);
301 sub determineGitRoot()
303 chomp(my $gitDir = `git rev-parse --git-dir`);
304 return dirname($gitDir);
307 sub determineSVNRoot()
317 my $escapedPath = escapeSubversionPath($path);
318 # Ignore error messages in case we've run past the root of the checkout.
319 open INFO, "svn info '$escapedPath' 2> " . File::Spec->devnull() . " |" or die;
321 if (/^Repository Root: (.+)/) {
324 if (/^Repository UUID: (.+)/) {
327 if ($thisRoot && $thisUUID) {
329 <INFO>; # Consume the rest of the input.
334 # It's possible (e.g. for developers of some ports) to have a WebKit
335 # checkout in a subdirectory of another checkout. So abort if the
336 # repository root or the repository UUID suddenly changes.
338 $repositoryUUID = $thisUUID if !$repositoryUUID;
339 last if $thisUUID ne $repositoryUUID;
342 $repositoryRoot = $thisRoot if !$repositoryRoot;
343 last if $thisRoot ne $repositoryRoot;
346 $path = File::Spec->catdir($parent, $path);
349 return File::Spec->rel2abs($last);
352 sub determineVCSRoot()
355 return determineGitRoot();
359 # Some users have a workflow where svn-create-patch, svn-apply and
360 # svn-unapply are used outside of multiple svn working directores,
361 # so warn the user and assume Subversion is being used in this case.
362 warn "Unable to determine VCS root for '" . Cwd::getcwd() . "'; assuming Subversion";
366 return determineSVNRoot();
369 sub svnRevisionForDirectory($)
374 if (isSVNDirectory($dir)) {
375 my $escapedDir = escapeSubversionPath($dir);
376 my $svnInfo = `LC_ALL=C svn info $escapedDir | grep Revision:`;
377 ($revision) = ($svnInfo =~ m/Revision: (\d+).*/g);
378 } elsif (isGitDirectory($dir)) {
379 my $gitLog = `cd $dir && LC_ALL=C git log --grep='git-svn-id: ' -n 1 | grep git-svn-id:`;
380 ($revision) = ($gitLog =~ m/ +git-svn-id: .+@(\d+) /g);
382 if (!defined($revision)) {
383 $revision = "unknown";
384 warn "Unable to determine current SVN revision in $dir";
389 sub pathRelativeToSVNRepositoryRootForPath($)
392 my $relativePath = File::Spec->abs2rel($file);
396 my $escapedRelativePath = escapeSubversionPath($relativePath);
397 $svnInfo = `LC_ALL=C svn info $escapedRelativePath`;
399 $svnInfo = `LC_ALL=C git svn info $relativePath`;
402 $svnInfo =~ /.*^URL: (.*?)$/m;
405 $svnInfo =~ /.*^Repository Root: (.*?)$/m;
406 my $repositoryRoot = $1;
408 $svnURL =~ s/$repositoryRoot\///;
412 sub makeFilePathRelative($)
415 return $path unless isGit();
417 unless (defined $gitRoot) {
418 chomp($gitRoot = `git rev-parse --show-cdup`);
420 return $gitRoot . $path;
430 sub possiblyColored($$)
432 my ($colors, $string) = @_;
435 return colored([$colors], $string);
441 sub adjustPathForRecentRenamings($)
445 $fullPath =~ s|WebCore/webaudio|WebCore/Modules/webaudio|g;
446 $fullPath =~ s|JavaScriptCore/wtf|WTF/wtf|g;
447 $fullPath =~ s|test_expectations.txt|TestExpectations|g;
452 sub canonicalizePath($)
456 # Remove extra slashes and '.' directories in path
457 $file = File::Spec->canonpath($file);
459 # Remove '..' directories in path
461 foreach my $dir (File::Spec->splitdir($file)) {
462 if ($dir eq '..' && $#dirs >= 0 && $dirs[$#dirs] ne '..') {
468 return ($#dirs >= 0) ? File::Spec->catdir(@dirs) : ".";
474 return "" unless $line;
476 $line =~ s/[\r\n]+$//g;
482 my ($fileHandle) = @_;
484 # Make input record separator the new-line character to simplify regex matching below.
485 my $savedInputRecordSeparator = $INPUT_RECORD_SEPARATOR;
486 $INPUT_RECORD_SEPARATOR = "\n";
487 my $firstLine = <$fileHandle>;
488 $INPUT_RECORD_SEPARATOR = $savedInputRecordSeparator;
490 return unless defined($firstLine);
493 if ($firstLine =~ /\r\n/) {
495 } elsif ($firstLine =~ /\r/) {
497 } elsif ($firstLine =~ /\n/) {
503 sub firstEOLInFile($)
507 if (open(FILE, $file)) {
508 $eol = parseFirstEOL(*FILE);
514 # Parses a chunk range line into its components.
516 # A chunk range line has the form: @@ -L_1,N_1 +L_2,N_2 @@, where the pairs (L_1, N_1),
517 # (L_2, N_2) are ranges that represent the starting line number and line count in the
518 # original file and new file, respectively.
520 # Note, some versions of GNU diff may omit the comma and trailing line count (e.g. N_1),
521 # in which case the omitted line count defaults to 1. For example, GNU diff may output
522 # @@ -1 +1 @@, which is equivalent to @@ -1,1 +1,1 @@.
524 # This subroutine returns undef if given an invalid or malformed chunk range.
527 # $line: the line to parse.
529 # Returns $chunkRangeHashRef
530 # $chunkRangeHashRef: a hash reference representing the parts of a chunk range, as follows--
531 # startingLine: the starting line in the original file.
532 # lineCount: the line count in the original file.
533 # newStartingLine: the new starting line in the new file.
534 # newLineCount: the new line count in the new file.
535 sub parseChunkRange($)
538 my $chunkRangeRegEx = qr#^\@\@ -(\d+)(,(\d+))? \+(\d+)(,(\d+))? \@\@#;
539 if ($line !~ /$chunkRangeRegEx/) {
543 $chunkRange{startingLine} = $1;
544 $chunkRange{lineCount} = defined($2) ? $3 : 1;
545 $chunkRange{newStartingLine} = $4;
546 $chunkRange{newLineCount} = defined($5) ? $6 : 1;
553 my $escapedFullPath = escapeSubversionPath($fullPath);
555 open SVN, "svn status --non-interactive --non-recursive '$escapedFullPath' |" or die;
557 # When running "svn stat" on a directory, we can't assume that only one
558 # status will be returned (since any files with a status below the
559 # directory will be returned), and we can't assume that the directory will
560 # be first (since any files with unknown status will be listed first).
561 my $normalizedFullPath = File::Spec->catdir(File::Spec->splitdir($fullPath));
563 # Input may use a different EOL sequence than $/, so avoid chomp.
565 my $normalizedStatPath = File::Spec->catdir(File::Spec->splitdir(substr($_, 7)));
566 if ($normalizedFullPath eq $normalizedStatPath) {
571 # Read the rest of the svn command output to avoid a broken pipe warning.
576 # Files will have only one status returned.
577 $svnStatus = removeEOL(<SVN>) . "\n";
583 # Return whether the given file mode is executable in the source control
584 # sense. We make this determination based on whether the executable bit
585 # is set for "others" rather than the stronger condition that it be set
586 # for the user, group, and others. This is sufficient for distinguishing
587 # the default behavior in Git and SVN.
590 # $fileMode: A number or string representing a file mode in octal notation.
593 my $fileMode = shift;
595 return $fileMode % 2;
598 # Parse the next Git diff header from the given file handle, and advance
599 # the handle so the last line read is the first line after the header.
601 # This subroutine dies if given leading junk.
604 # $fileHandle: advanced so the last line read from the handle is the first
605 # line of the header to parse. This should be a line
606 # beginning with "diff --git".
607 # $line: the line last read from $fileHandle
609 # Returns ($headerHashRef, $lastReadLine):
610 # $headerHashRef: a hash reference representing a diff header, as follows--
611 # copiedFromPath: the path from which the file was copied or moved if
612 # the diff is a copy or move.
613 # executableBitDelta: the value 1 or -1 if the executable bit was added or
614 # removed, respectively. New and deleted files have
615 # this value only if the file is executable, in which
616 # case the value is 1 and -1, respectively.
617 # indexPath: the path of the target file.
618 # isBinary: the value 1 if the diff is for a binary file.
619 # isDeletion: the value 1 if the diff is a file deletion.
620 # isCopyWithChanges: the value 1 if the file was copied or moved and
621 # the target file was changed in some way after being
622 # copied or moved (e.g. if its contents or executable
624 # isNew: the value 1 if the diff is for a new file.
625 # shouldDeleteSource: the value 1 if the file was copied or moved and
626 # the source file was deleted -- i.e. if the copy
627 # was actually a move.
628 # svnConvertedText: the header text with some lines converted to SVN
629 # format. Git-specific lines are preserved.
630 # $lastReadLine: the line last read from $fileHandle.
631 sub parseGitDiffHeader($$)
633 my ($fileHandle, $line) = @_;
638 if (/$gitDiffStartRegEx/) {
639 # The first and second paths can differ in the case of copies
640 # and renames. We use the second file path because it is the
642 $indexPath = adjustPathForRecentRenamings($4);
643 # Use $POSTMATCH to preserve the end-of-line character.
644 $_ = "Index: $indexPath$POSTMATCH"; # Convert to SVN format.
646 die("Could not parse leading \"diff --git\" line: \"$line\".");
650 my $foundHeaderEnding;
654 my $newExecutableBit = 0;
655 my $oldExecutableBit = 0;
656 my $shouldDeleteSource = 0;
657 my $similarityIndex = 0;
658 my $svnConvertedText;
660 # Temporarily strip off any end-of-line characters to simplify
661 # regex matching below.
665 if (/^(deleted file|old) mode (\d+)/) {
666 $oldExecutableBit = (isExecutable($2) ? 1 : 0);
667 $isDeletion = 1 if $1 eq "deleted file";
668 } elsif (/^new( file)? mode (\d+)/) {
669 $newExecutableBit = (isExecutable($2) ? 1 : 0);
671 } elsif (/^similarity index (\d+)%/) {
672 $similarityIndex = $1;
673 } elsif (/^copy from (\S+)/) {
674 $copiedFromPath = $1;
675 } elsif (/^rename from (\S+)/) {
676 # FIXME: Record this as a move rather than as a copy-and-delete.
677 # This will simplify adding rename support to svn-unapply.
678 # Otherwise, the hash for a deletion would have to know
679 # everything about the file being deleted in order to
680 # support undoing itself. Recording as a move will also
681 # permit us to use "svn move" and "git move".
682 $copiedFromPath = $1;
683 $shouldDeleteSource = 1;
684 } elsif (/^--- \S+/) {
685 $_ = "--- $indexPath"; # Convert to SVN format.
686 } elsif (/^\+\+\+ \S+/) {
687 $_ = "+++ $indexPath"; # Convert to SVN format.
688 $foundHeaderEnding = 1;
689 } elsif (/^GIT binary patch$/ ) {
691 $foundHeaderEnding = 1;
692 # The "git diff" command includes a line of the form "Binary files
693 # <path1> and <path2> differ" if the --binary flag is not used.
694 } elsif (/^Binary files / ) {
695 die("Error: the Git diff contains a binary file without the binary data in ".
696 "line: \"$_\". Be sure to use the --binary flag when invoking \"git diff\" ".
697 "with diffs containing binary files.");
700 $svnConvertedText .= "$_$eol"; # Also restore end-of-line characters.
702 $_ = <$fileHandle>; # Not defined if end-of-file reached.
704 last if (!defined($_) || /$gitDiffStartRegEx/ || $foundHeaderEnding);
707 my $executableBitDelta = $newExecutableBit - $oldExecutableBit;
711 $header{copiedFromPath} = $copiedFromPath if $copiedFromPath;
712 $header{executableBitDelta} = $executableBitDelta if $executableBitDelta;
713 $header{indexPath} = $indexPath;
714 $header{isBinary} = $isBinary if $isBinary;
715 $header{isCopyWithChanges} = 1 if ($copiedFromPath && ($similarityIndex != 100 || $executableBitDelta));
716 $header{isDeletion} = $isDeletion if $isDeletion;
717 $header{isNew} = $isNew if $isNew;
718 $header{shouldDeleteSource} = $shouldDeleteSource if $shouldDeleteSource;
719 $header{svnConvertedText} = $svnConvertedText;
721 return (\%header, $_);
724 # Parse the next SVN diff header from the given file handle, and advance
725 # the handle so the last line read is the first line after the header.
727 # This subroutine dies if given leading junk or if it could not detect
728 # the end of the header block.
731 # $fileHandle: advanced so the last line read from the handle is the first
732 # line of the header to parse. This should be a line
733 # beginning with "Index:".
734 # $line: the line last read from $fileHandle
736 # Returns ($headerHashRef, $lastReadLine):
737 # $headerHashRef: a hash reference representing a diff header, as follows--
738 # copiedFromPath: the path from which the file was copied if the diff
740 # indexPath: the path of the target file, which is the path found in
742 # isBinary: the value 1 if the diff is for a binary file.
743 # isNew: the value 1 if the diff is for a new file.
744 # sourceRevision: the revision number of the source, if it exists. This
745 # is the same as the revision number the file was copied
746 # from, in the case of a file copy.
747 # svnConvertedText: the header text converted to a header with the paths
748 # in some lines corrected.
749 # $lastReadLine: the line last read from $fileHandle.
750 sub parseSvnDiffHeader($$)
752 my ($fileHandle, $line) = @_;
757 if (/$svnDiffStartRegEx/) {
758 $indexPath = adjustPathForRecentRenamings($1);
760 die("First line of SVN diff does not begin with \"Index \": \"$_\"");
764 my $foundHeaderEnding;
768 my $svnConvertedText;
770 # Temporarily strip off any end-of-line characters to simplify
771 # regex matching below.
775 # Fix paths on "---" and "+++" lines to match the leading
777 if (s/^--- [^\t\n\r]+/--- $indexPath/) {
779 if (/^--- .+\(revision (\d+)\)/) {
780 $sourceRevision = $1;
781 $isNew = 1 if !$sourceRevision; # if revision 0.
782 if (/\(from (\S+):(\d+)\)$/) {
783 # The "from" clause is created by svn-create-patch, in
784 # which case there is always also a "revision" clause.
785 $copiedFromPath = $1;
786 die("Revision number \"$2\" in \"from\" clause does not match " .
787 "source revision number \"$sourceRevision\".") if ($2 != $sourceRevision);
790 } elsif (s/^\+\+\+ [^\t\n\r]+/+++ $indexPath/) {
791 $foundHeaderEnding = 1;
792 } elsif (/^Cannot display: file marked as a binary type.$/) {
794 $foundHeaderEnding = 1;
797 $svnConvertedText .= "$_$eol"; # Also restore end-of-line characters.
799 $_ = <$fileHandle>; # Not defined if end-of-file reached.
801 last if (!defined($_) || /$svnDiffStartRegEx/ || $foundHeaderEnding);
804 if (!$foundHeaderEnding) {
805 die("Did not find end of header block corresponding to index path \"$indexPath\".");
810 $header{copiedFromPath} = $copiedFromPath if $copiedFromPath;
811 $header{indexPath} = $indexPath;
812 $header{isBinary} = $isBinary if $isBinary;
813 $header{isNew} = $isNew if $isNew;
814 $header{sourceRevision} = $sourceRevision if $sourceRevision;
815 $header{svnConvertedText} = $svnConvertedText;
817 return (\%header, $_);
820 # Parse the next diff header from the given file handle, and advance
821 # the handle so the last line read is the first line after the header.
823 # This subroutine dies if given leading junk or if it could not detect
824 # the end of the header block.
827 # $fileHandle: advanced so the last line read from the handle is the first
828 # line of the header to parse. For SVN-formatted diffs, this
829 # is a line beginning with "Index:". For Git, this is a line
830 # beginning with "diff --git".
831 # $line: the line last read from $fileHandle
833 # Returns ($headerHashRef, $lastReadLine):
834 # $headerHashRef: a hash reference representing a diff header
835 # copiedFromPath: the path from which the file was copied if the diff
837 # executableBitDelta: the value 1 or -1 if the executable bit was added or
838 # removed, respectively. New and deleted files have
839 # this value only if the file is executable, in which
840 # case the value is 1 and -1, respectively.
841 # indexPath: the path of the target file.
842 # isBinary: the value 1 if the diff is for a binary file.
843 # isGit: the value 1 if the diff is Git-formatted.
844 # isSvn: the value 1 if the diff is SVN-formatted.
845 # sourceRevision: the revision number of the source, if it exists. This
846 # is the same as the revision number the file was copied
847 # from, in the case of a file copy.
848 # svnConvertedText: the header text with some lines converted to SVN
849 # format. Git-specific lines are preserved.
850 # $lastReadLine: the line last read from $fileHandle.
851 sub parseDiffHeader($$)
853 my ($fileHandle, $line) = @_;
855 my $header; # This is a hash ref.
860 if ($line =~ $svnDiffStartRegEx) {
862 ($header, $lastReadLine) = parseSvnDiffHeader($fileHandle, $line);
863 } elsif ($line =~ $gitDiffStartRegEx) {
865 ($header, $lastReadLine) = parseGitDiffHeader($fileHandle, $line);
867 die("First line of diff does not begin with \"Index:\" or \"diff --git\": \"$line\"");
870 $header->{isGit} = $isGit if $isGit;
871 $header->{isSvn} = $isSvn if $isSvn;
873 return ($header, $lastReadLine);
876 # FIXME: The %diffHash "object" should not have an svnConvertedText property.
877 # Instead, the hash object should store its information in a
878 # structured way as properties. This should be done in a way so
879 # that, if necessary, the text of an SVN or Git patch can be
880 # reconstructed from the information in those hash properties.
882 # A %diffHash is a hash representing a source control diff of a single
883 # file operation (e.g. a file modification, copy, or delete).
885 # These hashes appear, for example, in the parseDiff(), parsePatch(),
886 # and prepareParsedPatch() subroutines of this package.
888 # The corresponding values are--
890 # copiedFromPath: the path from which the file was copied if the diff
892 # executableBitDelta: the value 1 or -1 if the executable bit was added or
893 # removed from the target file, respectively.
894 # indexPath: the path of the target file. For SVN-formatted diffs,
895 # this is the same as the path in the "Index:" line.
896 # isBinary: the value 1 if the diff is for a binary file.
897 # isDeletion: the value 1 if the diff is known from the header to be a deletion.
898 # isGit: the value 1 if the diff is Git-formatted.
899 # isNew: the value 1 if the dif is known from the header to be a new file.
900 # isSvn: the value 1 if the diff is SVN-formatted.
901 # sourceRevision: the revision number of the source, if it exists. This
902 # is the same as the revision number the file was copied
903 # from, in the case of a file copy.
904 # svnConvertedText: the diff with some lines converted to SVN format.
905 # Git-specific lines are preserved.
907 # Parse one diff from a patch file created by svn-create-patch, and
908 # advance the file handle so the last line read is the first line
909 # of the next header block.
911 # This subroutine preserves any leading junk encountered before the header.
913 # Composition of an SVN diff
915 # There are three parts to an SVN diff: the header, the property change, and
916 # the binary contents, in that order. Either the header or the property change
917 # may be ommitted, but not both. If there are binary changes, then you always
921 # $fileHandle: a file handle advanced to the first line of the next
922 # header block. Leading junk is okay.
923 # $line: the line last read from $fileHandle.
924 # $optionsHashRef: a hash reference representing optional options to use
925 # when processing a diff.
926 # shouldNotUseIndexPathEOL: whether to use the line endings in the diff instead
927 # instead of the line endings in the target file; the
928 # value of 1 if svnConvertedText should use the line
929 # endings in the diff.
931 # Returns ($diffHashRefs, $lastReadLine):
932 # $diffHashRefs: A reference to an array of references to %diffHash hashes.
933 # See the %diffHash documentation above.
934 # $lastReadLine: the line last read from $fileHandle
937 # FIXME: Adjust this method so that it dies if the first line does not
938 # match the start of a diff. This will require a change to
939 # parsePatch() so that parsePatch() skips over leading junk.
940 my ($fileHandle, $line, $optionsHashRef) = @_;
942 my $headerStartRegEx = $svnDiffStartRegEx; # SVN-style header for the default
944 my $headerHashRef; # Last header found, as returned by parseDiffHeader().
945 my $svnPropertiesHashRef; # Last SVN properties diff found, as returned by parseSvnDiffProperties().
948 my $numTextChunks = 0;
949 while (defined($line)) {
950 if (!$headerHashRef && ($line =~ $gitDiffStartRegEx)) {
951 # Then assume all diffs in the patch are Git-formatted. This
952 # block was made to be enterable at most once since we assume
953 # all diffs in the patch are formatted the same (SVN or Git).
954 $headerStartRegEx = $gitDiffStartRegEx;
957 if ($line =~ $svnPropertiesStartRegEx) {
958 my $propertyPath = $1;
959 if ($svnPropertiesHashRef || $headerHashRef && ($propertyPath ne $headerHashRef->{indexPath})) {
960 # This is the start of the second diff in the while loop, which happens to
961 # be a property diff. If $svnPropertiesHasRef is defined, then this is the
962 # second consecutive property diff, otherwise it's the start of a property
963 # diff for a file that only has property changes.
966 ($svnPropertiesHashRef, $line) = parseSvnDiffProperties($fileHandle, $line);
969 if ($line !~ $headerStartRegEx) {
970 # Then we are in the body of the diff.
971 my $isChunkRange = defined(parseChunkRange($line));
972 $numTextChunks += 1 if $isChunkRange;
973 if ($indexPathEOL && !$isChunkRange) {
974 # The chunk range is part of the body of the diff, but its line endings should't be
975 # modified or patch(1) will complain. So, we only modify non-chunk range lines.
976 $line =~ s/\r\n|\r|\n/$indexPathEOL/g;
979 $line = <$fileHandle>;
981 } # Otherwise, we found a diff header.
983 if ($svnPropertiesHashRef || $headerHashRef) {
984 # Then either we just processed an SVN property change or this
985 # is the start of the second diff header of this while loop.
989 ($headerHashRef, $line) = parseDiffHeader($fileHandle, $line);
990 if (!$optionsHashRef || !$optionsHashRef->{shouldNotUseIndexPathEOL}) {
991 $indexPathEOL = firstEOLInFile($headerHashRef->{indexPath}) if !$headerHashRef->{isNew} && !$headerHashRef->{isBinary};
994 $svnText .= $headerHashRef->{svnConvertedText};
999 if ($headerHashRef->{shouldDeleteSource}) {
1001 $deletionHash{indexPath} = $headerHashRef->{copiedFromPath};
1002 $deletionHash{isDeletion} = 1;
1003 push @diffHashRefs, \%deletionHash;
1005 if ($headerHashRef->{copiedFromPath}) {
1007 $copyHash{copiedFromPath} = $headerHashRef->{copiedFromPath};
1008 $copyHash{indexPath} = $headerHashRef->{indexPath};
1009 $copyHash{sourceRevision} = $headerHashRef->{sourceRevision} if $headerHashRef->{sourceRevision};
1010 if ($headerHashRef->{isSvn}) {
1011 $copyHash{executableBitDelta} = $svnPropertiesHashRef->{executableBitDelta} if $svnPropertiesHashRef->{executableBitDelta};
1013 push @diffHashRefs, \%copyHash;
1016 # Note, the order of evaluation for the following if conditional has been explicitly chosen so that
1017 # it evaluates to false when there is no headerHashRef (e.g. a property change diff for a file that
1018 # only has property changes).
1019 if ($headerHashRef->{isCopyWithChanges} || (%$headerHashRef && !$headerHashRef->{copiedFromPath})) {
1020 # Then add the usual file modification.
1022 # FIXME: We should expand this code to support other properties. In the future,
1023 # parseSvnDiffProperties may return a hash whose keys are the properties.
1024 if ($headerHashRef->{isSvn}) {
1025 # SVN records the change to the executable bit in a separate property change diff
1026 # that follows the contents of the diff, except for binary diffs. For binary
1027 # diffs, the property change diff follows the diff header.
1028 $diffHash{executableBitDelta} = $svnPropertiesHashRef->{executableBitDelta} if $svnPropertiesHashRef->{executableBitDelta};
1029 } elsif ($headerHashRef->{isGit}) {
1030 # Git records the change to the executable bit in the header of a diff.
1031 $diffHash{executableBitDelta} = $headerHashRef->{executableBitDelta} if $headerHashRef->{executableBitDelta};
1033 $diffHash{indexPath} = $headerHashRef->{indexPath};
1034 $diffHash{isBinary} = $headerHashRef->{isBinary} if $headerHashRef->{isBinary};
1035 $diffHash{isDeletion} = $headerHashRef->{isDeletion} if $headerHashRef->{isDeletion};
1036 $diffHash{isGit} = $headerHashRef->{isGit} if $headerHashRef->{isGit};
1037 $diffHash{isNew} = $headerHashRef->{isNew} if $headerHashRef->{isNew};
1038 $diffHash{isSvn} = $headerHashRef->{isSvn} if $headerHashRef->{isSvn};
1039 if (!$headerHashRef->{copiedFromPath}) {
1040 # If the file was copied, then we have already incorporated the
1041 # sourceRevision information into the change.
1042 $diffHash{sourceRevision} = $headerHashRef->{sourceRevision} if $headerHashRef->{sourceRevision};
1044 # FIXME: Remove the need for svnConvertedText. See the %diffHash
1045 # code comments above for more information.
1047 # Note, we may not always have SVN converted text since we intend
1048 # to deprecate it in the future. For example, a property change
1049 # diff for a file that only has property changes will not return
1050 # any SVN converted text.
1051 $diffHash{svnConvertedText} = $svnText if $svnText;
1052 $diffHash{numTextChunks} = $numTextChunks if $svnText && !$headerHashRef->{isBinary};
1053 push @diffHashRefs, \%diffHash;
1056 if (!%$headerHashRef && $svnPropertiesHashRef) {
1057 # A property change diff for a file that only has property changes.
1058 my %propertyChangeHash;
1059 $propertyChangeHash{executableBitDelta} = $svnPropertiesHashRef->{executableBitDelta} if $svnPropertiesHashRef->{executableBitDelta};
1060 $propertyChangeHash{indexPath} = $svnPropertiesHashRef->{propertyPath};
1061 $propertyChangeHash{isSvn} = 1;
1062 push @diffHashRefs, \%propertyChangeHash;
1065 return (\@diffHashRefs, $line);
1068 # Parse an SVN property change diff from the given file handle, and advance
1069 # the handle so the last line read is the first line after this diff.
1071 # For the case of an SVN binary diff, the binary contents will follow the
1072 # the property changes.
1074 # This subroutine dies if the first line does not begin with "Property changes on"
1075 # or if the separator line that follows this line is missing.
1078 # $fileHandle: advanced so the last line read from the handle is the first
1079 # line of the footer to parse. This line begins with
1080 # "Property changes on".
1081 # $line: the line last read from $fileHandle.
1083 # Returns ($propertyHashRef, $lastReadLine):
1084 # $propertyHashRef: a hash reference representing an SVN diff footer.
1085 # propertyPath: the path of the target file.
1086 # executableBitDelta: the value 1 or -1 if the executable bit was added or
1087 # removed from the target file, respectively.
1088 # $lastReadLine: the line last read from $fileHandle.
1089 sub parseSvnDiffProperties($$)
1091 my ($fileHandle, $line) = @_;
1096 if (/$svnPropertiesStartRegEx/) {
1097 $footer{propertyPath} = $1;
1099 die("Failed to find start of SVN property change, \"Property changes on \": \"$_\"");
1102 # We advance $fileHandle two lines so that the next line that
1103 # we process is $svnPropertyStartRegEx in a well-formed footer.
1104 # A well-formed footer has the form:
1105 # Property changes on: FileA
1106 # ___________________________________________________________________
1107 # Added: svn:executable
1109 $_ = <$fileHandle>; # Not defined if end-of-file reached.
1110 my $separator = "_" x 67;
1111 if (defined($_) && /^$separator[\r\n]+$/) {
1114 die("Failed to find separator line: \"$_\".");
1117 # FIXME: We should expand this to support other SVN properties
1118 # (e.g. return a hash of property key-values that represents
1121 # Notice, we keep processing until we hit end-of-file or some
1122 # line that does not resemble $svnPropertyStartRegEx, such as
1123 # the empty line that precedes the start of the binary contents
1124 # of a patch, or the start of the next diff (e.g. "Index:").
1125 my $propertyHashRef;
1126 while (defined($_) && /$svnPropertyStartRegEx/) {
1127 ($propertyHashRef, $_) = parseSvnProperty($fileHandle, $_);
1128 if ($propertyHashRef->{name} eq "svn:executable") {
1129 # Notice, for SVN properties, propertyChangeDelta is always non-zero
1130 # because a property can only be added or removed.
1131 $footer{executableBitDelta} = $propertyHashRef->{propertyChangeDelta};
1135 return(\%footer, $_);
1138 # Parse the next SVN property from the given file handle, and advance the handle so the last
1139 # line read is the first line after the property.
1141 # This subroutine dies if the first line is not a valid start of an SVN property,
1142 # or the property is missing a value, or the property change type (e.g. "Added")
1143 # does not correspond to the property value type (e.g. "+").
1146 # $fileHandle: advanced so the last line read from the handle is the first
1147 # line of the property to parse. This should be a line
1148 # that matches $svnPropertyStartRegEx.
1149 # $line: the line last read from $fileHandle.
1151 # Returns ($propertyHashRef, $lastReadLine):
1152 # $propertyHashRef: a hash reference representing a SVN property.
1153 # name: the name of the property.
1154 # value: the last property value. For instance, suppose the property is "Modified".
1155 # Then it has both a '-' and '+' property value in that order. Therefore,
1156 # the value of this key is the value of the '+' property by ordering (since
1157 # it is the last value).
1158 # propertyChangeDelta: the value 1 or -1 if the property was added or
1159 # removed, respectively.
1160 # $lastReadLine: the line last read from $fileHandle.
1161 sub parseSvnProperty($$)
1163 my ($fileHandle, $line) = @_;
1168 my $propertyChangeType;
1169 if (/$svnPropertyStartRegEx/) {
1170 $propertyChangeType = $1;
1173 die("Failed to find SVN property: \"$_\".");
1176 $_ = <$fileHandle>; # Not defined if end-of-file reached.
1178 # The "svn diff" command neither inserts newline characters between property values
1179 # nor between successive properties.
1181 # FIXME: We do not support property values that contain tailing newline characters
1182 # as it is difficult to disambiguate these trailing newlines from the empty
1183 # line that precedes the contents of a binary patch.
1185 my $propertyValueType;
1186 while (defined($_) && /$svnPropertyValueStartRegEx/) {
1187 # Note, a '-' property may be followed by a '+' property in the case of a "Modified"
1188 # or "Name" property. We only care about the ending value (i.e. the '+' property)
1189 # in such circumstances. So, we take the property value for the property to be its
1190 # last parsed property value.
1192 # FIXME: We may want to consider strictly enforcing a '-', '+' property ordering or
1193 # add error checking to prevent '+', '+', ..., '+' and other invalid combinations.
1194 $propertyValueType = $1;
1195 ($propertyValue, $_) = parseSvnPropertyValue($fileHandle, $_);
1198 if (!$propertyValue) {
1199 die("Failed to find the property value for the SVN property \"$propertyName\": \"$_\".");
1202 my $propertyChangeDelta;
1203 if ($propertyValueType eq "+" || $propertyValueType eq "Merged") {
1204 $propertyChangeDelta = 1;
1205 } elsif ($propertyValueType eq "-" || $propertyValueType eq "Reverse-merged") {
1206 $propertyChangeDelta = -1;
1208 die("Not reached.");
1211 # We perform a simple validation that an "Added" or "Deleted" property
1212 # change type corresponds with a "+" and "-" value type, respectively.
1213 my $expectedChangeDelta;
1214 if ($propertyChangeType eq "Added") {
1215 $expectedChangeDelta = 1;
1216 } elsif ($propertyChangeType eq "Deleted") {
1217 $expectedChangeDelta = -1;
1220 if ($expectedChangeDelta && $propertyChangeDelta != $expectedChangeDelta) {
1221 die("The final property value type found \"$propertyValueType\" does not " .
1222 "correspond to the property change type found \"$propertyChangeType\".");
1226 $propertyHash{name} = $propertyName;
1227 $propertyHash{propertyChangeDelta} = $propertyChangeDelta;
1228 $propertyHash{value} = $propertyValue;
1229 return (\%propertyHash, $_);
1232 # Parse the value of an SVN property from the given file handle, and advance
1233 # the handle so the last line read is the first line after the property value.
1235 # This subroutine dies if the first line is an invalid SVN property value line
1236 # (i.e. a line that does not begin with " +" or " -").
1239 # $fileHandle: advanced so the last line read from the handle is the first
1240 # line of the property value to parse. This should be a line
1241 # beginning with " +" or " -".
1242 # $line: the line last read from $fileHandle.
1244 # Returns ($propertyValue, $lastReadLine):
1245 # $propertyValue: the value of the property.
1246 # $lastReadLine: the line last read from $fileHandle.
1247 sub parseSvnPropertyValue($$)
1249 my ($fileHandle, $line) = @_;
1255 if (/$svnPropertyValueStartRegEx/) {
1256 $propertyValue = $2; # Does not include the end-of-line character(s).
1259 die("Failed to find property value beginning with '+', '-', 'Merged', or 'Reverse-merged': \"$_\".");
1262 while (<$fileHandle>) {
1263 if (/^[\r\n]+$/ || /$svnPropertyValueStartRegEx/ || /$svnPropertyStartRegEx/) {
1264 # Note, we may encounter an empty line before the contents of a binary patch.
1265 # Also, we check for $svnPropertyValueStartRegEx because a '-' property may be
1266 # followed by a '+' property in the case of a "Modified" or "Name" property.
1267 # We check for $svnPropertyStartRegEx because it indicates the start of the
1268 # next property to parse.
1272 # Temporarily strip off any end-of-line characters. We add the end-of-line characters
1273 # from the previously processed line to the start of this line so that the last line
1274 # of the property value does not end in end-of-line characters.
1276 $propertyValue .= "$eol$_";
1280 return ($propertyValue, $_);
1283 # Parse a patch file created by svn-create-patch.
1286 # $fileHandle: A file handle to the patch file that has not yet been
1288 # $optionsHashRef: a hash reference representing optional options to use
1289 # when processing a diff.
1290 # shouldNotUseIndexPathEOL: whether to use the line endings in the diff instead
1291 # instead of the line endings in the target file; the
1292 # value of 1 if svnConvertedText should use the line
1293 # endings in the diff.
1296 # @diffHashRefs: an array of diff hash references.
1297 # See the %diffHash documentation above.
1300 my ($fileHandle, $optionsHashRef) = @_;
1302 my $newDiffHashRefs;
1303 my @diffHashRefs; # return value
1305 my $line = <$fileHandle>;
1307 while (defined($line)) { # Otherwise, at EOF.
1309 ($newDiffHashRefs, $line) = parseDiff($fileHandle, $line, $optionsHashRef);
1311 push @diffHashRefs, @$newDiffHashRefs;
1314 return @diffHashRefs;
1317 # Prepare the results of parsePatch() for use in svn-apply and svn-unapply.
1320 # $shouldForce: Whether to continue processing if an unexpected
1322 # @diffHashRefs: An array of references to %diffHashes.
1323 # See the %diffHash documentation above.
1325 # Returns $preparedPatchHashRef:
1326 # copyDiffHashRefs: A reference to an array of the $diffHashRefs in
1327 # @diffHashRefs that represent file copies. The original
1328 # ordering is preserved.
1329 # nonCopyDiffHashRefs: A reference to an array of the $diffHashRefs in
1330 # @diffHashRefs that do not represent file copies.
1331 # The original ordering is preserved.
1332 # sourceRevisionHash: A reference to a hash of source path to source
1334 sub prepareParsedPatch($@)
1336 my ($shouldForce, @diffHashRefs) = @_;
1341 my @copyDiffHashRefs = ();
1342 my @nonCopyDiffHashRefs = ();
1343 my %sourceRevisionHash = ();
1344 for my $diffHashRef (@diffHashRefs) {
1345 my $copiedFromPath = $diffHashRef->{copiedFromPath};
1346 my $indexPath = $diffHashRef->{indexPath};
1347 my $sourceRevision = $diffHashRef->{sourceRevision};
1350 if (defined($copiedFromPath)) {
1351 # Then the diff is a copy operation.
1352 $sourcePath = $copiedFromPath;
1354 # FIXME: Consider printing a warning or exiting if
1355 # exists($copiedFiles{$indexPath}) is true -- i.e. if
1356 # $indexPath appears twice as a copy target.
1357 $copiedFiles{$indexPath} = $sourcePath;
1359 push @copyDiffHashRefs, $diffHashRef;
1361 # Then the diff is not a copy operation.
1362 $sourcePath = $indexPath;
1364 push @nonCopyDiffHashRefs, $diffHashRef;
1367 if (defined($sourceRevision)) {
1368 if (exists($sourceRevisionHash{$sourcePath}) &&
1369 ($sourceRevisionHash{$sourcePath} != $sourceRevision)) {
1370 if (!$shouldForce) {
1371 die "Two revisions of the same file required as a source:\n".
1372 " $sourcePath:$sourceRevisionHash{$sourcePath}\n".
1373 " $sourcePath:$sourceRevision";
1376 $sourceRevisionHash{$sourcePath} = $sourceRevision;
1380 my %preparedPatchHash;
1382 $preparedPatchHash{copyDiffHashRefs} = \@copyDiffHashRefs;
1383 $preparedPatchHash{nonCopyDiffHashRefs} = \@nonCopyDiffHashRefs;
1384 $preparedPatchHash{sourceRevisionHash} = \%sourceRevisionHash;
1386 return \%preparedPatchHash;
1389 # Return localtime() for the project's time zone, given an integer time as
1390 # returned by Perl's time() function.
1391 sub localTimeInProjectTimeZone($)
1393 my $epochTime = shift;
1395 # Change the time zone temporarily for the localtime() call.
1396 my $savedTimeZone = $ENV{'TZ'};
1397 $ENV{'TZ'} = $changeLogTimeZone;
1398 my @localTime = localtime($epochTime);
1399 if (defined $savedTimeZone) {
1400 $ENV{'TZ'} = $savedTimeZone;
1408 # Set the reviewer and date in a ChangeLog patch, and return the new patch.
1411 # $patch: a ChangeLog patch as a string.
1412 # $reviewer: the name of the reviewer, or undef if the reviewer should not be set.
1413 # $epochTime: an integer time as returned by Perl's time() function.
1414 sub setChangeLogDateAndReviewer($$$)
1416 my ($patch, $reviewer, $epochTime) = @_;
1418 my @localTime = localTimeInProjectTimeZone($epochTime);
1419 my $newDate = strftime("%Y-%m-%d", @localTime);
1421 my $firstChangeLogLineRegEx = qr#(\n\+)\d{4}-[^-]{2}-[^-]{2}( )#;
1422 $patch =~ s/$firstChangeLogLineRegEx/$1$newDate$2/;
1424 if (defined($reviewer)) {
1425 # We include a leading plus ("+") in the regular expression to make
1426 # the regular expression less likely to match text in the leading junk
1427 # for the patch, if the patch has leading junk.
1428 $patch =~ s/(\n\+.*)NOBODY \(OOPS!\)/$1$reviewer/;
1434 # If possible, returns a ChangeLog patch equivalent to the given one,
1435 # but with the newest ChangeLog entry inserted at the top of the
1436 # file -- i.e. no leading context and all lines starting with "+".
1438 # If given a patch string not representable as a patch with the above
1439 # properties, it returns the input back unchanged.
1441 # WARNING: This subroutine can return an inequivalent patch string if
1442 # both the beginning of the new ChangeLog file matches the beginning
1443 # of the source ChangeLog, and the source beginning was modified.
1444 # Otherwise, it is guaranteed to return an equivalent patch string,
1447 # Applying this subroutine to ChangeLog patches allows svn-apply to
1448 # insert new ChangeLog entries at the top of the ChangeLog file.
1449 # svn-apply uses patch with --fuzz=3 to do this. We need to apply
1450 # this subroutine because the diff(1) command is greedy when matching
1451 # lines. A new ChangeLog entry with the same date and author as the
1452 # previous will match and cause the diff to have lines of starting
1455 # This subroutine has unit tests in VCSUtils_unittest.pl.
1457 # Returns $changeLogHashRef:
1458 # $changeLogHashRef: a hash reference representing a change log patch.
1459 # patch: a ChangeLog patch equivalent to the given one, but with the
1460 # newest ChangeLog entry inserted at the top of the file, if possible.
1461 sub fixChangeLogPatch($)
1463 my $patch = shift; # $patch will only contain patch fragments for ChangeLog.
1465 $patch =~ s|test_expectations.txt:|TestExpectations:|g;
1467 $patch =~ /(\r?\n)/;
1468 my $lineEnding = $1;
1469 my @lines = split(/$lineEnding/, $patch);
1471 my $i = 0; # We reuse the same index throughout.
1473 # Skip to beginning of first chunk.
1474 for (; $i < @lines; ++$i) {
1475 if (substr($lines[$i], 0, 1) eq "@") {
1479 my $chunkStartIndex = ++$i;
1480 my %changeLogHashRef;
1482 # Optimization: do not process if new lines already begin the chunk.
1483 if (substr($lines[$i], 0, 1) eq "+") {
1484 $changeLogHashRef{patch} = $patch;
1485 return \%changeLogHashRef;
1488 # Skip to first line of newly added ChangeLog entry.
1489 # For example, +2009-06-03 Eric Seidel <eric@webkit.org>
1490 my $dateStartRegEx = '^\+(\d{4}-\d{2}-\d{2})' # leading "+" and date
1491 . '\s+(.+)\s+' # name
1492 . '<([^<>]+)>$'; # e-mail address
1494 for (; $i < @lines; ++$i) {
1495 my $line = $lines[$i];
1496 my $firstChar = substr($line, 0, 1);
1497 if ($line =~ /$dateStartRegEx/) {
1499 } elsif ($firstChar eq " " or $firstChar eq "+") {
1502 $changeLogHashRef{patch} = $patch; # Do not change if, for example, "-" or "@" found.
1503 return \%changeLogHashRef;
1506 $changeLogHashRef{patch} = $patch; # Do not change if date not found.
1507 return \%changeLogHashRef;
1509 my $dateStartIndex = $i;
1511 # Rewrite overlapping lines to lead with " ".
1512 my @overlappingLines = (); # These will include a leading "+".
1513 for (; $i < @lines; ++$i) {
1514 my $line = $lines[$i];
1515 if (substr($line, 0, 1) ne "+") {
1518 push(@overlappingLines, $line);
1519 $lines[$i] = " " . substr($line, 1);
1522 # Remove excess ending context, if necessary.
1523 my $shouldTrimContext = 1;
1524 for (; $i < @lines; ++$i) {
1525 my $firstChar = substr($lines[$i], 0, 1);
1526 if ($firstChar eq " ") {
1528 } elsif ($firstChar eq "@") {
1531 $shouldTrimContext = 0; # For example, if "+" or "-" encountered.
1534 my $deletedLineCount = 0;
1535 if ($shouldTrimContext) { # Also occurs if end of file reached.
1536 splice(@lines, $i - @overlappingLines, @overlappingLines);
1537 $deletedLineCount = @overlappingLines;
1540 # Work backwards, shifting overlapping lines towards front
1541 # while checking that patch stays equivalent.
1542 for ($i = $dateStartIndex - 1; @overlappingLines && $i >= $chunkStartIndex; --$i) {
1543 my $line = $lines[$i];
1544 if (substr($line, 0, 1) ne " ") {
1547 my $text = substr($line, 1);
1548 my $newLine = pop(@overlappingLines);
1549 if ($text ne substr($newLine, 1)) {
1550 $changeLogHashRef{patch} = $patch; # Unexpected difference.
1551 return \%changeLogHashRef;
1553 $lines[$i] = "+$text";
1556 # If @overlappingLines > 0, this is where we make use of the
1557 # assumption that the beginning of the source file was not modified.
1558 splice(@lines, $chunkStartIndex, 0, @overlappingLines);
1560 # Update the date start index as it may have changed after shifting
1561 # the overlapping lines towards the front.
1562 for ($i = $chunkStartIndex; $i < $dateStartIndex; ++$i) {
1563 $dateStartIndex = $i if $lines[$i] =~ /$dateStartRegEx/;
1565 splice(@lines, $chunkStartIndex, $dateStartIndex - $chunkStartIndex); # Remove context of later entry.
1566 $deletedLineCount += $dateStartIndex - $chunkStartIndex;
1568 # Update the initial chunk range.
1569 my $chunkRangeHashRef = parseChunkRange($lines[$chunkStartIndex - 1]);
1570 if (!$chunkRangeHashRef) {
1571 # FIXME: Handle errors differently from ChangeLog files that
1572 # are okay but should not be altered. That way we can find out
1573 # if improvements to the script ever become necessary.
1574 $changeLogHashRef{patch} = $patch; # Error: unexpected patch string format.
1575 return \%changeLogHashRef;
1577 my $oldSourceLineCount = $chunkRangeHashRef->{lineCount};
1578 my $oldTargetLineCount = $chunkRangeHashRef->{newLineCount};
1580 my $sourceLineCount = $oldSourceLineCount + @overlappingLines - $deletedLineCount;
1581 my $targetLineCount = $oldTargetLineCount + @overlappingLines - $deletedLineCount;
1582 $lines[$chunkStartIndex - 1] = "@@ -1,$sourceLineCount +1,$targetLineCount @@";
1584 $changeLogHashRef{patch} = join($lineEnding, @lines) . "\n"; # patch(1) expects an extra trailing newline.
1585 return \%changeLogHashRef;
1588 # This is a supporting method for runPatchCommand.
1590 # Arg: the optional $args parameter passed to runPatchCommand (can be undefined).
1592 # Returns ($patchCommand, $isForcing).
1594 # This subroutine has unit tests in VCSUtils_unittest.pl.
1595 sub generatePatchCommand($)
1597 my ($passedArgsHashRef) = @_;
1599 my $argsHashRef = { # Defaults
1605 # Merges hash references. It's okay here if passed hash reference is undefined.
1606 @{$argsHashRef}{keys %{$passedArgsHashRef}} = values %{$passedArgsHashRef};
1608 my $ensureForce = $argsHashRef->{ensureForce};
1609 my $shouldReverse = $argsHashRef->{shouldReverse};
1610 my $options = $argsHashRef->{options};
1615 $options = [@{$options}]; # Copy to avoid side effects.
1619 if (grep /^--force$/, @{$options}) {
1621 } elsif ($ensureForce) {
1622 push @{$options}, "--force";
1626 if ($shouldReverse) { # No check: --reverse should never be passed explicitly.
1627 push @{$options}, "--reverse";
1630 @{$options} = sort(@{$options}); # For easier testing.
1632 my $patchCommand = join(" ", "patch -p0", @{$options});
1634 return ($patchCommand, $isForcing);
1637 # Apply the given patch using the patch(1) command.
1639 # On success, return the resulting exit status. Otherwise, exit with the
1640 # exit status. If "--force" is passed as an option, however, then never
1641 # exit and always return the exit status.
1644 # $patch: a patch string.
1645 # $repositoryRootPath: an absolute path to the repository root.
1646 # $pathRelativeToRoot: the path of the file to be patched, relative to the
1647 # repository root. This should normally be the path
1648 # found in the patch's "Index:" line. It is passed
1649 # explicitly rather than reparsed from the patch
1650 # string for optimization purposes.
1651 # This is used only for error reporting. The
1652 # patch command gleans the actual file to patch
1653 # from the patch string.
1654 # $args: a reference to a hash of optional arguments. The possible
1656 # ensureForce: whether to ensure --force is passed (defaults to 0).
1657 # shouldReverse: whether to pass --reverse (defaults to 0).
1658 # options: a reference to an array of options to pass to the
1659 # patch command. The subroutine passes the -p0 option
1660 # no matter what. This should not include --reverse.
1662 # This subroutine has unit tests in VCSUtils_unittest.pl.
1663 sub runPatchCommand($$$;$)
1665 my ($patch, $repositoryRootPath, $pathRelativeToRoot, $args) = @_;
1667 my ($patchCommand, $isForcing) = generatePatchCommand($args);
1669 # Temporarily change the working directory since the path found
1670 # in the patch's "Index:" line is relative to the repository root
1671 # (i.e. the same as $pathRelativeToRoot).
1672 my $cwd = Cwd::getcwd();
1673 chdir $repositoryRootPath;
1675 open PATCH, "| $patchCommand" or die "Could not call \"$patchCommand\" for file \"$pathRelativeToRoot\": $!";
1678 my $exitStatus = exitStatus($?);
1682 if ($exitStatus && !$isForcing) {
1683 print "Calling \"$patchCommand\" for file \"$pathRelativeToRoot\" returned " .
1684 "status $exitStatus. Pass --force to ignore patch failures.\n";
1691 # Merge ChangeLog patches using a three-file approach.
1693 # This is used by resolve-ChangeLogs when it's operated as a merge driver
1694 # and when it's used to merge conflicts after a patch is applied or after
1697 # It's also used for traditional rejected patches.
1700 # $fileMine: The merged version of the file. Also known in git as the
1701 # other branch's version (%B) or "ours".
1702 # For traditional patch rejects, this is the *.rej file.
1703 # $fileOlder: The base version of the file. Also known in git as the
1704 # ancestor version (%O) or "base".
1705 # For traditional patch rejects, this is the *.orig file.
1706 # $fileNewer: The current version of the file. Also known in git as the
1707 # current version (%A) or "theirs".
1708 # For traditional patch rejects, this is the original-named
1711 # Returns 1 if merge was successful, else 0.
1712 sub mergeChangeLogs($$$)
1714 my ($fileMine, $fileOlder, $fileNewer) = @_;
1716 my $traditionalReject = $fileMine =~ /\.rej$/ ? 1 : 0;
1721 if ($traditionalReject) {
1722 open(DIFF, "<", $fileMine) or die $!;
1725 rename($fileMine, "$fileMine.save");
1726 rename($fileOlder, "$fileOlder.save");
1728 open(DIFF, "diff -u -a --binary \"$fileOlder\" \"$fileMine\" |") or die $!;
1733 unlink("${fileNewer}.orig");
1734 unlink("${fileNewer}.rej");
1736 open(PATCH, "| patch --force --fuzz=3 --binary \"$fileNewer\" > " . File::Spec->devnull()) or die $!;
1737 if ($traditionalReject) {
1740 my $changeLogHash = fixChangeLogPatch($patch);
1741 print PATCH $changeLogHash->{patch};
1745 my $result = !exitStatus($?);
1747 # Refuse to merge the patch if it did not apply cleanly
1748 if (-e "${fileNewer}.rej") {
1749 unlink("${fileNewer}.rej");
1750 if (-f "${fileNewer}.orig") {
1752 rename("${fileNewer}.orig", $fileNewer);
1755 unlink("${fileNewer}.orig");
1758 if ($traditionalReject) {
1759 rename("$fileMine.save", $fileMine);
1760 rename("$fileOlder.save", $fileOlder);
1768 return unless $isGit;
1772 my $result = `git config $config`;
1774 $result = `git repo-config $config`;
1780 sub changeLogSuffix()
1782 my $rootPath = determineVCSRoot();
1783 my $changeLogSuffixFile = File::Spec->catfile($rootPath, ".changeLogSuffix");
1784 return "" if ! -e $changeLogSuffixFile;
1785 open FILE, $changeLogSuffixFile or die "Could not open $changeLogSuffixFile: $!";
1786 my $changeLogSuffix = <FILE>;
1787 chomp $changeLogSuffix;
1789 return $changeLogSuffix;
1792 sub changeLogFileName()
1794 return "ChangeLog" . changeLogSuffix()
1797 sub changeLogNameError($)
1800 print STDERR "$message\nEither:\n";
1801 print STDERR " set CHANGE_LOG_NAME in your environment\n";
1802 print STDERR " OR pass --name= on the command line\n";
1803 print STDERR " OR set REAL_NAME in your environment";
1804 print STDERR " OR git users can set 'git config user.name'\n";
1810 my $name = $ENV{CHANGE_LOG_NAME} || $ENV{REAL_NAME} || gitConfig("user.name") || (split /\s*,\s*/, (getpwuid $<)[6])[0];
1812 changeLogNameError("Failed to determine ChangeLog name.") unless $name;
1813 # getpwuid seems to always succeed on windows, returning the username instead of the full name. This check will catch that case.
1814 changeLogNameError("'$name' does not contain a space! ChangeLogs should contain your full name.") unless ($name =~ /\S\s\S/);
1819 sub changeLogEmailAddressError($)
1822 print STDERR "$message\nEither:\n";
1823 print STDERR " set CHANGE_LOG_EMAIL_ADDRESS in your environment\n";
1824 print STDERR " OR pass --email= on the command line\n";
1825 print STDERR " OR set EMAIL_ADDRESS in your environment\n";
1826 print STDERR " OR git users can set 'git config user.email'\n";
1830 sub changeLogEmailAddress()
1832 my $emailAddress = $ENV{CHANGE_LOG_EMAIL_ADDRESS} || $ENV{EMAIL_ADDRESS} || gitConfig("user.email");
1834 changeLogEmailAddressError("Failed to determine email address for ChangeLog.") unless $emailAddress;
1835 changeLogEmailAddressError("Email address '$emailAddress' does not contain '\@' and is likely invalid.") unless ($emailAddress =~ /\@/);
1837 return $emailAddress;
1840 # http://tools.ietf.org/html/rfc1924
1845 my @characters = ('0'..'9', 'A'..'Z', 'a'..'z', '!', '#', '$', '%', '&', '(', ')', '*', '+', '-', ';', '<', '=', '>', '?', '@', '^', '_', '`', '{', '|', '}', '~');
1846 for (my $i = 0; $i < 85; $i++) {
1847 $table{$characters[$i]} = $i;
1851 my @encodedChars = $encoded =~ /./g;
1853 for (my $encodedIter = 0; defined($encodedChars[$encodedIter]);) {
1855 for (my $i = 0; $i < 5; $i++) {
1857 my $char = $encodedChars[$encodedIter];
1858 $digit += $table{$char};
1862 for (my $i = 0; $i < 4; $i++) {
1863 $decoded .= chr(($digit >> (3 - $i) * 8) & 255);
1870 sub decodeGitBinaryChunk($$)
1872 my ($contents, $fullPath) = @_;
1874 # Load this module lazily in case the user don't have this module
1875 # and won't handle git binary patches.
1876 require Compress::Zlib;
1879 my $compressedSize = 0;
1880 while ($contents =~ /^([A-Za-z])(.*)$/gm) {
1882 next if $line eq "";
1883 die "$fullPath: unexpected size of a line: $&" if length($2) % 5 != 0;
1884 my $actualSize = length($2) / 5 * 4;
1885 my $encodedExpectedSize = ord($1);
1886 my $expectedSize = $encodedExpectedSize <= ord("Z") ? $encodedExpectedSize - ord("A") + 1 : $encodedExpectedSize - ord("a") + 27;
1888 die "$fullPath: unexpected size of a line: $&" if int(($expectedSize + 3) / 4) * 4 != $actualSize;
1889 $compressedSize += $expectedSize;
1893 my $compressed = decodeBase85($encoded);
1894 $compressed = substr($compressed, 0, $compressedSize);
1895 return Compress::Zlib::uncompress($compressed);
1898 sub decodeGitBinaryPatch($$)
1900 my ($contents, $fullPath) = @_;
1902 # Git binary patch has two chunks. One is for the normal patching
1903 # and another is for the reverse patching.
1905 # Each chunk a line which starts from either "literal" or "delta",
1906 # followed by a number which specifies decoded size of the chunk.
1908 # Then, content of the chunk comes. To decode the content, we
1909 # need decode it with base85 first, and then zlib.
1910 my $gitPatchRegExp = '(literal|delta) ([0-9]+)\n([A-Za-z0-9!#$%&()*+-;<=>?@^_`{|}~\\n]*?)\n\n';
1911 if ($contents !~ m"\nGIT binary patch\n$gitPatchRegExp$gitPatchRegExp\Z") {
1912 die "$fullPath: unknown git binary patch format"
1915 my $binaryChunkType = $1;
1916 my $binaryChunkExpectedSize = $2;
1917 my $encodedChunk = $3;
1918 my $reverseBinaryChunkType = $4;
1919 my $reverseBinaryChunkExpectedSize = $5;
1920 my $encodedReverseChunk = $6;
1922 my $binaryChunk = decodeGitBinaryChunk($encodedChunk, $fullPath);
1923 my $binaryChunkActualSize = length($binaryChunk);
1924 my $reverseBinaryChunk = decodeGitBinaryChunk($encodedReverseChunk, $fullPath);
1925 my $reverseBinaryChunkActualSize = length($reverseBinaryChunk);
1927 die "$fullPath: unexpected size of the first chunk (expected $binaryChunkExpectedSize but was $binaryChunkActualSize" if ($binaryChunkType eq "literal" and $binaryChunkExpectedSize != $binaryChunkActualSize);
1928 die "$fullPath: unexpected size of the second chunk (expected $reverseBinaryChunkExpectedSize but was $reverseBinaryChunkActualSize" if ($reverseBinaryChunkType eq "literal" and $reverseBinaryChunkExpectedSize != $reverseBinaryChunkActualSize);
1930 return ($binaryChunkType, $binaryChunk, $reverseBinaryChunkType, $reverseBinaryChunk);
1935 my ($data, $location) = @_;
1937 # Return the byte at $location in $data as a numeric value.
1938 return ord(substr($data, $location, 1));
1941 # The git binary delta format is undocumented, except in code:
1942 # - https://github.com/git/git/blob/master/delta.h:get_delta_hdr_size is the source
1943 # of the algorithm in decodeGitBinaryPatchDeltaSize.
1944 # - https://github.com/git/git/blob/master/patch-delta.c:patch_delta is the source
1945 # of the algorithm in applyGitBinaryPatchDelta.
1946 sub decodeGitBinaryPatchDeltaSize($)
1948 my ($binaryChunk) = @_;
1950 # Source and destination buffer sizes are stored in 7-bit chunks at the
1951 # start of the binary delta patch data. The highest bit in each byte
1952 # except the last is set; the remaining 7 bits provide the next
1953 # chunk of the size. The chunks are stored in ascending significance
1958 for (my $i = 0; $i < length($binaryChunk);) {
1959 $cmd = readByte($binaryChunk, $i++);
1960 $size |= ($cmd & 0x7f) << $shift;
1962 if (!($cmd & 0x80)) {
1968 sub applyGitBinaryPatchDelta($$)
1970 my ($binaryChunk, $originalContents) = @_;
1972 # Git delta format consists of two headers indicating source buffer size
1973 # and result size, then a series of commands. Each command is either
1974 # a copy-from-old-version (the 0x80 bit is set) or a copy-from-delta
1975 # command. Commands are applied sequentially to generate the result.
1977 # A copy-from-old-version command encodes an offset and size to copy
1978 # from in subsequent bits, while a copy-from-delta command consists only
1979 # of the number of bytes to copy from the delta.
1981 # We don't use these values, but we need to know how big they are so that
1982 # we can skip to the diff data.
1983 my ($size, $bytesUsed) = decodeGitBinaryPatchDeltaSize($binaryChunk);
1984 $binaryChunk = substr($binaryChunk, $bytesUsed);
1985 ($size, $bytesUsed) = decodeGitBinaryPatchDeltaSize($binaryChunk);
1986 $binaryChunk = substr($binaryChunk, $bytesUsed);
1989 for (my $i = 0; $i < length($binaryChunk); ) {
1990 my $cmd = ord(substr($binaryChunk, $i++, 1));
1992 # Extract an offset and size from the delta data, then copy
1993 # $size bytes from $offset in the original data into the output.
1996 if ($cmd & 0x01) { $offset = readByte($binaryChunk, $i++); }
1997 if ($cmd & 0x02) { $offset |= readByte($binaryChunk, $i++) << 8; }
1998 if ($cmd & 0x04) { $offset |= readByte($binaryChunk, $i++) << 16; }
1999 if ($cmd & 0x08) { $offset |= readByte($binaryChunk, $i++) << 24; }
2000 if ($cmd & 0x10) { $size = readByte($binaryChunk, $i++); }
2001 if ($cmd & 0x20) { $size |= readByte($binaryChunk, $i++) << 8; }
2002 if ($cmd & 0x40) { $size |= readByte($binaryChunk, $i++) << 16; }
2003 if ($size == 0) { $size = 0x10000; }
2004 $out .= substr($originalContents, $offset, $size);
2006 # Copy $cmd bytes from the delta data into the output.
2007 $out .= substr($binaryChunk, $i, $cmd);
2010 die "unexpected delta opcode 0";
2017 sub escapeSubversionPath($)
2020 $path .= "@" if $path =~ /@/;
2027 my $pid = open(CHILD, "-|");
2028 if (!defined($pid)) {
2029 die "Failed to fork(): $!";
2039 $childOutput{exitStatus} = exitStatus($?);
2040 $childOutput{stdout} = $childStdout if $childStdout;
2041 return \%childOutput;
2044 # FIXME: Consider further hardening of this function, including sanitizing the environment.
2045 exec { $args[0] } @args or die "Failed to exec(): $!";