| #!/usr/bin/perl -w |
| |
| # Copyright (C) 2006, 2007, 2008, 2009, 2010 Apple Inc. All rights reserved. |
| # Copyright (C) 2009 Torch Mobile Inc. All rights reserved. |
| # |
| # Redistribution and use in source and binary forms, with or without |
| # modification, are permitted provided that the following conditions |
| # are met: |
| # |
| # 1. Redistributions of source code must retain the above copyright |
| # notice, this list of conditions and the following disclaimer. |
| # 2. Redistributions in binary form must reproduce the above copyright |
| # notice, this list of conditions and the following disclaimer in the |
| # documentation and/or other materials provided with the distribution. |
| # 3. Neither the name of Apple Computer, Inc. ("Apple") nor the names of |
| # its contributors may be used to endorse or promote products derived |
| # from this software without specific prior written permission. |
| # |
| # THIS SOFTWARE IS PROVIDED BY APPLE AND ITS CONTRIBUTORS "AS IS" AND ANY |
| # EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED |
| # WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE |
| # DISCLAIMED. IN NO EVENT SHALL APPLE OR ITS CONTRIBUTORS BE LIABLE FOR ANY |
| # DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES |
| # (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; |
| # LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND |
| # ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT |
| # (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF |
| # THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. |
| |
| # Script to put change log comments in as default check-in comment. |
| |
| use strict; |
| use File::Basename; |
| use File::Spec; |
| use FindBin; |
| use lib $FindBin::Bin; |
| use Term::ReadKey; |
| use VCSUtils; |
| use webkitdirs; |
| |
| sub fixEnvironment(); |
| sub normalizeLineEndings($$); |
| sub removeLongestCommonPrefixEndingInDoubleNewline(\%); |
| sub isCommitLogEditor($); |
| |
| sub usage |
| { |
| print "Usage: [--help] [--regenerate-log] <log file>\n"; |
| exit 1; |
| } |
| |
| my $help = checkForArgumentAndRemoveFromARGV("--help"); |
| if ($help) { |
| usage(); |
| } |
| |
| my $regenerateLog = checkForArgumentAndRemoveFromARGV("--regenerate-log"); |
| my $log = $ARGV[0]; |
| if (!$log) { |
| usage(); |
| } |
| |
| fixEnvironment(); |
| |
| my $baseDir = baseProductDir(); |
| |
| my $editor = $ENV{SVN_LOG_EDITOR}; |
| $editor = $ENV{CVS_LOG_EDITOR} if !$editor; |
| $editor = "" if $editor && isCommitLogEditor($editor); |
| |
| my $splitEditor = 1; |
| if (!$editor) { |
| my $builtEditorApplication = "$baseDir/Release/Commit Log Editor.app/Contents/MacOS/Commit Log Editor"; |
| if (-x $builtEditorApplication) { |
| $editor = $builtEditorApplication; |
| $splitEditor = 0; |
| } |
| } |
| if (!$editor) { |
| my $builtEditorApplication = "$baseDir/Debug/Commit Log Editor.app/Contents/MacOS/Commit Log Editor"; |
| if (-x $builtEditorApplication) { |
| $editor = $builtEditorApplication; |
| $splitEditor = 0; |
| } |
| } |
| if (!$editor) { |
| my $builtEditorApplication = "$ENV{HOME}/Applications/Commit Log Editor.app/Contents/MacOS/Commit Log Editor"; |
| if (-x $builtEditorApplication) { |
| $editor = $builtEditorApplication; |
| $splitEditor = 0; |
| } |
| } |
| |
| $editor = $ENV{EDITOR} if !$editor; |
| $editor = "/usr/bin/vi" if !$editor; |
| |
| my @editor; |
| if ($splitEditor) { |
| @editor = split ' ', $editor; |
| } else { |
| @editor = ($editor); |
| } |
| |
| my $inChangesToBeCommitted = !isGit(); |
| my @changeLogs = (); |
| my $logContents = ""; |
| my $existingLog = 0; |
| open LOG, $log or die "Could not open the log file."; |
| while (<LOG>) { |
| if (isGit()) { |
| if (/^# Changes to be committed:$/) { |
| $inChangesToBeCommitted = 1; |
| } elsif ($inChangesToBeCommitted && /^# \S/) { |
| $inChangesToBeCommitted = 0; |
| } |
| } |
| |
| if (!isGit() || /^#/) { # |
| $logContents .= $_; |
| } else { |
| # $_ contains the current git log message |
| # (without the log comment info). We don't need it. |
| } |
| $existingLog = isGit() && !(/^#/ || /^\s*$/) unless $existingLog; |
| |
| push @changeLogs, makeFilePathRelative($1) if $inChangesToBeCommitted && (/^(?:M|A)....(.*ChangeLog)\r?\n?$/ || /^#\t(?:modified|new file): (.*ChangeLog)$/) && !/-ChangeLog$/; |
| } |
| close LOG; |
| |
| # We want to match the line endings of the existing log file in case they're |
| # different from perl's line endings. |
| my $endl = "\n"; |
| $endl = $1 if $logContents =~ /(\r?\n)/; |
| |
| my $keepExistingLog = 1; |
| if ($regenerateLog && $existingLog && scalar(@changeLogs) > 0) { |
| print "Existing log message detected, Use 'r' to regenerate log message from ChangeLogs, or any other key to keep the existing message.\n"; |
| ReadMode('cbreak'); |
| my $key = ReadKey(0); |
| ReadMode('normal'); |
| $keepExistingLog = 0 if ($key eq "r"); |
| } |
| |
| # Don't change anything if there's already a log message (as can happen with git-commit --amend). |
| exec (@editor, @ARGV) if $existingLog && $keepExistingLog; |
| |
| my $topLevel = determineVCSRoot(); |
| |
| my %changeLogSort; |
| my %changeLogContents; |
| for my $changeLog (@changeLogs) { |
| open CHANGELOG, $changeLog or die "Can't open $changeLog"; |
| my $contents = ""; |
| my $blankLines = ""; |
| my $reviewedByLine = ""; |
| my $lineCount = 0; |
| my $date = ""; |
| my $author = ""; |
| my $email = ""; |
| my $hasAuthorInfoToWrite = 0; |
| while (<CHANGELOG>) { |
| if (/^\S/) { |
| last if $contents; |
| } |
| if (/\S/) { |
| my $previousLineWasBlank = 1 unless $blankLines eq ""; |
| my $line = $_; |
| my $currentLineBlankLines = $blankLines; |
| $blankLines = ""; |
| |
| # Remove indentation spaces |
| $line =~ s/^ {8}//; |
| |
| # Save the reviewed / rubber stamped by line. |
| if ($line =~ m/^Reviewed by .*/ || $line =~ m/^Rubber[ \-]?stamped by .*/) { |
| $reviewedByLine = $line; |
| next; |
| } |
| |
| # Grab the author and the date line |
| if ($line =~ m/^([0-9]{4}-[0-9]{2}-[0-9]{2})\s+(.*[^\s])\s+<(.*)>/ && $lineCount == 0) { |
| $date = $1; |
| $author = $2; |
| $email = $3; |
| $hasAuthorInfoToWrite = 1; |
| next; |
| } |
| |
| $contents .= $currentLineBlankLines if $contents; |
| |
| # Attempt to insert the "patch by" line, after the first blank line. |
| if ($previousLineWasBlank && $hasAuthorInfoToWrite && $lineCount > 0) { |
| my $committerEmail = changeLogEmailAddress(); |
| my $authorAndCommitterAreSamePerson = $email eq $committerEmail; |
| if (!$authorAndCommitterAreSamePerson) { |
| $contents .= "Patch by $author <$email> on $date\n"; |
| $hasAuthorInfoToWrite = 0; |
| } |
| } |
| |
| # Attempt to insert the "reviewed by" line, after the first blank line. |
| if ($previousLineWasBlank && $reviewedByLine && $lineCount > 0) { |
| $contents .= $reviewedByLine . "\n"; |
| $reviewedByLine = ""; |
| } |
| |
| $lineCount++; |
| $contents .= $line; |
| } else { |
| $blankLines .= $_; |
| } |
| } |
| if ($reviewedByLine) { |
| $contents .= "\n".$reviewedByLine; |
| } |
| close CHANGELOG; |
| |
| $changeLog = File::Spec->abs2rel(File::Spec->rel2abs($changeLog), $topLevel); |
| |
| my $label = dirname($changeLog); |
| $label = "top level" unless length $label; |
| |
| my $sortKey = lc $label; |
| if ($label eq "top level") { |
| $sortKey = ""; |
| } elsif ($label eq "LayoutTests") { |
| $sortKey = lc "~, LayoutTests last"; |
| } |
| |
| $changeLogSort{$sortKey} = $label; |
| $changeLogContents{$label} = $contents; |
| } |
| |
| my $commonPrefix = removeLongestCommonPrefixEndingInDoubleNewline(%changeLogContents); |
| |
| my $first = 1; |
| open NEWLOG, ">$log.edit" or die; |
| if (isGit() && scalar keys %changeLogSort == 0) { |
| # populate git commit message with WebKit-format ChangeLog entries unless explicitly disabled |
| my $branch = gitBranch(); |
| chomp(my $webkitGenerateCommitMessage = `git config --bool branch.$branch.webkitGenerateCommitMessage`); |
| if ($webkitGenerateCommitMessage eq "") { |
| chomp($webkitGenerateCommitMessage = `git config --bool core.webkitGenerateCommitMessage`); |
| } |
| if ($webkitGenerateCommitMessage ne "false") { |
| open CHANGELOG_ENTRIES, "-|", "$FindBin::Bin/prepare-ChangeLog --git-index --no-write" or die "prepare-ChangeLog failed: $!.\n"; |
| while (<CHANGELOG_ENTRIES>) { |
| print NEWLOG normalizeLineEndings($_, $endl); |
| } |
| close CHANGELOG_ENTRIES; |
| } |
| } else { |
| print NEWLOG normalizeLineEndings($commonPrefix, $endl); |
| for my $sortKey (sort keys %changeLogSort) { |
| my $label = $changeLogSort{$sortKey}; |
| if (keys %changeLogSort > 1) { |
| print NEWLOG normalizeLineEndings("\n", $endl) if !$first; |
| $first = 0; |
| print NEWLOG normalizeLineEndings("$label: ", $endl); |
| } |
| print NEWLOG normalizeLineEndings($changeLogContents{$label}, $endl); |
| } |
| } |
| print NEWLOG $logContents; |
| close NEWLOG; |
| |
| system (@editor, "$log.edit"); |
| |
| open NEWLOG, "$log.edit" or exit; |
| my $foundComment = 0; |
| while (<NEWLOG>) { |
| $foundComment = 1 if (/\S/ && !/^CVS:/); |
| } |
| close NEWLOG; |
| |
| if ($foundComment) { |
| open NEWLOG, "$log.edit" or die; |
| open LOG, ">$log" or die; |
| while (<NEWLOG>) { |
| print LOG; |
| } |
| close LOG; |
| close NEWLOG; |
| } |
| |
| unlink "$log.edit"; |
| |
| sub fixEnvironment() |
| { |
| return unless isMsys() && isGit(); |
| |
| # When this script gets run from inside git commit, msys-style paths in the |
| # environment will have been turned into Windows-style paths with forward |
| # slashes. This screws up functions like File::Spec->rel2abs, which seem to |
| # rely on $PWD having an msys-style path. We convert the paths back to |
| # msys-style here by transforming "c:/foo" to "/c/foo" (e.g.). See |
| # <http://webkit.org/b/48527>. |
| foreach my $key (keys %ENV) { |
| $ENV{$key} =~ s#^([[:alpha:]]):/#/$1/#; |
| } |
| } |
| |
| sub normalizeLineEndings($$) |
| { |
| my ($string, $endl) = @_; |
| $string =~ s/\r?\n/$endl/g; |
| return $string; |
| } |
| |
| sub removeLongestCommonPrefixEndingInDoubleNewline(\%) |
| { |
| my ($hashOfStrings) = @_; |
| |
| my @strings = values %{$hashOfStrings}; |
| return "" unless @strings > 1; |
| |
| my $prefix = shift @strings; |
| my $prefixLength = length $prefix; |
| foreach my $string (@strings) { |
| while ($prefixLength) { |
| last if substr($string, 0, $prefixLength) eq $prefix; |
| --$prefixLength; |
| $prefix = substr($prefix, 0, -1); |
| } |
| last unless $prefixLength; |
| } |
| |
| return "" unless $prefixLength; |
| |
| my $lastDoubleNewline = rindex($prefix, "\n\n"); |
| return "" unless $lastDoubleNewline > 0; |
| |
| foreach my $key (keys %{$hashOfStrings}) { |
| $hashOfStrings->{$key} = substr($hashOfStrings->{$key}, $lastDoubleNewline); |
| } |
| return substr($prefix, 0, $lastDoubleNewline + 2); |
| } |
| |
| sub isCommitLogEditor($) |
| { |
| my $editor = shift; |
| return $editor =~ m/commit-log-editor/; |
| } |