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