Remove commit-log-editor's dependency on Module::Load::Conditional
[WebKit-https.git] / Tools / Scripts / commit-log-editor
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 fixEnvironment();
43 sub loadTermReadKey();
44 sub normalizeLineEndings($$);
45 sub patchAuthorshipString($$$);
46 sub removeLongestCommonPrefixEndingInDoubleNewline(\%);
47 sub isCommitLogEditor($);
48
49 my $endl = "\n";
50
51 sub printUsageAndExit
52 {
53     my $programName = basename($0);
54     print STDERR <<EOF;
55 Usage: $programName [--regenerate-log] <log file>
56        $programName --print-log <ChangeLog file> [<ChangeLog file>...]
57        $programName --help
58 EOF
59     exit 1;
60 }
61
62 my $help = 0;
63 my $printLog = 0;
64 my $regenerateLog = 0;
65
66 my $getOptionsResult = GetOptions(
67     'help' => \$help,
68     'print-log' => \$printLog,
69     'regenerate-log' => \$regenerateLog,
70 );
71
72 if (!$getOptionsResult || $help) {
73     printUsageAndExit();
74 }
75
76 die "Can't specify both --print-log and --regenerate-log\n" if $printLog && $regenerateLog;
77
78 if ($printLog) {
79     printUsageAndExit() unless @ARGV;
80     print createCommitMessage(@ARGV);
81     exit 0;
82 }
83
84 my $log = $ARGV[0];
85 if (!$log) {
86     printUsageAndExit();
87 }
88
89 fixEnvironment();
90
91 my $baseDir = baseProductDir();
92
93 my $editor = $ENV{SVN_LOG_EDITOR};
94 $editor = $ENV{CVS_LOG_EDITOR} if !$editor;
95 $editor = "" if $editor && isCommitLogEditor($editor);
96
97 my $splitEditor = 1;
98 if (!$editor) {
99     my $builtEditorApplication = "$baseDir/Release/Commit Log Editor.app/Contents/MacOS/Commit Log Editor";
100     if (-x $builtEditorApplication) {
101         $editor = $builtEditorApplication;
102         $splitEditor = 0;
103     }
104 }
105 if (!$editor) {
106     my $builtEditorApplication = "$baseDir/Debug/Commit Log Editor.app/Contents/MacOS/Commit Log Editor";
107     if (-x $builtEditorApplication) {
108         $editor = $builtEditorApplication;
109         $splitEditor = 0;
110     }
111 }
112 if (!$editor) {
113     my $builtEditorApplication = "$ENV{HOME}/Applications/Commit Log Editor.app/Contents/MacOS/Commit Log Editor";
114     if (-x $builtEditorApplication) {
115         $editor = $builtEditorApplication;
116         $splitEditor = 0;
117     }
118 }
119
120 $editor = $ENV{EDITOR} if !$editor;
121 $editor = "/usr/bin/vi" if !$editor;
122
123 my @editor;
124 if ($splitEditor) {
125     @editor = split ' ', $editor;
126 } else {
127     @editor = ($editor);
128 }
129
130 my $inChangesToBeCommitted = !isGit();
131 my @changeLogs = ();
132 my $logContents = "";
133 my $existingLog = 0;
134 open LOG, $log or die "Could not open the log file.";
135 while (<LOG>) {
136     if (isGit()) {
137         if (/^# Changes to be committed:$/) {
138             $inChangesToBeCommitted = 1;
139         } elsif ($inChangesToBeCommitted && /^# \S/) {
140             $inChangesToBeCommitted = 0;
141         }
142     }
143
144     if (!isGit() || /^#/) { #
145         $logContents .= $_;
146     } else {
147         # $_ contains the current git log message
148         # (without the log comment info). We don't need it.
149     }
150     $existingLog = isGit() && !(/^#/ || /^\s*$/) unless $existingLog;
151
152     push @changeLogs, makeFilePathRelative($1) if $inChangesToBeCommitted && (/^(?:M|A)....(.*ChangeLog)\r?\n?$/ || /^#\t(?:modified|new file):   (.*ChangeLog)$/) && !/-ChangeLog$/;
153 }
154 close LOG;
155
156 # We want to match the line endings of the existing log file in case they're
157 # different from perl's line endings.
158 $endl = $1 if $logContents =~ /(\r?\n)/;
159
160 my $keepExistingLog = 1;
161 if ($regenerateLog && $existingLog && scalar(@changeLogs) > 0 && loadTermReadKey()) {
162     print "Existing log message detected, Use 'r' to regenerate log message from ChangeLogs, or any other key to keep the existing message.\n";
163     Term::ReadKey::ReadMode('cbreak');
164     my $key = Term::ReadKey::ReadKey(0);
165     Term::ReadKey::ReadMode('normal');
166     $keepExistingLog = 0 if ($key eq "r");
167 }
168
169 # Don't change anything if there's already a log message (as can happen with git-commit --amend).
170 exec (@editor, @ARGV) if $existingLog && $keepExistingLog;
171
172 my $first = 1;
173 open NEWLOG, ">$log.edit" or die;
174 if (isGit() && @changeLogs == 0) {
175     # populate git commit message with WebKit-format ChangeLog entries unless explicitly disabled
176     my $branch = gitBranch();
177     chomp(my $webkitGenerateCommitMessage = `git config --bool branch.$branch.webkitGenerateCommitMessage`);
178     if ($webkitGenerateCommitMessage eq "") {
179         chomp($webkitGenerateCommitMessage = `git config --bool core.webkitGenerateCommitMessage`);
180     }
181     if ($webkitGenerateCommitMessage ne "false") {
182         open CHANGELOG_ENTRIES, "-|", "$FindBin::Bin/prepare-ChangeLog --git-index --no-write" or die "prepare-ChangeLog failed: $!.\n";
183         while (<CHANGELOG_ENTRIES>) {
184             print NEWLOG normalizeLineEndings($_, $endl);
185         }
186         close CHANGELOG_ENTRIES;
187     }
188 } else {
189     print NEWLOG createCommitMessage(@changeLogs);
190 }
191 print NEWLOG $logContents;
192 close NEWLOG;
193
194 system (@editor, "$log.edit");
195
196 open NEWLOG, "$log.edit" or exit;
197 my $foundComment = 0;
198 while (<NEWLOG>) {
199     $foundComment = 1 if (/\S/ && !/^CVS:/);
200 }
201 close NEWLOG;
202
203 if ($foundComment) {
204     open NEWLOG, "$log.edit" or die;
205     open LOG, ">$log" or die;
206     while (<NEWLOG>) {
207         print LOG;
208     }
209     close LOG;
210     close NEWLOG;
211 }
212
213 unlink "$log.edit";
214
215 sub createCommitMessage(@)
216 {
217     my @changeLogs = @_;
218
219     my $topLevel = determineVCSRoot();
220
221     my %changeLogSort;
222     my %changeLogContents;
223     for my $changeLog (@changeLogs) {
224         open CHANGELOG, $changeLog or die "Can't open $changeLog";
225         my $contents = "";
226         my $blankLines = "";
227         my $lineCount = 0;
228         my $date = "";
229         my $author = "";
230         my $email = "";
231         my $hasAuthorInfoToWrite = 0;
232         while (<CHANGELOG>) {
233             if (/^\S/) {
234                 last if $contents;
235             }
236             if (/\S/) {
237                 $contents .= $blankLines if $contents;
238                 $blankLines = "";
239
240                 my $line = $_;
241
242                 # Remove indentation spaces
243                 $line =~ s/^ {8}//;
244
245                 # Grab the author and the date line
246                 if ($line =~ m/^([0-9]{4}-[0-9]{2}-[0-9]{2})\s+(.*[^\s])\s+<(.*)>/ && $lineCount == 0) {
247                     $date = $1;
248                     $author = $2;
249                     $email = $3;
250                     $hasAuthorInfoToWrite = 1;
251                     next;
252                 }
253
254                 if ($hasAuthorInfoToWrite) {
255                     my $isReviewedByLine = $line =~ m/^(?:Reviewed|Rubber[ \-]?stamped) by/;
256                     my $isModifiedFileLine = $line =~ m/^\* .*:/;
257
258                     # Insert the authorship line if needed just above the "Reviewed by" line or the
259                     # first modified file (whichever comes first).
260                     if ($isReviewedByLine || $isModifiedFileLine) {
261                         $hasAuthorInfoToWrite = 0;
262                         my $authorshipString = patchAuthorshipString($author, $email, $date);
263                         if ($authorshipString) {
264                             $contents .= "$authorshipString\n";
265                             $contents .= "\n" if $isModifiedFileLine;
266                         }
267                     }
268                 }
269
270
271                 $lineCount++;
272                 $contents .= $line;
273             } else {
274                 $blankLines .= $_;
275             }
276         }
277         if ($hasAuthorInfoToWrite) {
278             # We didn't find anywhere to put the authorship info, so just put it at the end.
279             my $authorshipString = patchAuthorshipString($author, $email, $date);
280             $contents .= "\n$authorshipString\n" if $authorshipString;
281             $hasAuthorInfoToWrite = 0;
282         }
283
284         close CHANGELOG;
285
286         $changeLog = File::Spec->abs2rel(File::Spec->rel2abs($changeLog), $topLevel);
287
288         my $label = dirname($changeLog);
289         $label = "top level" unless length $label;
290
291         my $sortKey = lc $label;
292         if ($label eq "top level") {
293             $sortKey = "";
294         } elsif ($label eq "LayoutTests") {
295             $sortKey = lc "~, LayoutTests last";
296         }
297
298         $changeLogSort{$sortKey} = $label;
299         $changeLogContents{$label} = $contents;
300     }
301
302     my $commonPrefix = removeLongestCommonPrefixEndingInDoubleNewline(%changeLogContents);
303
304     my $first = 1;
305     my @result;
306     push @result, normalizeLineEndings($commonPrefix, $endl);
307     for my $sortKey (sort keys %changeLogSort) {
308         my $label = $changeLogSort{$sortKey};
309         if (keys %changeLogSort > 1) {
310             push @result, normalizeLineEndings("\n", $endl) if !$first;
311             $first = 0;
312             push @result, normalizeLineEndings("$label: ", $endl);
313         }
314         push @result, normalizeLineEndings($changeLogContents{$label}, $endl);
315     }
316
317     return join '', @result;
318 }
319
320 sub fixEnvironment()
321 {
322     return unless isMsys() && isGit();
323
324     # When this script gets run from inside git commit, msys-style paths in the
325     # environment will have been turned into Windows-style paths with forward
326     # slashes. This screws up functions like File::Spec->rel2abs, which seem to
327     # rely on $PWD having an msys-style path. We convert the paths back to
328     # msys-style here by transforming "c:/foo" to "/c/foo" (e.g.). See
329     # <http://webkit.org/b/48527>.
330     foreach my $key (keys %ENV) {
331         $ENV{$key} =~ s#^([[:alpha:]]):/#/$1/#;
332     }
333 }
334
335 sub loadTermReadKey()
336 {
337     eval { require Term::ReadKey; };
338     return !$@;
339 }
340
341 sub normalizeLineEndings($$)
342 {
343     my ($string, $endl) = @_;
344     $string =~ s/\r?\n/$endl/g;
345     return $string;
346 }
347
348 sub patchAuthorshipString($$$)
349 {
350     my ($authorName, $authorEmail, $authorDate) = @_;
351
352     return if $authorEmail eq changeLogEmailAddress();
353     return "Patch by $authorName <$authorEmail> on $authorDate";
354 }
355
356 sub removeLongestCommonPrefixEndingInDoubleNewline(\%)
357 {
358     my ($hashOfStrings) = @_;
359
360     my @strings = values %{$hashOfStrings};
361     return "" unless @strings > 1;
362
363     my $prefix = shift @strings;
364     my $prefixLength = length $prefix;
365     foreach my $string (@strings) {
366         while ($prefixLength) {
367             last if substr($string, 0, $prefixLength) eq $prefix;
368             --$prefixLength;
369             $prefix = substr($prefix, 0, -1);
370         }
371         last unless $prefixLength;
372     }
373
374     return "" unless $prefixLength;
375
376     my $lastDoubleNewline = rindex($prefix, "\n\n");
377     return "" unless $lastDoubleNewline > 0;
378
379     foreach my $key (keys %{$hashOfStrings}) {
380         $hashOfStrings->{$key} = substr($hashOfStrings->{$key}, $lastDoubleNewline);
381     }
382     return substr($prefix, 0, $lastDoubleNewline + 2);
383 }
384
385 sub isCommitLogEditor($)
386 {
387     my $editor = shift;
388     return $editor =~ m/commit-log-editor/;
389 }