#!/usr/bin/env perl

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

#

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

# Copyright (C) 2002-2021 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:

# 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 List::Util qw/max/;

use POSIX qw(strftime);

use VCSUtils;

sub actuallyGenerateFunctionLists($$$$$$);

sub attributeCommand($$$);

sub changeLogDate($);

sub changeLogEmailAddressFromArgs($$);

sub changeLogNameFromArgs($$);

sub computeModifiedFunctions($$$);

sub createPatchCommand($$$$);

sub decodeEntities($);

sub determinePropertyChanges($$$);

sub diffCommand($$$$);

sub diffFromToString($$$);

sub extractLineRangeAfterChange($);

sub extractLineRangeBeforeChange($);

sub fetchBugXMLData($$);

sub fetchBugDescriptionFromBugXMLData($$$);

sub fetchRadarURLFromBugXMLData($$);

sub findChangeLogs($$);

sub findOriginalFileFromSvn($);

sub generateFileList(\%$$$\%);

sub generateFunctionLists($$$$$);

sub generateNewChangeLogs($$$$$$$$$$$$$$$);

sub getLatestChangeLogs($);

sub get_function_line_ranges($$);

sub get_function_line_ranges_for_cpp($$);

sub delete_namespaces_from_ranges_for_cpp(\@\@);

sub is_function_in_namespace($$);

sub get_function_line_ranges_for_java($$);

sub get_function_line_ranges_for_javascript($$);

sub get_function_line_ranges_for_perl($$);

sub get_selector_line_ranges_for_css($$);

sub get_function_line_ranges_for_swift($$);

sub parseSwiftFunctionArgs($);

sub isAddedStatus($);

sub isConflictStatus($$$);

sub isModifiedStatus($);

sub isUnmodifiedStatus($);

sub main();

sub method_decl_to_selector($);

sub normalizeLineEndings($$);

sub openChangeLogs($);

sub originalFile($$$$);

sub pluralizeAndList($$@);

sub printDiff($$$$);

sub processPaths(\@);

sub propertyChangeDescription($);

sub resolveChangeLogsPath($@);

sub resolveConflictedChangeLogs($);

sub reviewerAndDescriptionForGitCommit($$);

sub statusCommand($$$$);

sub statusDescription($$$$);

sub svnUpdateCommand(@);

sub testListForChangeLog(@);

### Constant variables.

# Project time zone for Cupertino, CA, US

use constant ChangeLogTimeZone => "PST8PDT";

use constant SVN => "svn";

use constant GIT => "git";

use constant SupportedTestExtensions => {map { $_ => 1 } qw(html shtml svg xml xhtml pl php)};

exit(main());

sub main()

{

my %attributeCache;

my $bugDescription;

my $bugRadarURL;

my $bugNumber;

my $name;

my $emailAddress;

my $mergeBase = 0;

my $gitCommit = 0;

my $gitIndex = "";

my $gitReviewer = "";

my $checkWebKitStyle = 0;

my $openChangeLogs = 0;

my $writeChangeLogs = 1;

my $delimiters = 0;

my $showHelp = 0;

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

my $updateChangeLogs = 1;

my $onlyFiles = 0;

my $parseOptionsResult =

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

"bug|b:i" => \$bugNumber,

"delimiters" => \$delimiters,

"description:s" => \$bugDescription,

"name:s" => \$name,

"email:s" => \$emailAddress,

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

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

"git-index" => \$gitIndex,

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

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

"style!" => \$checkWebKitStyle,

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

"write!" => \$writeChangeLogs,

"update!" => \$updateChangeLogs,

"only-files" => \$onlyFiles);

if (!$parseOptionsResult || $showHelp) {

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

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

print STDERR " --description One-line description that matches the bug title.\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 " -g|--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 " --[no-]style Run check-webkit-style script when done (default: no-style)\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";

print STDERR " --delimiters When writing to stdout, label and print a \"~\" after each entry\n";

print STDERR " --email= Specify the email address to be used in the patch\n";

print STDERR " --only-files Exclude the standard changelog header and only include references to files.\n";

return 1;

}

if ($checkWebKitStyle) {

print STDERR " Running check-webkit-style.\n ";

system "$FindBin::Bin/check-webkit-style";

}

die "--git-commit and --git-index are incompatible when not used with --only-files." if ($gitIndex && $gitCommit && !$onlyFiles);

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

my %paths = processPaths(@ARGV);

# Find the list of modified files

my ($changedFiles, $conflictFiles, $functionLists, $addedRegressionTests, $requiresTests) = generateFileList(%paths, $gitCommit, $gitIndex, $mergeBase, %attributeCache);

if (!@$changedFiles && !@$conflictFiles && !keys %$functionLists) {

print STDERR " No changes found.\n";

return 1;

}

if (@$conflictFiles) {

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

print STDERR join("\n", @$conflictFiles), "\n";

return 1;

}

generateFunctionLists($changedFiles, $functionLists, $gitCommit, $gitIndex, $mergeBase);

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

$name = changeLogNameFromArgs($name, $gitCommit);

$emailAddress = changeLogEmailAddressFromArgs($emailAddress, $gitCommit);

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

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

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

my $bugURL;

if ($bugNumber) {

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

}

if ($bugNumber && !$bugDescription) {

my $bugXMLData = fetchBugXMLData($bugURL, $bugNumber);

$bugDescription = fetchBugDescriptionFromBugXMLData($bugURL, $bugNumber, $bugXMLData);

$bugRadarURL = fetchRadarURLFromBugXMLData($bugNumber, $bugXMLData);

}

my ($filesInChangeLog, $prefixes) = findChangeLogs($functionLists, $writeChangeLogs);

# Get the latest ChangeLog files from svn.

my $changeLogs = getLatestChangeLogs($prefixes);

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

resolveConflictedChangeLogs($changeLogs);

}

generateNewChangeLogs($prefixes, $filesInChangeLog, $addedRegressionTests, $requiresTests, $functionLists, $bugURL, $bugDescription, $bugRadarURL, $name, $emailAddress, $gitReviewer, $gitCommit, $writeChangeLogs, $delimiters, $onlyFiles);

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 && @$changedFiles) {

printDiff($changedFiles, $gitCommit, $gitIndex, $mergeBase);

}

# Open ChangeLogs.

if ($openChangeLogs && @$changeLogs) {

openChangeLogs($changeLogs);

}

return 0;

}

sub originalFile($$$$)

{

my ($file, $gitCommit, $gitIndex, $mergeBase) = @_;

my $command;

if (isSVN()) {

my $escapedPathsString = escapeSubversionPath($file);

$command = SVN . " cat $escapedPathsString";

} elsif (isGit()) {

$command = GIT . " show ";

if ($mergeBase) {

$command .= "$mergeBase";

} else {

$command .= "HEAD";

}

$command .= ":'$file'";

}

return $command;

}

sub generateFunctionLists($$$$$)

{

my ($changedFiles, $functionLists, $gitCommit, $gitIndex, $mergeBase) = @_;

my %delegateHash = (

openDiff => sub ($$$$) {

my ($changedFiles, $gitCommit, $gitIndex, $mergeBase) = @_;

return unless open(DIFF, "-|", diffCommand($changedFiles, $gitCommit, $gitIndex, $mergeBase));

return \*DIFF;

},

openFile => sub ($) {

my ($file) = @_;

return unless open(SOURCE, "<", $file);

return \*SOURCE;

},

openOriginalFile => sub ($) {

my ($file, $gitCommit, $gitIndex, $mergeBase) = @_;

return unless open(SOURCE, "-|", originalFile($file, $gitCommit, $gitIndex, $mergeBase));

return \*SOURCE;

},

normalizePath => sub ($) {

my ($path) = @_;

return normalizePath(makeFilePathRelative($path));

},

);

actuallyGenerateFunctionLists($changedFiles, $functionLists, $gitCommit, $gitIndex, $mergeBase, \%delegateHash);

}

sub actuallyGenerateFunctionLists($$$$$$)

{

my ($changedFiles, $functionLists, $gitCommit, $gitIndex, $mergeBase, $delegateHashRef) = @_;

my %line_ranges_after_changed;

my %line_ranges_before_changed;

if (@$changedFiles) {

# 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;

my $diffFileHandle = $delegateHashRef->{openDiff}($changedFiles, $gitCommit, $gitIndex, $mergeBase);

if (!$diffFileHandle) {

die "The diff failed: $!.\n";

}

while (<$diffFileHandle>) {

my $filePath = parseDiffStartLine($_);

$file = $delegateHashRef->{normalizePath}($filePath) if $filePath;

if (defined $file) {

my ($before_start, $before_end) = extractLineRangeBeforeChange($_);

if ($before_start >= 1 && $before_end >= 1) {

push @{$line_ranges_before_changed{$file}}, [ $before_start, $before_end ];

} elsif (/DO_NOT_COMMIT/) {

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

}

my ($after_start, $after_end) = extractLineRangeAfterChange($_);

if ($after_start >= 1 && $after_end >= 1) {

push @{$line_ranges_after_changed{$file}}, [ $after_start, $after_end ];

} elsif (/DO_NOT_COMMIT/) {

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

}

}

}

close($diffFileHandle);

}

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

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

my %filesToExamine = map { $_ => 1 } (keys(%line_ranges_before_changed), keys(%line_ranges_after_changed));

foreach my $file (keys %filesToExamine) {

my %saw_function;

# Find all the functions in the file.

my $sourceFileHandle = $delegateHashRef->{openFile}($file);

next unless $sourceFileHandle;

my @afterChangeFunctionRanges = get_function_line_ranges($sourceFileHandle, $file);

close($sourceFileHandle);

# Find modified functions in the file.

if ($line_ranges_after_changed{$file}) {

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

my @functions = computeModifiedFunctions($file, \@change_ranges, \@afterChangeFunctionRanges);

# Format the list of functions.

if (@functions) {

$functionLists->{$file} = "" if !defined $functionLists->{$file};

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

}

}

# Find the deleted functions in the original file.

if ($line_ranges_before_changed{$file}) {

my $originalFileHandle = $delegateHashRef->{openOriginalFile}($file, $gitCommit, $gitIndex, $mergeBase);

next unless $originalFileHandle;

my @beforeChangeFunctionRanges = get_function_line_ranges($originalFileHandle, $file);

close($originalFileHandle);

my %existsAfterChange = map { $_->[2] => 1 } @afterChangeFunctionRanges;

my @functions;

my %sawFunctions;

for my $functionRange (@beforeChangeFunctionRanges) {

my $functionName = $functionRange->[2];

if (!$existsAfterChange{$functionName} && !$sawFunctions{$functionName}) {

push @functions, $functionName;

$sawFunctions{$functionName} = 1;

}

}

# Format the list of deleted functions.

if (@functions) {

$functionLists->{$file} = "" if !defined $functionLists->{$file};

$functionLists->{$file} .= "\n (" . join("): Deleted.\n (", @functions) . "): Deleted.";

}

}

}

}

sub computeModifiedFunctions($$$)

{

my ($file, $changedLineRanges, $functionRanges) = @_;

my %sawFunction;

# Find all the modified functions.

my @functions;

my @change_ranges = @{$changedLineRanges};

my @change_range = (0, 0);

FUNCTION: foreach my $function_range_ref (@{$functionRanges}) {

my @function_range = @{$function_range_ref};

# FIXME: This is a hack. If the function name is empty, skip it.

# The cpp, python, javascript, perl, css and java parsers

# are not perfectly implemented and sometimes function names cannot be retrieved

# correctly. As you can see in get_function_line_ranges_XXXX(), those parsers

# are not intended to implement real parsers but intended to just retrieve function names

# for most practical syntaxes.

next unless $function_range[2];

# 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 (!$sawFunction{$function_range[2]}) {

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

push @functions, $function_range[2];

}

next FUNCTION;

}

}

}

return @functions;

}

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, $gitCommit) = @_;

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

my $command = GIT . ' log --max-count=1 --pretty="format:%an" "' . $gitCommit . '"';

return `$command` if $gitCommit;

return $nameFromArgs || changeLogName();

}

sub changeLogEmailAddressFromArgs($$)

{

my ($emailAddressFromArgs, $gitCommit) = @_;

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

my $command = GIT . ' log --max-count=1 --pretty="format:%ae" "' . $gitCommit . '"';

return `$command` if $gitCommit;

return $emailAddressFromArgs || changeLogEmailAddress();

}

sub fetchBugXMLData($$)

{

my ($bugURL, $bugNumber) = @_;

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

# 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 $xmlData = `curl --insecure --silent "$bugXMLURL"`;

if ($xmlData !~ /<\?xml/) {

# Maybe the reason the above did not work is because the curl that is installed doesn't

# support ssl at all.

if (`curl --version | grep ^Protocols` !~ /\bhttps\b/) {

print STDERR " Could not get description for bug $bugNumber.\n";

print STDERR " It looks like your version of curl does not support ssl.\n";

print STDERR " If you are using macports, this can be fixed with sudo port install curl +ssl.\n";

}

exit 1;

}

return $xmlData;

}

sub fetchBugDescriptionFromBugXMLData($$$)

{

my ($bugURL, $bugNumber, $bugXMLData) = @_;

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

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

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

exit 1;

}

my $bugDescription = decodeEntities($1);

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

return $bugDescription;

}

sub fetchRadarURLFromBugXMLData($$)

{

my ($bugNumber, $bugXMLData) = @_;

return "" if $bugXMLData !~ m|<thetext>\s*((&lt;)?rdar://(problem/)?\d+(&gt;)?)|;

my $bugRadarURL = decodeEntities($1);

print STDERR " Radar URL from bug $bugNumber:\n \"$bugRadarURL\".\n";

return $bugRadarURL;

}

sub findChangeLogs($$)

{

my ($functionLists, $requireChangeLogToExist) = @_;

# Find the change logs.

my %has_log;

my %filesInChangeLog;

foreach my $file (sort keys %$functionLists) {

my $prefix = $file;

my $has_log = 0;

while ($prefix) {

if ($^O eq "MSWin32") {

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

} else {

$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 && $requireChangeLogToExist) {

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

} else {

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

}

}

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

my @prefixes;

my %prefixesSort;

foreach my $prefix (keys %filesInChangeLog) {

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 "Source/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};

}

return (\%filesInChangeLog, \@prefixes);

}

sub getLatestChangeLogs($)

{

my ($prefixes) = @_;

my @changeLogs = ();

foreach my $prefix (@$prefixes) {

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

}

return \@changeLogs;

}

sub svnUpdateCommand(@)

{

my @changeLogs = shift;

my @escapedChangeLogPaths = map(escapeSubversionPath($_), @changeLogs);

my $escapedChangeLogPathsString = qq(") . join(qq(" "), @escapedChangeLogPaths) . qq(");

my $command = SVN . " update $escapedChangeLogPathsString";

return $command;

}

sub resolveChangeLogsPath($@)

{

my ($resolveChangeLogsPath, @conflictedChangeLogs) = @_;

my @escapedConflictedChangeLogs = map(escapeSubversionPath($_), @conflictedChangeLogs);

my $escapedConflictedChangeLogsString = qq(") . join(qq(" "), @escapedConflictedChangeLogs) . qq(");

my $command = "$resolveChangeLogsPath --no-warnings $escapedConflictedChangeLogsString";

return $command;

}

sub resolveConflictedChangeLogs($)

{

my ($changeLogs) = @_;

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

open ERRORS, "-|", svnUpdateCommand(@$changeLogs)

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;

return if !@conflictedChangeLogs;

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

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

open RESOLVE, "-|", resolveChangeLogsPath($resolveChangeLogsPath, @conflictedChangeLogs)

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

print STDERR " $_" while <RESOLVE>;

close RESOLVE;

}

sub generateNewChangeLogs($$$$$$$$$$$$$$$)

{

my ($prefixes, $filesInChangeLog, $addedRegressionTests, $requiresTests, $functionLists, $bugURL, $bugDescription, $bugRadarURL, $name, $emailAddress, $gitReviewer, $gitCommit, $writeChangeLogs, $delimiters, $onlyFiles) = @_;

my $hasWebCoreChange = 0;

foreach my $prefix (@$prefixes) {

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

$hasWebCoreChange = 1;

}

}

# 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.";

binmode(CHANGE_LOG);

} 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 && !$delimiters;

}

if (!$onlyFiles) {

my $date = changeLogDate(ChangeLogTimeZone);

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

}

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

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

($bugDescription, $description) =

($description =~ /^(?:\s*(.*)\n)?(?:\s*\n)*((?:\n|.)*)/)

if !$bugDescription && $description;

$bugDescription = "Need a short description (OOPS!)." unless $bugDescription;

$bugURL = "Need the bug URL (OOPS!)." unless $bugURL;

if (!$onlyFiles) {

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

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

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

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

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

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

}

my $shouldMentionTests = @$requiresTests;

$shouldMentionTests |= !$hasWebCoreChange && unixPath($prefix) =~ m|/WebKit/$|;

$shouldMentionTests |= unixPath($prefix) =~ m|/WebCore/$|;

if ($shouldMentionTests) {

if (@$addedRegressionTests) {

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

} else {

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

}

}

foreach my $file (sort @{$filesInChangeLog->{$prefix}}) {

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

$file_stem = unixPath($file_stem);

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

}

if ($writeChangeLogs) {

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

} else {

print CHANGE_LOG "\n";

print "~\n" if $delimiters;

}

close CHANGE_LOG;

}

}

sub printDiff($$$$)

{

my ($changedFiles, $gitCommit, $gitIndex, $mergeBase) = @_;

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

local $/ = undef; # local slurp mode

my $changedFilesString = "'" . join("' '", @$changedFiles) . "'";

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

print <DIFF>;

close DIFF;

}

sub openChangeLogs($)

{

my ($changeLogs) = @_;

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

my $editor = $ENV{CHANGE_LOG_EDITOR} || $ENV{VISUAL} || $ENV{EDITOR};

if ($editor) {

system ((split ' ', $editor), @$changeLogs);

} else {

$editor = $ENV{CHANGE_LOG_EDIT_APPLICATION};

if ($editor) {

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

} else {

system "open", "-e", @$changeLogs;

}

}

}

sub get_function_line_ranges($$)

{

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

# Try to determine the source language based on the file extension.

return get_function_line_ranges_for_cpp($file_handle, $file_name) if $file_name =~ /\.(c|cpp|m|mm|h)$/;

return get_function_line_ranges_for_java($file_handle, $file_name) if $file_name =~ /\.java$/;

return get_function_line_ranges_for_javascript($file_handle, $file_name) if $file_name =~ /\.js$/;

return get_selector_line_ranges_for_css($file_handle, $file_name) if $file_name =~ /\.css$/;

return get_function_line_ranges_for_perl($file_handle, $file_name) if $file_name =~ /\.p[lm]$/;

return get_function_line_ranges_for_python($file_handle, $file_name) if $file_name =~ /\.py$/ or $file_name =~ /master\.cfg$/;

return get_function_line_ranges_for_swift($file_handle, $file_name) if $file_name =~ /\.swift$/;

# Try to determine the source language based on the script interpreter.

my $first_line = <$file_handle>;

seek($file_handle, 0, 0);

return () unless $first_line =~ m|^#!(?:/usr/bin/env\s+)?(\S+)|;

my $interpreter = $1;

return get_function_line_ranges_for_perl($file_handle, $file_name) if $interpreter =~ /perl$/;

return get_function_line_ranges_for_python($file_handle, $file_name) if $interpreter =~ /python$/;

return ();

}

sub method_decl_to_selector($)

{

(my $method_decl) = @_;

$_ = $method_decl;

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

$_ = $comment_stripped;

}

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

# Strip out the return type and parameter types. The extra )? takes care of most block parameter types.

s/\([^\)]*\)\)?//g;

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_cpp($$)

{

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

my @ranges;

my $in_comment = 0;

my $in_macro = 0;

my $in_method_declaration = 0;

my $in_parentheses = 0;

my $quotation_mark;

my $in_braces = 0;

my $in_toplevel_array_brace = 0;

my $brace_start = 0;

my $brace_end = 0;

my $namespace_start = -1;

my $skip_til_brace_or_semicolon = 0;

my $equal_observed = 0;

my $word = "";

my $interface_name = "";

my $potential_method_char = "";

my $potential_method_spec = "";

my $potential_start = 0;

my $potential_name = "";

my $start = 0;

my $name = "";

my $next_word_could_be_namespace = 0;

my $potential_namespace = "";

my @namespaces;

my @all_namespaces;

while (<$file_handle>) {

# Handle continued quoted string.

if ($quotation_mark) {

if (!s-([^\\]|\\.)*$quotation_mark--) {

if (!m-\\$-) {

warn "mismatched quotes at line $. in $file_name\n";

undef $quotation_mark;

}

next;

}

undef $quotation_mark;

}

# Handle continued multi-line comment.

if ($in_comment) {

next unless s-.*\*/--;

$in_comment = 0;

}

# Handle continued macro.

if ($in_macro) {

$in_macro = 0 unless /\\$/;

next;

}

# Handle start of macro (or any preprocessor directive).

if (/^\s*\#/) {

$in_macro = 1 if /^([^\\]|\\.)*\\$/;

next;

}

# Handle comments and quoted text.

while (m-(/\*|//|\'|\")-) { # \' and \" keep emacs perl mode happy

my $match = $1;

if ($match eq "/*") {

if (!s-/\*.*?\*/--) {

s-/\*.*--;

$in_comment = 1;

}

} elsif ($match eq "//") {

s-//.*--;

} else { # ' or "

if (!s-$match([^\\]|\\.)*?$match--) {

if (!s-$match.*\\$--) {

warn "mismatched quotes at line $. in $file_name\n";

s-$match.*--;

} else {

$quotation_mark = $match;

}

}

}

}

# continued method declaration

if ($in_method_declaration) {

my $original = $_;

my $method_cont = $_;

chomp $method_cont;

$method_cont =~ s/[;\{].*//;

$potential_method_spec = "${potential_method_spec} ${method_cont}";

$_ = $original;

if (/;/) {

$potential_start = 0;

$potential_method_spec = "";

$potential_method_char = "";

$in_method_declaration = 0;

s/^[^;\{]*//;

} elsif (/{/) {

my $selector = method_decl_to_selector ($potential_method_spec);

$potential_name = "${potential_method_char}\[${interface_name} ${selector}\]";

$potential_method_spec = "";

$potential_method_char = "";

$in_method_declaration = 0;

$_ = $original;

s/^[^;{]*//;

} elsif (/\@end/) {

$in_method_declaration = 0;

$interface_name = "";

$_ = $original;

} else {

next;

}

}

# start of method declaration

if ((my $method_char, my $method_spec) = m&^([-+])([^0-9;][^;]*);?$&) {

my $original = $_;

if ($interface_name) {

chomp $method_spec;

$method_spec =~ s/\{.*//;

$potential_method_char = $method_char;

$potential_method_spec = $method_spec;

$potential_start = $.;

$in_method_declaration = 1;

} else {

warn "declaring a method but don't have interface on line $. in $file_name\n";

}

$_ = $original;

if (/\{/) {

my $selector = method_decl_to_selector ($potential_method_spec);

$potential_name = "${potential_method_char}\[${interface_name} ${selector}\]";

$potential_method_spec = "";

$potential_method_char = "";

$in_method_declaration = 0;

$_ = $original;

s/^[^{]*//;

} elsif (/\@end/) {

$in_method_declaration = 0;

$interface_name = "";

$_ = $original;

} else {

next;

}

}

# Find function, interface and method names.

while (m&((?:[[:word:]]+::)*operator(?:[ \t]*\(\)|[^()]*)|[[:word:]<>:~]+|[(){}:;=])|\@(?:implementation|interface|protocol)\s+(\w+)[^{]*&g) {

# Skip an array definition at the top level.

# e.g. static int arr[] = { 1, 2, 3 };

if ($1) {

if ($1 eq "=" and !$in_parentheses and !$in_braces) {

$equal_observed = 1;

} elsif ($1 eq "{" and $equal_observed) {

# This '{' is the beginning of an array definition, not the beginning of a method.

$in_toplevel_array_brace = 1;

$in_braces++;

$equal_observed = 0;

next;

} elsif ($1 !~ /[ \t]/) {

$equal_observed = 0;

}

}