Home | History | Annotate | Download | only in Scripts 
      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 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 fixEnvironment();
     42 sub normalizeLineEndings($$);
     43 sub removeLongestCommonPrefixEndingInDoubleNewline(\%);
     44 sub isCommitLogEditor($);
     45 
     46 sub usage
     47 {
     48     print "Usage: [--help] [--regenerate-log] <log file>\n";
     49     exit 1;
     50 }
     51 
     52 my $help = checkForArgumentAndRemoveFromARGV("--help");
     53 if ($help) {
     54     usage();
     55 }
     56 
     57 my $regenerateLog = checkForArgumentAndRemoveFromARGV("--regenerate-log");
     58 my $log = $ARGV[0];
     59 if (!$log) {
     60     usage();
     61 }
     62 
     63 fixEnvironment();
     64 
     65 my $baseDir = baseProductDir();
     66 
     67 my $editor = $ENV{SVN_LOG_EDITOR};
     68 $editor = $ENV{CVS_LOG_EDITOR} if !$editor;
     69 $editor = "" if $editor && isCommitLogEditor($editor);
     70 
     71 my $splitEditor = 1;
     72 if (!$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 }
     79 if (!$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 }
     86 if (!$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 
     97 my @editor;
     98 if ($splitEditor) {
     99     @editor = split ' ', $editor;
    100 } else {
    101     @editor = ($editor);
    102 }
    103 
    104 my $inChangesToBeCommitted = !isGit();
    105 my @changeLogs = ();
    106 my $logContents = "";
    107 my $existingLog = 0;
    108 open LOG, $log or die "Could not open the log file.";
    109 while (<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 }
    128 close 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.
    132 my $endl = "\n";
    133 $endl = $1 if $logContents =~ /(\r?\n)/;
    134 
    135 my $keepExistingLog = 1;
    136 if ($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).
    145 exec (@editor, @ARGV) if $existingLog && $keepExistingLog;
    146 
    147 my $topLevel = determineVCSRoot();
    148 
    149 my %changeLogSort;
    150 my %changeLogContents;
    151 for 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 
    234 my $commonPrefix = removeLongestCommonPrefixEndingInDoubleNewline(%changeLogContents);
    235 
    236 my $first = 1;
    237 open NEWLOG, ">$log.edit" or die;
    238 if (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 }
    264 print NEWLOG $logContents;
    265 close NEWLOG;
    266 
    267 system (@editor, "$log.edit");
    268 
    269 open NEWLOG, "$log.edit" or exit;
    270 my $foundComment = 0;
    271 while (<NEWLOG>) {
    272     $foundComment = 1 if (/\S/ && !/^CVS:/);
    273 }
    274 close NEWLOG;
    275 
    276 if ($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 
    286 unlink "$log.edit";
    287 
    288 sub 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 
    303 sub normalizeLineEndings($$)
    304 {
    305     my ($string, $endl) = @_;
    306     $string =~ s/\r?\n/$endl/g;
    307     return $string;
    308 }
    309 
    310 sub 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 
    339 sub isCommitLogEditor($)
    340 {
    341     my $editor = shift;
    342     return $editor =~ m/commit-log-editor/;
    343 }
    344