| OLD | NEW |
|---|
| (Empty) |
| 1 #!/usr/bin/perl -w | |
| 2 | |
| 3 # Copyright (C) 2006, 2007, 2008, 2009, 2010 Apple Inc. All rights reserved. | |
| 4 # Copyright (C) 2009 Torch Mobile Inc. All rights reserved. | |
| 5 # | |
| 6 # Redistribution and use in source and binary forms, with or without | |
| 7 # modification, are permitted provided that the following conditions | |
| 8 # are met: | |
| 9 # | |
| 10 # 1. Redistributions of source code must retain the above copyright | |
| 11 # notice, this list of conditions and the following disclaimer. | |
| 12 # 2. Redistributions in binary form must reproduce the above copyright | |
| 13 # notice, this list of conditions and the following disclaimer in the | |
| 14 # documentation and/or other materials provided with the distribution. | |
| 15 # 3. Neither the name of Apple Computer, Inc. ("Apple") nor the names of | |
| 16 # its contributors may be used to endorse or promote products derived | |
| 17 # from this software without specific prior written permission. | |
| 18 # | |
| 19 # THIS SOFTWARE IS PROVIDED BY APPLE AND ITS CONTRIBUTORS "AS IS" AND ANY | |
| 20 # EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED | |
| 21 # WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE | |
| 22 # DISCLAIMED. IN NO EVENT SHALL APPLE OR ITS CONTRIBUTORS BE LIABLE FOR ANY | |
| 23 # DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES | |
| 24 # (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; | |
| 25 # LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND | |
| 26 # ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT | |
| 27 # (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF | |
| 28 # THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. | |
| 29 | |
| 30 # Script to put change log comments in as default check-in comment. | |
| 31 | |
| 32 use strict; | |
| 33 use Getopt::Long; | |
| 34 use File::Basename; | |
| 35 use File::Spec; | |
| 36 use FindBin; | |
| 37 use lib $FindBin::Bin; | |
| 38 use VCSUtils; | |
| 39 use webkitdirs; | |
| 40 | |
| 41 sub createCommitMessage(@); | |
| 42 sub loadTermReadKey(); | |
| 43 sub normalizeLineEndings($$); | |
| 44 sub patchAuthorshipString($$$); | |
| 45 sub removeLongestCommonPrefixEndingInDoubleNewline(\%); | |
| 46 sub isCommitLogEditor($); | |
| 47 | |
| 48 my $endl = "\n"; | |
| 49 | |
| 50 sub printUsageAndExit | |
| 51 { | |
| 52 my $programName = basename($0); | |
| 53 print STDERR <<EOF; | |
| 54 Usage: $programName [--regenerate-log] <log file> | |
| 55 $programName --print-log <ChangeLog file> [<ChangeLog file>...] | |
| 56 $programName --help | |
| 57 EOF | |
| 58 exit 1; | |
| 59 } | |
| 60 | |
| 61 my $help = 0; | |
| 62 my $printLog = 0; | |
| 63 my $regenerateLog = 0; | |
| 64 | |
| 65 my $getOptionsResult = GetOptions( | |
| 66 'help' => \$help, | |
| 67 'print-log' => \$printLog, | |
| 68 'regenerate-log' => \$regenerateLog, | |
| 69 ); | |
| 70 | |
| 71 if (!$getOptionsResult || $help) { | |
| 72 printUsageAndExit(); | |
| 73 } | |
| 74 | |
| 75 die "Can't specify both --print-log and --regenerate-log\n" if $printLog && $reg
enerateLog; | |
| 76 | |
| 77 if ($printLog) { | |
| 78 printUsageAndExit() unless @ARGV; | |
| 79 print createCommitMessage(@ARGV); | |
| 80 exit 0; | |
| 81 } | |
| 82 | |
| 83 my $log = $ARGV[0]; | |
| 84 if (!$log) { | |
| 85 printUsageAndExit(); | |
| 86 } | |
| 87 | |
| 88 my $baseDir = baseProductDir(); | |
| 89 | |
| 90 my $editor = $ENV{SVN_LOG_EDITOR}; | |
| 91 $editor = $ENV{CVS_LOG_EDITOR} if !$editor; | |
| 92 $editor = "" if $editor && isCommitLogEditor($editor); | |
| 93 | |
| 94 my $splitEditor = 1; | |
| 95 if (!$editor) { | |
| 96 my $builtEditorApplication = "$baseDir/Release/Commit Log Editor.app/Content
s/MacOS/Commit Log Editor"; | |
| 97 if (-x $builtEditorApplication) { | |
| 98 $editor = $builtEditorApplication; | |
| 99 $splitEditor = 0; | |
| 100 } | |
| 101 } | |
| 102 if (!$editor) { | |
| 103 my $builtEditorApplication = "$baseDir/Debug/Commit Log Editor.app/Contents/
MacOS/Commit Log Editor"; | |
| 104 if (-x $builtEditorApplication) { | |
| 105 $editor = $builtEditorApplication; | |
| 106 $splitEditor = 0; | |
| 107 } | |
| 108 } | |
| 109 if (!$editor) { | |
| 110 my $builtEditorApplication = "$ENV{HOME}/Applications/Commit Log Editor.app/
Contents/MacOS/Commit Log Editor"; | |
| 111 if (-x $builtEditorApplication) { | |
| 112 $editor = $builtEditorApplication; | |
| 113 $splitEditor = 0; | |
| 114 } | |
| 115 } | |
| 116 | |
| 117 $editor = $ENV{EDITOR} if !$editor; | |
| 118 $editor = "/usr/bin/vi" if !$editor; | |
| 119 | |
| 120 my @editor; | |
| 121 if ($splitEditor) { | |
| 122 @editor = split ' ', $editor; | |
| 123 } else { | |
| 124 @editor = ($editor); | |
| 125 } | |
| 126 | |
| 127 my $inChangesToBeCommitted = !isGit(); | |
| 128 my @changeLogs = (); | |
| 129 my $logContents = ""; | |
| 130 my $existingLog = 0; | |
| 131 open LOG, $log or die "Could not open the log file."; | |
| 132 while (my $curLine = <LOG>) { | |
| 133 if (isGit()) { | |
| 134 if ($curLine =~ /^# Changes to be committed:$/) { | |
| 135 $inChangesToBeCommitted = 1; | |
| 136 } elsif ($inChangesToBeCommitted && $curLine =~ /^# \S/) { | |
| 137 $inChangesToBeCommitted = 0; | |
| 138 } | |
| 139 } | |
| 140 | |
| 141 if (!isGit() || $curLine =~ /^#/) { | |
| 142 $logContents .= $curLine; | |
| 143 } else { | |
| 144 # $_ contains the current git log message | |
| 145 # (without the log comment info). We don't need it. | |
| 146 } | |
| 147 $existingLog = isGit() && !($curLine =~ /^#/ || $curLine =~ /^\s*$/) unless
$existingLog; | |
| 148 my $changeLogFileName = changeLogFileName(); | |
| 149 push @changeLogs, makeFilePathRelative($1) if $inChangesToBeCommitted && ($c
urLine =~ /^(?:M|A)....(.*$changeLogFileName)\r?\n?$/ || $curLine =~ /^#\t(?:mod
ified|new file): (.*$changeLogFileName)$/) && $curLine !~ /-$changeLogFileName
$/; | |
| 150 } | |
| 151 close LOG; | |
| 152 | |
| 153 # We want to match the line endings of the existing log file in case they're | |
| 154 # different from perl's line endings. | |
| 155 $endl = $1 if $logContents =~ /(\r?\n)/; | |
| 156 | |
| 157 my $keepExistingLog = 1; | |
| 158 if ($regenerateLog && $existingLog && scalar(@changeLogs) > 0 && loadTermReadKey
()) { | |
| 159 print "Existing log message detected, Use 'r' to regenerate log message from
ChangeLogs, or any other key to keep the existing message.\n"; | |
| 160 Term::ReadKey::ReadMode('cbreak'); | |
| 161 my $key = Term::ReadKey::ReadKey(0); | |
| 162 Term::ReadKey::ReadMode('normal'); | |
| 163 $keepExistingLog = 0 if ($key eq "r"); | |
| 164 } | |
| 165 | |
| 166 # Don't change anything if there's already a log message (as can happen with git
-commit --amend). | |
| 167 exec (@editor, @ARGV) if $existingLog && $keepExistingLog; | |
| 168 | |
| 169 my $first = 1; | |
| 170 open NEWLOG, ">$log.edit" or die; | |
| 171 if (isGit() && @changeLogs == 0) { | |
| 172 # populate git commit message with WebKit-format ChangeLog entries unless ex
plicitly disabled | |
| 173 my $branch = gitBranch(); | |
| 174 chomp(my $webkitGenerateCommitMessage = `git config --bool branch.$branch.we
bkitGenerateCommitMessage`); | |
| 175 if ($webkitGenerateCommitMessage eq "") { | |
| 176 chomp($webkitGenerateCommitMessage = `git config --bool core.webkitGener
ateCommitMessage`); | |
| 177 } | |
| 178 if ($webkitGenerateCommitMessage ne "false") { | |
| 179 open CHANGELOG_ENTRIES, "-|", "$FindBin::Bin/prepare-ChangeLog --git-ind
ex --no-write" or die "prepare-ChangeLog failed: $!.\n"; | |
| 180 while (<CHANGELOG_ENTRIES>) { | |
| 181 print NEWLOG normalizeLineEndings($_, $endl); | |
| 182 } | |
| 183 close CHANGELOG_ENTRIES; | |
| 184 } | |
| 185 } else { | |
| 186 print NEWLOG createCommitMessage(@changeLogs); | |
| 187 } | |
| 188 print NEWLOG $logContents; | |
| 189 close NEWLOG; | |
| 190 | |
| 191 system (@editor, "$log.edit"); | |
| 192 | |
| 193 open NEWLOG, "$log.edit" or exit; | |
| 194 my $foundComment = 0; | |
| 195 while (<NEWLOG>) { | |
| 196 $foundComment = 1 if (/\S/ && !/^CVS:/); | |
| 197 } | |
| 198 close NEWLOG; | |
| 199 | |
| 200 if ($foundComment) { | |
| 201 open NEWLOG, "$log.edit" or die; | |
| 202 open LOG, ">$log" or die; | |
| 203 while (<NEWLOG>) { | |
| 204 print LOG; | |
| 205 } | |
| 206 close LOG; | |
| 207 close NEWLOG; | |
| 208 } | |
| 209 | |
| 210 unlink "$log.edit"; | |
| 211 | |
| 212 sub createCommitMessage(@) | |
| 213 { | |
| 214 my @changeLogs = @_; | |
| 215 | |
| 216 my $topLevel = determineVCSRoot(); | |
| 217 | |
| 218 my %changeLogSort; | |
| 219 my %changeLogContents; | |
| 220 for my $changeLog (@changeLogs) { | |
| 221 open CHANGELOG, $changeLog or die "Can't open $changeLog"; | |
| 222 my $contents = ""; | |
| 223 my $blankLines = ""; | |
| 224 my $lineCount = 0; | |
| 225 my $date = ""; | |
| 226 my $author = ""; | |
| 227 my $email = ""; | |
| 228 my $hasAuthorInfoToWrite = 0; | |
| 229 while (<CHANGELOG>) { | |
| 230 if (/^\S/) { | |
| 231 last if $contents; | |
| 232 } | |
| 233 if (/\S/) { | |
| 234 $contents .= $blankLines if $contents; | |
| 235 $blankLines = ""; | |
| 236 | |
| 237 my $line = $_; | |
| 238 | |
| 239 # Remove indentation spaces | |
| 240 $line =~ s/^ {8}//; | |
| 241 | |
| 242 # Grab the author and the date line | |
| 243 if ($line =~ m/^([0-9]{4}-[0-9]{2}-[0-9]{2})\s+(.*[^\s])\s+<(.*)
>/ && $lineCount == 0) { | |
| 244 $date = $1; | |
| 245 $author = $2; | |
| 246 $email = $3; | |
| 247 $hasAuthorInfoToWrite = 1; | |
| 248 next; | |
| 249 } | |
| 250 | |
| 251 if ($hasAuthorInfoToWrite) { | |
| 252 my $isReviewedByLine = $line =~ m/^(?:Reviewed|Rubber[ \-]?s
tamped) by/; | |
| 253 my $isModifiedFileLine = $line =~ m/^\* .*:/; | |
| 254 | |
| 255 # Insert the authorship line if needed just above the "Revie
wed by" line or the | |
| 256 # first modified file (whichever comes first). | |
| 257 if ($isReviewedByLine || $isModifiedFileLine) { | |
| 258 $hasAuthorInfoToWrite = 0; | |
| 259 my $authorshipString = patchAuthorshipString($author, $e
mail, $date); | |
| 260 if ($authorshipString) { | |
| 261 $contents .= "$authorshipString\n"; | |
| 262 $contents .= "\n" if $isModifiedFileLine; | |
| 263 } | |
| 264 } | |
| 265 } | |
| 266 | |
| 267 | |
| 268 $lineCount++; | |
| 269 $contents .= $line; | |
| 270 } else { | |
| 271 $blankLines .= $_; | |
| 272 } | |
| 273 } | |
| 274 if ($hasAuthorInfoToWrite) { | |
| 275 # We didn't find anywhere to put the authorship info, so just put it
at the end. | |
| 276 my $authorshipString = patchAuthorshipString($author, $email, $date)
; | |
| 277 $contents .= "\n$authorshipString\n" if $authorshipString; | |
| 278 $hasAuthorInfoToWrite = 0; | |
| 279 } | |
| 280 | |
| 281 close CHANGELOG; | |
| 282 | |
| 283 $changeLog = File::Spec->abs2rel(File::Spec->rel2abs($changeLog), $topLe
vel); | |
| 284 | |
| 285 my $label = dirname($changeLog); | |
| 286 $label = "top level" unless length $label; | |
| 287 | |
| 288 my $sortKey = lc $label; | |
| 289 if ($label eq "top level") { | |
| 290 $sortKey = ""; | |
| 291 } elsif ($label eq "LayoutTests") { | |
| 292 $sortKey = lc "~, LayoutTests last"; | |
| 293 } | |
| 294 | |
| 295 $changeLogSort{$sortKey} = $label; | |
| 296 $changeLogContents{$label} = $contents; | |
| 297 } | |
| 298 | |
| 299 my $commonPrefix = removeLongestCommonPrefixEndingInDoubleNewline(%changeLog
Contents); | |
| 300 | |
| 301 my $first = 1; | |
| 302 my @result; | |
| 303 push @result, normalizeLineEndings($commonPrefix, $endl); | |
| 304 for my $sortKey (sort keys %changeLogSort) { | |
| 305 my $label = $changeLogSort{$sortKey}; | |
| 306 if (keys %changeLogSort > 1) { | |
| 307 push @result, normalizeLineEndings("\n", $endl) if !$first; | |
| 308 $first = 0; | |
| 309 push @result, normalizeLineEndings("$label: ", $endl); | |
| 310 } | |
| 311 push @result, normalizeLineEndings($changeLogContents{$label}, $endl); | |
| 312 } | |
| 313 | |
| 314 return join '', @result; | |
| 315 } | |
| 316 | |
| 317 sub loadTermReadKey() | |
| 318 { | |
| 319 eval { require Term::ReadKey; }; | |
| 320 return !$@; | |
| 321 } | |
| 322 | |
| 323 sub normalizeLineEndings($$) | |
| 324 { | |
| 325 my ($string, $endl) = @_; | |
| 326 $string =~ s/\r?\n/$endl/g; | |
| 327 return $string; | |
| 328 } | |
| 329 | |
| 330 sub patchAuthorshipString($$$) | |
| 331 { | |
| 332 my ($authorName, $authorEmail, $authorDate) = @_; | |
| 333 | |
| 334 return if $authorEmail eq changeLogEmailAddress(); | |
| 335 return "Patch by $authorName <$authorEmail> on $authorDate"; | |
| 336 } | |
| 337 | |
| 338 sub removeLongestCommonPrefixEndingInDoubleNewline(\%) | |
| 339 { | |
| 340 my ($hashOfStrings) = @_; | |
| 341 | |
| 342 my @strings = values %{$hashOfStrings}; | |
| 343 return "" unless @strings > 1; | |
| 344 | |
| 345 my $prefix = shift @strings; | |
| 346 my $prefixLength = length $prefix; | |
| 347 foreach my $string (@strings) { | |
| 348 while ($prefixLength) { | |
| 349 last if substr($string, 0, $prefixLength) eq $prefix; | |
| 350 --$prefixLength; | |
| 351 $prefix = substr($prefix, 0, -1); | |
| 352 } | |
| 353 last unless $prefixLength; | |
| 354 } | |
| 355 | |
| 356 return "" unless $prefixLength; | |
| 357 | |
| 358 my $lastDoubleNewline = rindex($prefix, "\n\n"); | |
| 359 return "" unless $lastDoubleNewline > 0; | |
| 360 | |
| 361 foreach my $key (keys %{$hashOfStrings}) { | |
| 362 $hashOfStrings->{$key} = substr($hashOfStrings->{$key}, $lastDoubleNewli
ne); | |
| 363 } | |
| 364 return substr($prefix, 0, $lastDoubleNewline + 2); | |
| 365 } | |
| 366 | |
| 367 sub isCommitLogEditor($) | |
| 368 { | |
| 369 my $editor = shift; | |
| 370 return $editor =~ m/commit-log-editor/; | |
| 371 } | |
| OLD | NEW |
|---|
Chromium Code Reviews
Issue 1253013003:
Remove all perl scripts from Tools/Scripts (Closed)
Base URL: svn://svn.chromium.org/blink/trunk