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