#!/usr/bin/perl -w # Copyright (C) 2006, 2007, 2008, 2009 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 normalizeLineEndings($$); sub removeLongestCommonPrefixEndingInDoubleNewline(\%); 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(); } my $baseDir = baseProductDir(); my $editor = $ENV{SVN_LOG_EDITOR}; if (!$editor) { $editor = $ENV{CVS_LOG_EDITOR}; } if (!$editor) { my $builtEditorApplication = "$baseDir/Release/Commit Log Editor.app/Contents/MacOS/Commit Log Editor"; $editor = $builtEditorApplication if -x $builtEditorApplication; } if (!$editor) { my $builtEditorApplication = "$baseDir/Debug/Commit Log Editor.app/Contents/MacOS/Commit Log Editor"; $editor = $builtEditorApplication if -x $builtEditorApplication; } if (!$editor) { my $installedEditorApplication = "$ENV{HOME}/Applications/Commit Log Editor.app/Contents/MacOS/Commit Log Editor"; $editor = $installedEditorApplication if -x $installedEditorApplication; } if (!$editor) { $editor = $ENV{EDITOR} || "/usr/bin/vi"; } my $inChangesToBeCommitted = !isGit(); my @changeLogs = (); my $logContents = ""; my $existingLog = 0; open LOG, $log or die; 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....(.*ChangeLog)\r?\n?$/ || /^#\tmodified: (.*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 by line if ($line =~ m/^Reviewed 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 "Tools") { $sortKey = "-, just after top level"; } elsif ($label eq "WebBrowser") { $sortKey = lc "WebKit, WebBrowser after"; } elsif ($label eq "WebCore") { $sortKey = lc "WebFoundation, WebCore after"; } 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 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); }