#!/usr/bin/perl -w

# -*- Mode: perl; indent-tabs-mode: nil; c-basic-offset: 2  -*-

#

#  Copyright (C) 2000, 2001 Eazel, Inc.

#  Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007 Apple Inc.  All rights reserved.

#  Copyright (C) 2009 Torch Mobile, Inc.

#  Copyright (C) 2009 Cameron McCormack <cam@mcc.id.au>

#

#  prepare-ChangeLog is free software; you can redistribute it and/or

#  modify it under the terms of the GNU General Public

#  License as published by the Free Software Foundation; either

#  version 2 of the License, or (at your option) any later version.

#

#  prepare-ChangeLog is distributed in the hope that it will be useful,

#  but WITHOUT ANY WARRANTY; without even the implied warranty of

#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU

#  General Public License for more details.

#

#  You should have received a copy of the GNU General Public

#  License along with this program; if not, write to the Free

#  Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.

#

# Perl script to create a ChangeLog entry with names of files

# and functions from a diff.

#

# Darin Adler <darin@bentspoon.com>, started 20 April 2000

# Java support added by Maciej Stachowiak <mjs@eazel.com>

# Objective-C, C++ and Objective-C++ support added by Maciej Stachowiak <mjs@apple.com>

# Git support added by Adam Roben <aroben@apple.com>

# --git-index flag added by Joe Mason <joe.mason@torchmobile.com>

#

# TODO:

#   List functions that have been removed too.

#   Decide what a good logical order is for the changed files

#     other than a normal text "sort" (top level first?)

#     (group directories?) (.h before .c?)

#   Handle yacc source files too (other languages?).

#   Help merge when there are ChangeLog conflicts or if there's

#     already a partly written ChangeLog entry.

#   Add command line option to put the ChangeLog into a separate file.

#   Add SVN version numbers for commit (can't do that until

#     the changes are checked in, though).

#   Work around diff stupidity where deleting a function that starts

#     with a comment makes diff think that the following function

#     has been changed (if the following function starts with a comment

#     with the same first line, such as /**)

#   Work around diff stupidity where deleting an entire function and

#     the blank lines before it makes diff think you've changed the

#     previous function.

use strict;

use warnings;

use File::Basename;

use File::Spec;

use FindBin;

use Getopt::Long;

use lib $FindBin::Bin;

use POSIX qw(strftime);

use VCSUtils;

sub changeLogDate($);

sub changeLogEmailAddressFromArgs($);

sub changeLogNameFromArgs($);

sub firstDirectoryOrCwd();

sub diffFromToString();

sub diffCommand(@);

sub statusCommand(@);

sub createPatchCommand($);

sub diffHeaderFormat();

sub findOriginalFileFromSvn($);

sub determinePropertyChanges($$$);

sub pluralizeAndList($$@);

sub generateFileList(\@\@\%);

sub isUnmodifiedStatus($);

sub isModifiedStatus($);

sub isAddedStatus($);

sub isConflictStatus($);

sub statusDescription($$$$);

sub propertyChangeDescription($);

sub extractLineRange($);

sub testListForChangeLog(@);

sub get_function_line_ranges($$);

sub get_function_line_ranges_for_c($$);

sub get_function_line_ranges_for_java($$);

sub get_function_line_ranges_for_javascript($$);

sub get_selector_line_ranges_for_css($$);

sub method_decl_to_selector($);

sub processPaths(\@);

sub reviewerAndDescriptionForGitCommit($);

sub normalizeLineEndings($$);

sub decodeEntities($);

# Project time zone for Cupertino, CA, US

my $changeLogTimeZone = "PST8PDT";

my $bugNumber;

my $name;

my $emailAddress;

my $mergeBase = 0;

my $gitCommit = 0;

my $gitIndex = "";

my $gitReviewer = "";

my $openChangeLogs = 0;

my $writeChangeLogs = 1;

my $showHelp = 0;

my $spewDiff = $ENV{"PREPARE_CHANGELOG_DIFF"};

my $updateChangeLogs = 1;

my $parseOptionsResult =

    GetOptions("diff|d!" => \$spewDiff,

               "bug:i" => \$bugNumber,

               "name:s" => \$name,

               "email:s" => \$emailAddress,

               "merge-base:s" => \$mergeBase,

               "git-commit:s" => \$gitCommit,

               "git-index" => \$gitIndex,

               "git-reviewer:s" => \$gitReviewer,

               "help|h!" => \$showHelp,

               "open|o!" => \$openChangeLogs,

               "write!" => \$writeChangeLogs,

               "update!" => \$updateChangeLogs);

if (!$parseOptionsResult || $showHelp) {

    print STDERR basename($0) . " [--bug] [-d|--diff] [-h|--help] [-o|--open] [--git-commit=<committish>] [--git-reviewer=<name>] [svndir1 [svndir2 ...]]\n";

    print STDERR "  --bug          Fill in the ChangeLog bug information from the given bug.\n";

    print STDERR "  -d|--diff      Spew diff to stdout when running\n";

    print STDERR "  --merge-base   Populate the ChangeLogs with the diff to this branch\n";

    print STDERR "  --git-commit   Populate the ChangeLogs from the specified git commit\n";

    print STDERR "  --git-index    Populate the ChangeLogs from the git index only\n";

    print STDERR "  --git-reviewer When populating the ChangeLogs from a git commit claim that the spcified name reviewed the change.\n";

    print STDERR "                 This option is useful when the git commit lacks a Signed-Off-By: line\n";

    print STDERR "  -h|--help      Show this help message\n";

    print STDERR "  -o|--open      Open ChangeLogs in an editor when done\n";

    print STDERR "  --[no-]update  Update ChangeLogs from svn before adding entry (default: update)\n";

    print STDERR "  --[no-]write   Write ChangeLogs to disk (otherwise send new entries to stdout) (default: write)\n";

    exit 1;

}

die "--git-commit and --git-index are incompatible." if ($gitIndex && $gitCommit);

my %paths = processPaths(@ARGV);

my $isGit = isGitDirectory(firstDirectoryOrCwd());

my $isSVN = isSVNDirectory(firstDirectoryOrCwd());

$isSVN || $isGit || die "Couldn't determine your version control system.";

my $SVN = "svn";

my $GIT = "git";

# Find the list of modified files

my @changed_files;

my $changed_files_string;

my %changed_line_ranges;

my %function_lists;

my @conflict_files;

my %supportedTestExtensions = map { $_ => 1 } qw(html shtml svg xml xhtml pl php);

my @addedRegressionTests = ();

my $didChangeRegressionTests = 0;

generateFileList(@changed_files, @conflict_files, %function_lists);

if (!@changed_files && !@conflict_files && !keys %function_lists) {

    print STDERR "  No changes found.\n";

    exit 1;

}

if (@conflict_files) {

    print STDERR "  The following files have conflicts. Run prepare-ChangeLog again after fixing the conflicts:\n";

    print STDERR join("\n", @conflict_files), "\n";

    exit 1;

}

if (@changed_files) {

    $changed_files_string = "'" . join ("' '", @changed_files) . "'";

    # For each file, build a list of modified lines.

    # Use line numbers from the "after" side of each diff.

    print STDERR "  Reviewing diff to determine which lines changed.\n";

    my $file;

    open DIFF, "-|", diffCommand(@changed_files) or die "The diff failed: $!.\n";

    while (<DIFF>) {

        $file = makeFilePathRelative($1) if $_ =~ diffHeaderFormat();

        if (defined $file) {

            my ($start, $end) = extractLineRange($_);

            if ($start >= 0 && $end >= 0) {

                push @{$changed_line_ranges{$file}}, [ $start, $end ];

            } elsif (/DO_NOT_COMMIT/) {

                print STDERR "WARNING: file $file contains the string DO_NOT_COMMIT, line $.\n";

            }

        }

    }

    close DIFF;

}

# For each source file, convert line range to function list.

if (%changed_line_ranges) {

    print STDERR "  Extracting affected function names from source files.\n";

    foreach my $file (keys %changed_line_ranges) {

        # Only look for function names in certain source files.

        next unless $file =~ /\.(c|cpp|m|mm|h|java|js)/;

        # Find all the functions in the file.

        open SOURCE, $file or next;

        my @function_ranges = get_function_line_ranges(\*SOURCE, $file);

        close SOURCE;

        # Find all the modified functions.

        my @functions;

        my %saw_function;

        my @change_ranges = (@{$changed_line_ranges{$file}}, []);

        my @change_range = (0, 0);

        FUNCTION: foreach my $function_range_ref (@function_ranges) {

            my @function_range = @$function_range_ref;

            # Advance to successive change ranges.

            for (;; @change_range = @{shift @change_ranges}) {

                last FUNCTION unless @change_range;

                # If past this function, move on to the next one.

                next FUNCTION if $change_range[0] > $function_range[1];

                # If an overlap with this function range, record the function name.

                if ($change_range[1] >= $function_range[0]

                    and $change_range[0] <= $function_range[1]) {

                    if (!$saw_function{$function_range[2]}) {

                        $saw_function{$function_range[2]} = 1;

                        push @functions, $function_range[2];

                    }

                    next FUNCTION;

                }

            }

        }

        # Format the list of functions now.

        if (@functions) {

            $function_lists{$file} = "" if !defined $function_lists{$file};

            $function_lists{$file} .= "\n        (" . join("):\n        (", @functions) . "):";

        }

    }

}

# Get some parameters for the ChangeLog we are about to write.

my $date = changeLogDate($changeLogTimeZone);

$name = changeLogNameFromArgs($name);

$emailAddress = changeLogEmailAddressFromArgs($emailAddress);

print STDERR "  Change author: $name <$emailAddress>.\n";

my $bugDescription;

my $bugURL;

if ($bugNumber) {

    $bugURL = "https://bugs.webkit.org/show_bug.cgi?id=$bugNumber";

    my $bugXMLURL = "$bugURL&ctype=xml";

    # Perl has no built in XML processing, so we'll fetch and parse with curl and grep

    # Pass --insecure because some cygwin installs have no certs we don't

    # care about validating that bugs.webkit.org is who it says it is here.

    my $descriptionLine = `curl --insecure --silent "$bugXMLURL" | grep short_desc`;

    if ($descriptionLine !~ /<short_desc>(.*)<\/short_desc>/) {

        print STDERR "  Bug $bugNumber has no bug description. Maybe you set wrong bug ID?\n";

        print STDERR "  The bug URL: $bugXMLURL\n";

        exit 1;

    }

    $bugDescription = decodeEntities($1);

    print STDERR "  Description from bug $bugNumber:\n    \"$bugDescription\".\n";

}

# Remove trailing parenthesized notes from user name (bit of hack).

$name =~ s/\(.*?\)\s*$//g;

# Find the change logs.

my %has_log;

my %files;

foreach my $file (sort keys %function_lists) {

    my $prefix = $file;

    my $has_log = 0;

    while ($prefix) {

        $prefix =~ s-/[^/]+/?$-/- or $prefix = "";

        $has_log = $has_log{$prefix};

        if (!defined $has_log) {

            $has_log = -f "${prefix}ChangeLog";

            $has_log{$prefix} = $has_log;

        }

        last if $has_log;

    }

    if (!$has_log) {

        print STDERR "No ChangeLog found for $file.\n";

    } else {

        push @{$files{$prefix}}, $file;

    }

}

# Build the list of ChangeLog prefixes in the correct project order

my @prefixes;

my %prefixesSort;

foreach my $prefix (keys %files) {

    my $prefixDir = substr($prefix, 0, length($prefix) - 1); # strip trailing /

    my $sortKey = lc $prefix;

    $sortKey = "top level" unless length $sortKey;

    if ($prefixDir eq "top level") {

        $sortKey = "";

    } elsif ($prefixDir eq "Tools") {

        $sortKey = "-, just after top level";

    } elsif ($prefixDir eq "WebBrowser") {

        $sortKey = lc "WebKit, WebBrowser after";

    } elsif ($prefixDir eq "WebCore") {

        $sortKey = lc "WebFoundation, WebCore after";

    } elsif ($prefixDir eq "LayoutTests") {

        $sortKey = lc "~, LayoutTests last";

    }

    $prefixesSort{$sortKey} = $prefix;

}

foreach my $prefixSort (sort keys %prefixesSort) {

    push @prefixes, $prefixesSort{$prefixSort};

}

# Get the latest ChangeLog files from svn.

my @logs = ();

foreach my $prefix (@prefixes) {

    push @logs, File::Spec->catfile($prefix || ".", "ChangeLog");

}

if (@logs && $updateChangeLogs && $isSVN) {

    print STDERR "  Running 'svn update' to update ChangeLog files.\n";

    open ERRORS, "-|", $SVN, "update", @logs

        or die "The svn update of ChangeLog files failed: $!.\n";

    my @conflictedChangeLogs;

    while (my $line = <ERRORS>) {

        print STDERR "    ", $line;

        push @conflictedChangeLogs, $1 if $line =~ m/^C\s+(.+?)[\r\n]*$/;

    }

    close ERRORS;

    if (@conflictedChangeLogs) {

        print STDERR "  Attempting to merge conflicted ChangeLogs.\n";

        my $resolveChangeLogsPath = File::Spec->catfile(dirname($0), "resolve-ChangeLogs");

        open RESOLVE, "-|", $resolveChangeLogsPath, "--no-warnings", @conflictedChangeLogs

            or die "Could not open resolve-ChangeLogs script: $!.\n";

        print STDERR "    $_" while <RESOLVE>;

        close RESOLVE;

    }

}

# Generate new ChangeLog entries and (optionally) write out new ChangeLog files.

foreach my $prefix (@prefixes) {

    my $endl = "\n";

    my @old_change_log;

    if ($writeChangeLogs) {

        my $changeLogPath = File::Spec->catfile($prefix || ".", "ChangeLog");

        print STDERR "  Editing the ${changeLogPath} file.\n";

        open OLD_CHANGE_LOG, ${changeLogPath} or die "Could not open ${changeLogPath} file: $!.\n";

        # It's less efficient to read the whole thing into memory than it would be

        # to read it while we prepend to it later, but I like doing this part first.

        @old_change_log = <OLD_CHANGE_LOG>;

        close OLD_CHANGE_LOG;

        # We want to match the ChangeLog's line endings in case it doesn't match

        # the native line endings for this version of perl.

        if ($old_change_log[0] =~ /(\r?\n)$/g) {

            $endl = "$1";

        }

        open CHANGE_LOG, "> ${changeLogPath}" or die "Could not write ${changeLogPath}\n.";

    } else {

        open CHANGE_LOG, ">-" or die "Could not write to STDOUT\n.";

        print substr($prefix, 0, length($prefix) - 1) . ":\n\n" unless (scalar @prefixes) == 1;

    }

    print CHANGE_LOG normalizeLineEndings("$date  $name  <$emailAddress>\n\n", $endl);

    my ($reviewer, $description) = reviewerAndDescriptionForGitCommit($gitCommit) if $gitCommit;

    $reviewer = "NOBODY (OO" . "PS!)" if !$reviewer;

    print CHANGE_LOG normalizeLineEndings("        Reviewed by $reviewer.\n\n", $endl);

    print CHANGE_LOG normalizeLineEndings($description . "\n", $endl) if $description;

    $bugDescription = "Need a short description and bug URL (OOPS!)" unless $bugDescription;

    print CHANGE_LOG normalizeLineEndings("        $bugDescription\n", $endl) if $bugDescription;

    print CHANGE_LOG normalizeLineEndings("        $bugURL\n", $endl) if $bugURL;

    print CHANGE_LOG normalizeLineEndings("\n", $endl);

    if ($prefix =~ m/WebCore/ || `pwd` =~ m/WebCore/) {

        if ($didChangeRegressionTests) {

            print CHANGE_LOG normalizeLineEndings(testListForChangeLog(sort @addedRegressionTests), $endl);

        } else {

            print CHANGE_LOG normalizeLineEndings("        No new tests. (OOPS!)\n\n", $endl);

        }

    }

    foreach my $file (sort @{$files{$prefix}}) {

        my $file_stem = substr $file, length $prefix;

        print CHANGE_LOG normalizeLineEndings("        * $file_stem:$function_lists{$file}\n", $endl);

    }

    if ($writeChangeLogs) {

        print CHANGE_LOG normalizeLineEndings("\n", $endl), @old_change_log;

    } else {

        print CHANGE_LOG "\n";

    }

    close CHANGE_LOG;

}

if ($writeChangeLogs) {

    print STDERR "-- Please remember to include a detailed description in your ChangeLog entry. --\n-- See <http://webkit.org/coding/contributing.html> for more info --\n";

}

# Write out another diff.

if ($spewDiff && @changed_files) {

    print STDERR "  Running diff to help you write the ChangeLog entries.\n";

    local $/ = undef; # local slurp mode

    open DIFF, "-|", createPatchCommand($changed_files_string) or die "The diff failed: $!.\n";

    print <DIFF>;

    close DIFF;

}

# Open ChangeLogs.

if ($openChangeLogs && @logs) {

    print STDERR "  Opening the edited ChangeLog files.\n";

    my $editor = $ENV{"CHANGE_LOG_EDIT_APPLICATION"};

    if ($editor) {

        system "open", "-a", $editor, @logs;

    } else {

        system "open", "-e", @logs;

    }

}

# Done.

exit;

sub changeLogDate($)

{

    my ($timeZone) = @_;

    my $savedTimeZone = $ENV{'TZ'};

    # Set TZ temporarily so that localtime() is in that time zone

    $ENV{'TZ'} = $timeZone;

    my $date = strftime("%Y-%m-%d", localtime());

    if (defined $savedTimeZone) {

         $ENV{'TZ'} = $savedTimeZone;

    } else {

         delete $ENV{'TZ'};

    }

    return $date;

}

sub changeLogNameFromArgs($)

{

    my ($nameFromArgs) = @_;

    # Silently allow --git-commit to win, we could warn if $nameFromArgs is defined.

    return `$GIT log --max-count=1 --pretty=\"format:%an\" \"$gitCommit\"` if $gitCommit;

    return $nameFromArgs || changeLogName();

}

sub changeLogEmailAddressFromArgs($)

{

    my ($emailAddressFromArgs) = @_;

    # Silently allow --git-commit to win, we could warn if $emailAddressFromArgs is defined.

    return `$GIT log --max-count=1 --pretty=\"format:%ae\" \"$gitCommit\"` if $gitCommit;

    return $emailAddressFromArgs || changeLogEmailAddress();

}

sub get_function_line_ranges($$)

{

    my ($file_handle, $file_name) = @_;

    if ($file_name =~ /\.(c|cpp|m|mm|h)$/) {

        return get_function_line_ranges_for_c ($file_handle, $file_name);

    } elsif ($file_name =~ /\.java$/) {

        return get_function_line_ranges_for_java ($file_handle, $file_name);

    } elsif ($file_name =~ /\.js$/) {

        return get_function_line_ranges_for_javascript ($file_handle, $file_name);

    } elsif ($file_name =~ /\.css$/) {

        return get_selector_line_ranges_for_css ($file_handle, $file_name);

    }

    return ();

}

sub method_decl_to_selector($)

{

    (my $method_decl) = @_;

    $_ = $method_decl;

    if ((my $comment_stripped) = m-([^/]*)(//|/*).*-) {

        $_ = $comment_stripped;

    }

    s/,\s*...//;

    if (/:/) {

        my @components = split /:/;

        pop @components if (scalar @components > 1);

        $_ = (join ':', map {s/.*[^[:word:]]//; scalar $_;} @components) . ':';

    } else {

        s/\s*$//;

        s/.*[^[:word:]]//;

    }

    return $_;

}

# Read a file and get all the line ranges of the things that look like C functions.

# A function name is the last word before an open parenthesis before the outer

# level open brace. A function starts at the first character after the last close

# brace or semicolon before the function name and ends at the close brace.

# Comment handling is simple-minded but will work for all but pathological cases.

#

# Result is a list of triples: [ start_line, end_line, function_name ].

sub get_function_line_ranges_for_c($$)

{

    my ($file_handle, $file_name) = @_;

    my @ranges;