2572 lines
87 KiB
Perl
Executable File
2572 lines
87 KiB
Perl
Executable File
#!/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 $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);
|
|
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";
|
|
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." if ($gitIndex && $gitCommit);
|
|
|
|
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);
|
|
|
|
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*((<)?rdar://(problem/)?\d+(>)?)|;
|
|
|
|
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) = @_;
|
|
|
|
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;
|
|
}
|
|
|
|
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;
|
|
|
|
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;
|
|
}
|
|
}
|
|
|
|
# interface name
|
|
if ($2) {
|
|
$interface_name = $2;
|
|
next;
|
|
}
|
|
|
|
# Open parenthesis.
|
|
if ($1 eq "(") {
|
|
$potential_name = $word unless $in_parentheses || $skip_til_brace_or_semicolon || grep { $word eq $_ } ("CF_ENUM", "CF_OPTIONS", "NS_ENUM", "NS_OPTIONS");
|
|
$in_parentheses++;
|
|
next;
|
|
}
|
|
|
|
# Close parenthesis.
|
|
if ($1 eq ")") {
|
|
$in_parentheses--;
|
|
next;
|
|
}
|
|
|
|
if ($1 eq "const" and !$in_parentheses) {
|
|
$potential_name .= " const";
|
|
next;
|
|
}
|
|
|
|
if ($1 eq "volatile" and !$in_parentheses) {
|
|
$potential_name .= " volatile";
|
|
next;
|
|
}
|
|
|
|
# C++ auto function() -> type
|
|
if ($1 eq ">") {
|
|
$skip_til_brace_or_semicolon = 1 unless ($in_parentheses || $in_braces);
|
|
next;
|
|
}
|
|
|
|
# C++ constructor initializers
|
|
if ($1 eq ":") {
|
|
$skip_til_brace_or_semicolon = 1 unless ($in_parentheses || $in_braces);
|
|
}
|
|
|
|
# Open brace.
|
|
if ($1 eq "{") {
|
|
$skip_til_brace_or_semicolon = 0;
|
|
|
|
if (!$in_braces) {
|
|
if ($namespace_start >= 0 and $namespace_start < $potential_start) {
|
|
push @ranges, [ $namespace_start . "", $potential_start - 1, $name ];
|
|
}
|
|
|
|
if ($potential_namespace) {
|
|
push @namespaces, $potential_namespace;
|
|
push @all_namespaces, $potential_namespace;
|
|
$potential_namespace = "";
|
|
$name = $namespaces[-1];
|
|
$namespace_start = $. + 1;
|
|
next;
|
|
}
|
|
|
|
# Promote potential name to real function name at the
|
|
# start of the outer level set of braces (function body?).
|
|
if ($potential_start) {
|
|
$start = $potential_start;
|
|
$name = $potential_name;
|
|
if (@namespaces && $name && (length($name) < 2 || substr($name,1,1) ne "[")) {
|
|
$name = join ('::', @namespaces, $name);
|
|
}
|
|
}
|
|
}
|
|
|
|
$in_method_declaration = 0;
|
|
|
|
$brace_start = $. if (!$in_braces);
|
|
$in_braces++;
|
|
next;
|
|
}
|
|
|
|
# Close brace.
|
|
if ($1 eq "}") {
|
|
if (!$in_braces && @namespaces) {
|
|
if ($namespace_start >= 0 and $namespace_start < $.) {
|
|
push @ranges, [ $namespace_start . "", $. - 1, $name ];
|
|
}
|
|
|
|
pop @namespaces;
|
|
if (@namespaces) {
|
|
$name = $namespaces[-1];
|
|
$namespace_start = $. + 1;
|
|
} else {
|
|
$name = "";
|
|
$namespace_start = -1;
|
|
}
|
|
next;
|
|
}
|
|
|
|
$in_braces--;
|
|
$brace_end = $. if (!$in_braces);
|
|
|
|
# End of an outer level set of braces.
|
|
# This could be a function body.
|
|
if (!$in_braces and $name) {
|
|
# This is the end of an array definition at the top level, not the end of a method.
|
|
if ($in_toplevel_array_brace) {
|
|
$in_toplevel_array_brace = 0;
|
|
next;
|
|
}
|
|
|
|
push @ranges, [ $start, $., $name ];
|
|
if (@namespaces) {
|
|
$name = $namespaces[-1];
|
|
$namespace_start = $. + 1;
|
|
} else {
|
|
$name = "";
|
|
$namespace_start = -1;
|
|
}
|
|
}
|
|
|
|
$potential_start = 0;
|
|
$potential_name = "";
|
|
next;
|
|
}
|
|
|
|
# Semicolon.
|
|
if ($1 eq ";") {
|
|
$skip_til_brace_or_semicolon = 0;
|
|
$potential_start = 0;
|
|
$potential_name = "";
|
|
$in_method_declaration = 0;
|
|
next;
|
|
}
|
|
|
|
# Ignore "const" method qualifier.
|
|
if ($1 eq "const") {
|
|
next;
|
|
}
|
|
|
|
if ($1 eq "namespace" || $1 eq "class" || $1 eq "struct") {
|
|
$next_word_could_be_namespace = 1;
|
|
next;
|
|
}
|
|
|
|
# Word.
|
|
$word = $1;
|
|
if (!$skip_til_brace_or_semicolon) {
|
|
if ($next_word_could_be_namespace) {
|
|
$potential_namespace = $word;
|
|
$next_word_could_be_namespace = 0;
|
|
} elsif ($potential_namespace) {
|
|
$potential_namespace = "";
|
|
}
|
|
|
|
if (!$in_parentheses) {
|
|
$potential_start = 0;
|
|
$potential_name = "";
|
|
}
|
|
if (!$potential_start) {
|
|
$potential_start = $.;
|
|
$potential_name = "";
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
warn "missing close braces in $file_name (probable start at $brace_start)\n" if ($in_braces > 0);
|
|
warn "too many close braces in $file_name (probable start at $brace_end)\n" if ($in_braces < 0);
|
|
|
|
warn "mismatched parentheses in $file_name\n" if $in_parentheses;
|
|
|
|
return delete_namespaces_from_ranges_for_cpp(@ranges, @all_namespaces);
|
|
}
|
|
|
|
|
|
# Take in references to an array of line ranges for C functions in a given file
|
|
# and an array of namespaces declared in that file and return an updated
|
|
# list of line ranges with the namespaces removed.
|
|
|
|
sub delete_namespaces_from_ranges_for_cpp(\@\@)
|
|
{
|
|
my ($ranges, $namespaces) = @_;
|
|
return grep {!is_function_in_namespace($namespaces, $$_[2])} @$ranges;
|
|
}
|
|
|
|
|
|
sub is_function_in_namespace($$)
|
|
{
|
|
my ($namespaces, $function_name) = @_;
|
|
return grep {$_ eq $function_name} @$namespaces;
|
|
}
|
|
|
|
|
|
# Read a file and get all the line ranges of the things that look like Java
|
|
# classes, interfaces and methods.
|
|
#
|
|
# A class or interface name is the word that immediately follows
|
|
# `class' or `interface' when followed by an open curly brace and not
|
|
# a semicolon. It can appear at the top level, or inside another class
|
|
# or interface block, but not inside a function block
|
|
#
|
|
# A class or interface starts at the first character after the first close
|
|
# brace or after the function name and ends at the close brace.
|
|
#
|
|
# A function name is the last word before an open parenthesis before
|
|
# an open brace rather than a semicolon. It can appear at top level or
|
|
# inside a class or interface block, but not inside a function block.
|
|
#
|
|
# A function starts at the first character after the first close
|
|
# brace or after 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_java($$)
|
|
{
|
|
my ($file_handle, $file_name) = @_;
|
|
|
|
my @current_scopes;
|
|
|
|
my @ranges;
|
|
|
|
my $in_comment = 0;
|
|
my $in_macro = 0;
|
|
my $in_parentheses = 0;
|
|
my $in_braces = 0;
|
|
my $in_non_block_braces = 0;
|
|
my $class_or_interface_just_seen = 0;
|
|
my $in_class_declaration = 0;
|
|
|
|
my $word = "";
|
|
|
|
my $potential_start = 0;
|
|
my $potential_name = "";
|
|
my $potential_name_is_class_or_interface = 0;
|
|
|
|
my $start = 0;
|
|
my $name = "";
|
|
my $current_name_is_class_or_interface = 0;
|
|
|
|
while (<$file_handle>) {
|
|
# 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--) {
|
|
warn "mismatched quotes at line $. in $file_name\n";
|
|
s-$match.*--;
|
|
}
|
|
}
|
|
}
|
|
|
|
# Find function names.
|
|
while (m-(\w+|[(){};])-g) {
|
|
# Open parenthesis.
|
|
if ($1 eq "(") {
|
|
if (!$in_parentheses) {
|
|
$potential_name = $word;
|
|
$potential_name_is_class_or_interface = 0;
|
|
}
|
|
$in_parentheses++;
|
|
next;
|
|
}
|
|
|
|
# Close parenthesis.
|
|
if ($1 eq ")") {
|
|
$in_parentheses--;
|
|
next;
|
|
}
|
|
|
|
# Open brace.
|
|
if ($1 eq "{") {
|
|
$in_class_declaration = 0;
|
|
|
|
# Promote potential name to real function name at the
|
|
# start of the outer level set of braces (function/class/interface body?).
|
|
if (!$in_non_block_braces
|
|
and (!$in_braces or $current_name_is_class_or_interface)
|
|
and $potential_start) {
|
|
if ($name) {
|
|
push @ranges, [ $start, ($. - 1),
|
|
join ('.', @current_scopes) ];
|
|
}
|
|
|
|
|
|
$current_name_is_class_or_interface = $potential_name_is_class_or_interface;
|
|
|
|
$start = $potential_start;
|
|
$name = $potential_name;
|
|
|
|
push (@current_scopes, $name);
|
|
} else {
|
|
$in_non_block_braces++;
|
|
}
|
|
|
|
$potential_name = "";
|
|
$potential_start = 0;
|
|
|
|
$in_braces++;
|
|
next;
|
|
}
|
|
|
|
# Close brace.
|
|
if ($1 eq "}") {
|
|
$in_braces--;
|
|
|
|
# End of an outer level set of braces.
|
|
# This could be a function body.
|
|
if (!$in_non_block_braces) {
|
|
if ($name) {
|
|
push @ranges, [ $start, $.,
|
|
join ('.', @current_scopes) ];
|
|
|
|
pop (@current_scopes);
|
|
|
|
if (@current_scopes) {
|
|
$current_name_is_class_or_interface = 1;
|
|
|
|
$start = $. + 1;
|
|
$name = $current_scopes[$#current_scopes-1];
|
|
} else {
|
|
$current_name_is_class_or_interface = 0;
|
|
$start = 0;
|
|
$name = "";
|
|
}
|
|
}
|
|
} else {
|
|
$in_non_block_braces-- if $in_non_block_braces;
|
|
}
|
|
|
|
$potential_start = 0;
|
|
$potential_name = "";
|
|
next;
|
|
}
|
|
|
|
# Semicolon.
|
|
if ($1 eq ";") {
|
|
$potential_start = 0;
|
|
$potential_name = "";
|
|
next;
|
|
}
|
|
|
|
if ($1 eq "class") {
|
|
$in_class_declaration = 1;
|
|
}
|
|
if ($1 eq "class" or (!$in_class_declaration and $1 eq "interface")) {
|
|
$class_or_interface_just_seen = 1;
|
|
next;
|
|
}
|
|
|
|
# Word.
|
|
$word = $1;
|
|
if (!$in_parentheses) {
|
|
if ($class_or_interface_just_seen) {
|
|
$potential_name = $word;
|
|
$potential_start = $.;
|
|
$class_or_interface_just_seen = 0;
|
|
$potential_name_is_class_or_interface = 1;
|
|
next;
|
|
}
|
|
}
|
|
if (!$potential_start) {
|
|
$potential_start = $.;
|
|
$potential_name = "";
|
|
}
|
|
$class_or_interface_just_seen = 0;
|
|
}
|
|
}
|
|
|
|
warn "mismatched braces in $file_name\n" if $in_braces;
|
|
warn "mismatched parentheses in $file_name\n" if $in_parentheses;
|
|
|
|
return @ranges;
|
|
}
|
|
|
|
|
|
|
|
# Read a file and get all the line ranges of the things that look like
|
|
# JavaScript functions or methods.
|
|
#
|
|
# A function name is the word that immediately follows `function' when
|
|
# followed by an open curly brace. It can appear at the top level,
|
|
# or inside other functions. For example:
|
|
#
|
|
# function name() { // (name)
|
|
# function inner() { } // (name.inner)
|
|
# }
|
|
#
|
|
# An anonymous function name is the identifier on the left hand side of
|
|
# an assignment with the equals operator or object notation that has a
|
|
# value starting with `function' followed an open curly brace.
|
|
# For example:
|
|
#
|
|
# namespace = {
|
|
# name: function() {} // (namespace.name)
|
|
# }
|
|
# namespace.Foo = function() {} // (namespace.Foo)
|
|
#
|
|
# A getter or setter name is the word that immediately follows `get' or
|
|
# `set' when followed by params and an open curly brace. For example:
|
|
#
|
|
# namespace = {
|
|
# get foo() {} // (namespace.get foo)
|
|
# }
|
|
#
|
|
# A method name is the word immediately before parenthesis, with an open
|
|
# curly brace immediately following closing parenthesis. For a class expression
|
|
# we take the assignment identifier instead of the class name for namespacing.
|
|
#
|
|
# namespace.Foo = class DoesNotMatter extends Bar {
|
|
# constructor() {} // (namespace.Foo)
|
|
# static staticMethod() {} // (namespace.Foo.staticMethod)
|
|
# instanceMethod() {} // (namespace.Foo.prototype.instanceMethod)
|
|
# get getter() {} // (namespace.Foo.prototype.get getter)
|
|
# }
|
|
# class ClassName {
|
|
# constructor() {} // (ClassName)
|
|
# method() {} // (ClassName.prototype.method)
|
|
# }
|
|
#
|
|
# Methods may exist in object literals, outside of classes.
|
|
#
|
|
# Foo.prototype = {
|
|
# method() {}, // (Foo.prototype.method)
|
|
# otherMethod() {} // (Foo.prototype.otherMethod)
|
|
# }
|
|
#
|
|
# 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_javascript($$)
|
|
{
|
|
my ($fileHandle, $fileName) = @_;
|
|
|
|
my @currentScopes;
|
|
my @currentIdentifiers;
|
|
my @currentParsingMode = ("global");
|
|
my @currentFunctionNames;
|
|
my @currentFunctionDepths;
|
|
my @currentFunctionStartLines;
|
|
|
|
my @ranges;
|
|
|
|
my $inComment = 0;
|
|
my $inQuotedText = "";
|
|
my $inExtends = 0;
|
|
my $inMethod = 0;
|
|
my $inAnonymousFunctionParameters = 0;
|
|
my $parenthesesDepth = 0;
|
|
my $globalParenthesesDepth = 0;
|
|
my $bracesDepth = 0;
|
|
|
|
my $classJustSeen = 0;
|
|
my $parenthesisJustSeen = 0;
|
|
my $functionJustSeen = 0;
|
|
my $getterJustSeen = 0;
|
|
my $setterJustSeen = 0;
|
|
my $asyncJustSeen = 0;
|
|
my $assignmentJustSeen = 0;
|
|
my $staticOrContructorSeen = 0;
|
|
|
|
my $currentToken = "";
|
|
my $lastToken = "";
|
|
my $possibleMethodName = "";
|
|
my $word = "";
|
|
|
|
while (<$fileHandle>) {
|
|
# Handle continued multi-line comment.
|
|
if ($inComment) {
|
|
next unless s-.*\*/--;
|
|
$inComment = 0;
|
|
}
|
|
|
|
# Handle continued quoted text.
|
|
if ($inQuotedText ne "") {
|
|
next if /\\$/;
|
|
s-([^\\]|\\.)*?$inQuotedText--;
|
|
$inQuotedText = "";
|
|
}
|
|
|
|
# Handle comments and quoted text.
|
|
while (m-(/\*|//|\'|\")-) { # \' and \" keep emacs perl mode happy
|
|
my $match = $1;
|
|
if ($match eq '/*') {
|
|
if (!s-/\*.*?\*/--) {
|
|
s-/\*.*--;
|
|
$inComment = 1;
|
|
}
|
|
} elsif ($match eq '//') {
|
|
s-//.*--;
|
|
} else { # ' or "
|
|
if (!s-$match([^\\]|\\.)*?$match-string_appeared_here-) {
|
|
$inQuotedText = $match if /\\$/;
|
|
warn "mismatched quotes at line $. in $fileName\n" if $inQuotedText eq "";
|
|
s-$match.*--;
|
|
}
|
|
}
|
|
}
|
|
|
|
# Find function names.
|
|
while (m-(\w+|[(){}=:;,.])-g) {
|
|
# Skip everything until "{" after extends.
|
|
if ($inExtends) {
|
|
next if $1 ne '{';
|
|
$inExtends = 0;
|
|
}
|
|
|
|
$lastToken = $currentToken;
|
|
$currentToken = $1;
|
|
|
|
# Open parenthesis.
|
|
if ($1 eq '(') {
|
|
$parenthesesDepth++;
|
|
$globalParenthesesDepth++ if $currentParsingMode[$#currentParsingMode] eq "global";
|
|
$possibleMethodName = join('.', @currentIdentifiers);
|
|
$inAnonymousFunctionParameters = 1 if $functionJustSeen;
|
|
$functionJustSeen = 0;
|
|
next;
|
|
}
|
|
|
|
# Close parenthesis.
|
|
if ($1 eq ')') {
|
|
$parenthesesDepth--;
|
|
$globalParenthesesDepth-- if $currentParsingMode[$#currentParsingMode] eq "global";
|
|
@currentIdentifiers = () if $inAnonymousFunctionParameters;
|
|
$inAnonymousFunctionParameters = 0;
|
|
$parenthesisJustSeen = 1;
|
|
next;
|
|
}
|
|
|
|
# Open brace.
|
|
if ($1 eq '{') {
|
|
my $methodName = "";
|
|
my $mode = $currentParsingMode[$#currentParsingMode];
|
|
|
|
# Method.
|
|
if (($mode eq 'class' or $mode eq 'global') and $parenthesisJustSeen and ($staticOrContructorSeen or $possibleMethodName)) {
|
|
if ($mode eq 'class') {
|
|
$methodName = join('.', $staticOrContructorSeen ? "" : "prototype", $possibleMethodName);
|
|
} else {
|
|
$methodName = $possibleMethodName;
|
|
}
|
|
|
|
$methodName =~ s/\.{2,}/\./g; # Removes consecutive periods.
|
|
$methodName =~ s/\.$//; # Remove trailing period.
|
|
|
|
my $currentMethod = join('.', @currentScopes, $methodName);
|
|
$currentMethod =~ s/\.{2,}/\./g; # Removes consecutive periods.
|
|
$currentMethod =~ s/\.$//; # Remove trailing period.
|
|
|
|
push(@currentParsingMode, "method");
|
|
push(@currentFunctionNames, $currentMethod);
|
|
push(@currentFunctionDepths, $bracesDepth);
|
|
push(@currentFunctionStartLines, $.);
|
|
}
|
|
|
|
$bracesDepth++;
|
|
$functionJustSeen = 0;
|
|
|
|
push(@currentScopes, join('.', $methodName ? $methodName : @currentIdentifiers));
|
|
@currentIdentifiers = ();
|
|
|
|
$staticOrContructorSeen = 0;
|
|
next;
|
|
}
|
|
|
|
# Close brace.
|
|
if ($1 eq '}') {
|
|
$bracesDepth--;
|
|
$functionJustSeen = 0;
|
|
|
|
if (@currentFunctionDepths and $bracesDepth == $currentFunctionDepths[$#currentFunctionDepths]) {
|
|
pop(@currentFunctionDepths);
|
|
pop(@currentParsingMode);
|
|
|
|
my $currentName = pop(@currentFunctionNames);
|
|
my $start = pop(@currentFunctionStartLines);
|
|
|
|
$currentName =~ s/^\.//g; # Removes leading periods.
|
|
|
|
push(@ranges, [$start, $., $currentName]);
|
|
}
|
|
|
|
pop(@currentScopes);
|
|
@currentIdentifiers = ();
|
|
|
|
next;
|
|
}
|
|
|
|
# Dot.
|
|
if ($1 eq '.') {
|
|
next;
|
|
}
|
|
|
|
# Semicolon or comma.
|
|
if ($1 eq ';' or $1 eq ',') {
|
|
@currentIdentifiers = ();
|
|
next;
|
|
}
|
|
|
|
# Class.
|
|
if ($1 eq 'class') {
|
|
$classJustSeen = 1;
|
|
next;
|
|
}
|
|
|
|
# Extends.
|
|
if ($1 eq 'extends') {
|
|
$inExtends = 1;
|
|
next;
|
|
}
|
|
|
|
# Function.
|
|
if ($1 eq 'function') {
|
|
$functionJustSeen = 1;
|
|
|
|
if ($assignmentJustSeen) {
|
|
my $currentFunction = join('.', (@currentScopes, @currentIdentifiers));
|
|
$currentFunction =~ s/\.{2,}/\./g; # Removes consecutive periods.
|
|
|
|
push(@currentParsingMode, "function");
|
|
push(@currentFunctionNames, $currentFunction);
|
|
push(@currentFunctionDepths, $bracesDepth);
|
|
push(@currentFunctionStartLines, $.);
|
|
}
|
|
|
|
next;
|
|
}
|
|
|
|
# Getter prefix.
|
|
if ($1 eq 'get') {
|
|
next if $lastToken eq '.'; # Avoid map.get(...).
|
|
$getterJustSeen = 1;
|
|
next;
|
|
}
|
|
|
|
# Setter prefix.
|
|
if ($1 eq 'set') {
|
|
next if $lastToken eq '.'; # Avoid map.set(...).
|
|
$setterJustSeen = 1;
|
|
next;
|
|
}
|
|
|
|
# Async prefix.
|
|
if ($1 eq 'async') {
|
|
next if $lastToken eq '.';
|
|
$asyncJustSeen = 1;
|
|
next;
|
|
}
|
|
|
|
# Static.
|
|
if ($1 eq 'static' or $1 eq 'constructor') {
|
|
$staticOrContructorSeen = 1;
|
|
next;
|
|
}
|
|
|
|
# Assignment operator.
|
|
if ($1 eq '=' or $1 eq ':') {
|
|
$assignmentJustSeen = 1;
|
|
next;
|
|
}
|
|
|
|
next if $parenthesesDepth > $globalParenthesesDepth;
|
|
|
|
# Word.
|
|
$word = $1;
|
|
|
|
if ($classJustSeen) {
|
|
push(@currentIdentifiers, $word) if !$assignmentJustSeen;
|
|
|
|
my $currentClass = join('.', (@currentScopes, @currentIdentifiers));
|
|
$currentClass =~ s/\.{2,}/\./g; # Removes consecutive periods.
|
|
|
|
push(@currentParsingMode, "class");
|
|
push(@currentFunctionNames, $currentClass);
|
|
push(@currentFunctionDepths, $bracesDepth);
|
|
push(@currentFunctionStartLines, $.);
|
|
} elsif ($getterJustSeen or $setterJustSeen or $asyncJustSeen) {
|
|
$word = "get $word" if $getterJustSeen;
|
|
$word = "set $word" if $setterJustSeen;
|
|
$word = "async $word" if $asyncJustSeen;
|
|
|
|
push(@currentIdentifiers, $word);
|
|
|
|
my $mode = $currentParsingMode[$#currentParsingMode];
|
|
my $currentFunction = join('.', (@currentScopes, ($mode eq 'class' and !$staticOrContructorSeen) ? "prototype" : "", @currentIdentifiers));
|
|
$currentFunction =~ s/\.{2,}/\./g; # Removes consecutive periods.
|
|
|
|
push(@currentParsingMode, "function");
|
|
push(@currentFunctionNames, $currentFunction);
|
|
push(@currentFunctionDepths, $bracesDepth);
|
|
push(@currentFunctionStartLines, $.);
|
|
} elsif ($functionJustSeen and !$assignmentJustSeen) {
|
|
push(@currentIdentifiers, $word);
|
|
|
|
my $currentFunction = join('.', (@currentScopes, @currentIdentifiers));
|
|
$currentFunction =~ s/\.{2,}/\./g; # Removes consecutive periods.
|
|
|
|
push(@currentParsingMode, "function");
|
|
push(@currentFunctionNames, $currentFunction);
|
|
push(@currentFunctionDepths, $bracesDepth);
|
|
push(@currentFunctionStartLines, $.);
|
|
} elsif ($word ne 'if' and $word ne 'for' and $word ne 'do' and $word ne 'while' and $word ne 'which' and $word ne 'var') {
|
|
push(@currentIdentifiers, $word);
|
|
}
|
|
|
|
$classJustSeen = 0;
|
|
$parenthesisJustSeen = 0;
|
|
$functionJustSeen = 0;
|
|
$getterJustSeen = 0;
|
|
$setterJustSeen = 0;
|
|
$asyncJustSeen = 0;
|
|
$assignmentJustSeen = 0;
|
|
}
|
|
}
|
|
|
|
warn "mismatched braces in $fileName\n" if $bracesDepth;
|
|
warn "mismatched parentheses in $fileName\n" if $parenthesesDepth;
|
|
|
|
return @ranges;
|
|
}
|
|
|
|
# Read a file and get all the line ranges of the things that look like Perl functions. Functions
|
|
# start on a line that starts with "sub ", and end on the first line starting with "}" thereafter.
|
|
#
|
|
# Result is a list of triples: [ start_line, end_line, function ].
|
|
|
|
sub get_function_line_ranges_for_perl($$)
|
|
{
|
|
my ($fileHandle, $fileName) = @_;
|
|
|
|
my @ranges;
|
|
|
|
my $currentFunction = "";
|
|
my $start = 0;
|
|
my $hereDocumentIdentifier = "";
|
|
|
|
while (<$fileHandle>) {
|
|
chomp;
|
|
if (!$hereDocumentIdentifier) {
|
|
if (/^sub\s+([\w_][\w\d_]*)/) {
|
|
# Skip over forward declarations, which don't contain a brace and end with a semicolon.
|
|
next if /;\s*$/;
|
|
|
|
if ($currentFunction) {
|
|
warn "nested functions found at top-level at $fileName:$.\n";
|
|
next;
|
|
}
|
|
$currentFunction = $1;
|
|
$start = $.;
|
|
}
|
|
if (/<<\s*[\"\']?([\w_][\w_\d]*)/) {
|
|
# Enter here-document.
|
|
$hereDocumentIdentifier = $1;
|
|
}
|
|
if (index($_, "}") == 0) {
|
|
next unless $start;
|
|
push(@ranges, [$start, $., $currentFunction]);
|
|
$currentFunction = "";
|
|
$start = 0;
|
|
}
|
|
} elsif ($_ eq $hereDocumentIdentifier) {
|
|
# Escape from here-document.
|
|
$hereDocumentIdentifier = "";
|
|
}
|
|
}
|
|
|
|
return @ranges;
|
|
}
|
|
|
|
# Read a file and get all the line ranges of the things that look like Python classes, methods, or functions.
|
|
#
|
|
# FIXME: Maybe we should use Python's ast module to do the parsing for us?
|
|
#
|
|
# Result is a list of triples: [ start_line, end_line, function ].
|
|
|
|
sub get_function_line_ranges_for_python($$)
|
|
{
|
|
my ($fileHandle, $fileName) = @_;
|
|
|
|
my @ranges;
|
|
|
|
my $multilineStringLiteralSentinelRegEx = qr#(?:"""|''')#;
|
|
my $multilineStringLiteralStartRegEx = qr#\s*$multilineStringLiteralSentinelRegEx#;
|
|
my $multilineStringLiteralEndRegEx = qr#$multilineStringLiteralSentinelRegEx\s*$#;
|
|
|
|
my @scopeStack = ({ line => 0, indent => -1, name => undef });
|
|
my $lastLine = 0;
|
|
my $inComment = 0;
|
|
until ($lastLine) {
|
|
$_ = <$fileHandle>;
|
|
unless ($_) {
|
|
# To pop out all popped scopes, run the loop once more after
|
|
# we encountered the end of the file.
|
|
$_ = "pass\n";
|
|
$.++;
|
|
$lastLine = 1;
|
|
}
|
|
chomp;
|
|
next unless /^(\s*)([^#].*)$/; # Skip non-indented lines that begin with a comment.
|
|
|
|
my $indent = length $1;
|
|
my $rest = $2;
|
|
my $scope = $scopeStack[-1];
|
|
|
|
if ($indent <= $scope->{indent}) {
|
|
# Find all the scopes that we have just exited.
|
|
my $i = 0;
|
|
for (; $i < @scopeStack; ++$i) {
|
|
last if $indent <= $scopeStack[$i]->{indent};
|
|
}
|
|
my @poppedScopes = splice @scopeStack, $i;
|
|
|
|
# For each scope that was just exited, add a range that goes from the start of that
|
|
# scope to the start of the next nested scope, or to the line just before this one for
|
|
# the innermost scope.
|
|
for ($i = 0; $i < @poppedScopes; ++$i) {
|
|
my $lineAfterEnd = $i + 1 == @poppedScopes ? $. : $poppedScopes[$i + 1]->{line};
|
|
push @ranges, [$poppedScopes[$i]->{line}, $lineAfterEnd - 1, $poppedScopes[$i]->{name}];
|
|
}
|
|
@scopeStack or warn "Popped off last scope at $fileName:$.\n";
|
|
|
|
# Set the now-current scope to start at the current line. Any lines within this scope
|
|
# before this point should already have been added to @ranges.
|
|
$scope = $scopeStack[-1];
|
|
$scope->{line} = $.;
|
|
}
|
|
|
|
# Skip multi-line string literals and docstrings.
|
|
next if /$multilineStringLiteralStartRegEx.*$multilineStringLiteralEndRegEx/;
|
|
if (!$inComment && /$multilineStringLiteralStartRegEx/) {
|
|
$inComment = 1;
|
|
} elsif ($inComment && /$multilineStringLiteralEndRegEx/) {
|
|
$inComment = 0;
|
|
}
|
|
next if $inComment;
|
|
|
|
next if /^\s*[#'"]/; # Skip indented and non-indented lines that begin with a comment or string literal (includes docstrings).
|
|
|
|
next unless $rest =~ /(?:class|def)\s+(\w+)/;
|
|
my $name = $1;
|
|
my $fullName = $scope->{name} ? join('.', $scope->{name}, $name) : $name;
|
|
push @scopeStack, { line => $., indent => $indent, name => $fullName };
|
|
|
|
if ($scope->{indent} >= 0) {
|
|
push @ranges, [$scope->{line}, $. - 1, $scope->{name}];
|
|
}
|
|
}
|
|
|
|
return @ranges;
|
|
}
|
|
|
|
# Read a file and get all the line ranges of the things that look like CSS selectors. A selector is
|
|
# anything before an opening brace on a line. A selector starts at the line containing the opening
|
|
# brace and ends at the closing brace.
|
|
#
|
|
# Result is a list of triples: [ start_line, end_line, selector ].
|
|
|
|
sub get_selector_line_ranges_for_css($$)
|
|
{
|
|
my ($fileHandle, $fileName) = @_;
|
|
|
|
my @ranges;
|
|
|
|
my $inComment = 0;
|
|
my $inBrace = 0;
|
|
my @stack;
|
|
my $context;
|
|
my @currentParseMode = ("global");
|
|
my @groupingStack;
|
|
my $selectorBraces = 0;
|
|
|
|
while (<$fileHandle>) {
|
|
foreach my $token (split m-(\{|\}|/\*|\*/)-, $_) {
|
|
if ($token eq "{") {
|
|
if (!$inComment) {
|
|
$inBrace += 1;
|
|
$selectorBraces += 1 if $currentParseMode[$#currentParseMode] eq "selector";
|
|
warn "mismatched opening brace found in $fileName:$.\n" if $selectorBraces > 1;
|
|
}
|
|
} elsif ($token eq "}") {
|
|
if (!$inComment) {
|
|
if (!$inBrace or $currentParseMode[$#currentParseMode] eq "global") {
|
|
warn "mismatched closing brace found in $fileName:$.\n";
|
|
next;
|
|
}
|
|
|
|
$inBrace -= 1;
|
|
|
|
my $parseMode = pop(@currentParseMode);
|
|
if ($parseMode eq "selector") {
|
|
my $name = pop(@stack);
|
|
my $startLine = pop(@stack);
|
|
my $endLine = $.;
|
|
my $groupingPrefix = join(" ", @groupingStack);
|
|
if (length $groupingPrefix) {
|
|
$groupingPrefix .= " "
|
|
}
|
|
push(@ranges, [$startLine, $endLine, $groupingPrefix . $name]);
|
|
} elsif ($parseMode eq "media") {
|
|
pop(@groupingStack);
|
|
}
|
|
|
|
$selectorBraces = 0;
|
|
}
|
|
} elsif ($token eq "/*") {
|
|
$inComment = 1;
|
|
} elsif ($token eq "*/") {
|
|
warn "mismatched comment found in $fileName:$.\n" if !$inComment;
|
|
$inComment = 0;
|
|
} else {
|
|
if (!$inComment and $currentParseMode[$#currentParseMode] ne "selector" and $token !~ /^[\s\t]*$/) {
|
|
$token =~ s/^[\s\t]*|[\s\t]*$//g;
|
|
my $startLine = $.;
|
|
if ($token =~ /^\@media/) {
|
|
push(@currentParseMode, "media");
|
|
push(@groupingStack, $token);
|
|
} else {
|
|
push(@currentParseMode, "selector");
|
|
push(@stack, ($startLine, $token));
|
|
}
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
# Sort by start line.
|
|
return sort {$a->[0] <=> $b->[0]} @ranges;
|
|
}
|
|
|
|
# Read a file and get all the line ranges of the things that look like Swift classes, methods,
|
|
# or functions.
|
|
#
|
|
# Result is a list of triples: [ start_line, end_line, function ].
|
|
|
|
sub get_function_line_ranges_for_swift($$)
|
|
{
|
|
my ($fileHandle, $fileName) = @_;
|
|
|
|
my @ranges;
|
|
|
|
my $currentFunction = "";
|
|
my $currentType = "";
|
|
my $functionStart = 0;
|
|
my $typeStart = 0;
|
|
my $functionScopeDepth = 0;
|
|
my $typeScopeDepth = 0;
|
|
my $scopeDepth = 0;
|
|
|
|
while (<$fileHandle>) {
|
|
chomp;
|
|
next if (/^\s*\/\/.*/);
|
|
if (/func\s+([\w_][\w\d_]*)\((.*)\)/ || /var\s+([\w_][\w\d_]*):\s+/) {
|
|
$functionScopeDepth = $scopeDepth;
|
|
$currentFunction = $1;
|
|
if ($2) {
|
|
$currentFunction = "$currentFunction(". parseSwiftFunctionArgs($2) . ")";
|
|
}
|
|
if ($currentType) {
|
|
$currentFunction = "$currentType.$currentFunction";
|
|
}
|
|
$functionStart = $.;
|
|
} elsif (/(?:class|struct|enum|protocol|extension)\s+([\w_][\w\d_]*)/) {
|
|
$typeScopeDepth = $scopeDepth;
|
|
$currentType = $1;
|
|
$typeStart = $.;
|
|
}
|
|
if (index($_, "{") > -1) {
|
|
$scopeDepth++;
|
|
}
|
|
if (index($_, "}") > -1) {
|
|
$scopeDepth--;
|
|
}
|
|
if ($scopeDepth == $functionScopeDepth) {
|
|
next unless $functionStart;
|
|
push(@ranges, [$functionStart, $., $currentFunction]);
|
|
$currentFunction = "";
|
|
$functionStart = 0;
|
|
} elsif ($scopeDepth == $typeScopeDepth) {
|
|
next unless $typeStart;
|
|
$currentType = "";
|
|
$typeStart = 0;
|
|
}
|
|
}
|
|
|
|
return @ranges;
|
|
}
|
|
|
|
sub parseSwiftFunctionArgs($)
|
|
{
|
|
my ($functionArgs) = @_;
|
|
my @words = split /, /, $functionArgs;
|
|
my $argCount = scalar(@words);
|
|
if ($argCount == 0) {
|
|
return "";
|
|
} elsif ($argCount > 0) {
|
|
# If the first argument is unnamed, give it the name "_"
|
|
$words[0] =~ s/^(\w+: .*)/_ $1/;
|
|
return join("", map { $_ =~ s/^(\w+).*/$1/; "$_:" } @words);
|
|
} else {
|
|
warn "Unknown argument count.\n";
|
|
}
|
|
}
|
|
|
|
sub processPaths(\@)
|
|
{
|
|
my ($paths) = @_;
|
|
return ("." => 1) if (!@{$paths});
|
|
|
|
my %result = ();
|
|
|
|
for my $file (@{$paths}) {
|
|
die "can't handle absolute paths like \"$file\"\n" if File::Spec->file_name_is_absolute($file);
|
|
die "can't handle empty string path\n" if $file eq "";
|
|
die "can't handle path with single quote in the name like \"$file\"\n" if $file =~ /'/; # ' (keep Xcode syntax highlighting happy)
|
|
|
|
my $untouchedFile = $file;
|
|
|
|
$file = canonicalizePath($file);
|
|
|
|
die "can't handle paths with .. like \"$untouchedFile\"\n" if $file =~ m|/\.\./|;
|
|
|
|
$result{$file} = 1;
|
|
}
|
|
|
|
return ("." => 1) if ($result{"."});
|
|
|
|
# Remove any paths that also have a parent listed.
|
|
for my $path (keys %result) {
|
|
for (my $parent = dirname($path); $parent ne '.'; $parent = dirname($parent)) {
|
|
if ($result{$parent}) {
|
|
delete $result{$path};
|
|
last;
|
|
}
|
|
}
|
|
}
|
|
|
|
return %result;
|
|
}
|
|
|
|
sub diffFromToString($$$)
|
|
{
|
|
my ($gitCommit, $gitIndex, $mergeBase) = @_;
|
|
|
|
return "" if isSVN();
|
|
return $gitCommit if $gitCommit =~ m/.+\.\..+/;
|
|
return "\"$gitCommit^\" \"$gitCommit\"" if $gitCommit;
|
|
return "--cached" if $gitIndex;
|
|
return $mergeBase if $mergeBase;
|
|
return "HEAD" if isGit();
|
|
}
|
|
|
|
sub diffCommand($$$$)
|
|
{
|
|
my ($paths, $gitCommit, $gitIndex, $mergeBase) = @_;
|
|
|
|
# The function overlap detection logic in computeModifiedFunctions() assumes that its line
|
|
# ranges were from a unified diff without any context lines.
|
|
my $command;
|
|
if (isSVN()) {
|
|
my @escapedPaths = map(escapeSubversionPath($_), @$paths);
|
|
my $escapedPathsString = qq(") . join(qq(" "), @escapedPaths) . qq(");
|
|
$command = SVN . " diff --diff-cmd diff -x -U0 $escapedPathsString";
|
|
} elsif (isGit()) {
|
|
my $pathsString = "'" . join("' '", @$paths) . "'";
|
|
$command = GIT . " diff --no-ext-diff -U0 " . diffFromToString($gitCommit, $gitIndex, $mergeBase);
|
|
$command .= " -- $pathsString" unless $gitCommit or $mergeBase;
|
|
}
|
|
|
|
return $command;
|
|
}
|
|
|
|
sub statusCommand($$$$)
|
|
{
|
|
my ($paths, $gitCommit, $gitIndex, $mergeBase) = @_;
|
|
|
|
my $command;
|
|
if (isSVN()) {
|
|
my @escapedFiles = map(escapeSubversionPath($_), keys %$paths);
|
|
my $escapedFilesString = qq(") . join(qq(" "), @escapedFiles) . qq(");
|
|
$command = SVN . " stat $escapedFilesString";
|
|
} elsif (isGit()) {
|
|
my $filesString = '"' . join('" "', keys %$paths) . '"';
|
|
$command = GIT . " diff -r --name-status -M -C " . diffFromToString($gitCommit, $gitIndex, $mergeBase);
|
|
$command .= " -- $filesString" unless $gitCommit;
|
|
}
|
|
|
|
return "$command 2>&1";
|
|
}
|
|
|
|
sub attributeCommand($$$)
|
|
{
|
|
my ($attributeCache, $file, $attr) = @_;
|
|
|
|
my $result;
|
|
if (isSVN()) {
|
|
my $devNull = File::Spec->devnull();
|
|
my $foundAttribute = 0;
|
|
my $subPath = ".";
|
|
my (@directoryParts) = File::Spec->splitdir($file);
|
|
foreach my $part (@directoryParts) {
|
|
if ($part eq ".") {
|
|
next;
|
|
}
|
|
$subPath = File::Spec->join($subPath, $part);
|
|
$subPath =~ s/^\.\///;
|
|
if ($foundAttribute || exists $attributeCache->{$attr}{$subPath} && $attributeCache->{$attr}{$subPath} eq "1") {
|
|
$attributeCache->{$attr}{$subPath} = "1";
|
|
$foundAttribute = 1;
|
|
next;
|
|
}
|
|
my $command = SVN . " propget $attr '$subPath'";
|
|
my $attrib = $attributeCache->{$attr}{$subPath} || `$command 2> $devNull`;
|
|
chomp $attrib;
|
|
if ($attrib eq "1") {
|
|
$foundAttribute = 1;
|
|
}
|
|
$attributeCache->{$attr}{$subPath} = $attrib || "0";
|
|
}
|
|
$result = $attributeCache->{$attr}{$file};
|
|
} elsif (isGit()) {
|
|
my $command = GIT . " check-attr $attr -- '$file'";
|
|
$result = `$command`;
|
|
chomp $result;
|
|
$result =~ s/.*\W(\w)/$1/;
|
|
}
|
|
|
|
$result =~ s/\D//g;
|
|
return int($result || 0);
|
|
}
|
|
|
|
sub createPatchCommand($$$$)
|
|
{
|
|
my ($changedFilesString, $gitCommit, $gitIndex, $mergeBase) = @_;
|
|
|
|
my $command;
|
|
if (isSVN()) {
|
|
$command = "'$FindBin::Bin/svn-create-patch --no-style' $changedFilesString";
|
|
} elsif (isGit()) {
|
|
$command = GIT . " diff -M -C " . diffFromToString($gitCommit, $gitIndex, $mergeBase);
|
|
$command .= " -- $changedFilesString" unless $gitCommit;
|
|
}
|
|
|
|
return $command;
|
|
}
|
|
|
|
sub findOriginalFileFromSvn($)
|
|
{
|
|
my ($file) = @_;
|
|
my $baseUrl;
|
|
open INFO, SVN . " info . |" or die;
|
|
while (<INFO>) {
|
|
if (/^URL: (.+?)[\r\n]*$/) {
|
|
$baseUrl = $1;
|
|
}
|
|
}
|
|
close INFO;
|
|
my $sourceFile;
|
|
my $escapedFile = escapeSubversionPath($file);
|
|
open INFO, SVN . " info '$escapedFile' |" or die;
|
|
while (<INFO>) {
|
|
if (/^Copied From URL: (.+?)[\r\n]*$/) {
|
|
$sourceFile = File::Spec->abs2rel($1, $baseUrl);
|
|
}
|
|
}
|
|
close INFO;
|
|
return $sourceFile;
|
|
}
|
|
|
|
sub determinePropertyChanges($$$)
|
|
{
|
|
my ($file, $isAdd, $original) = @_;
|
|
|
|
my $escapedFile = escapeSubversionPath($file);
|
|
my %changes;
|
|
if ($isAdd) {
|
|
my %addedProperties;
|
|
my %removedProperties;
|
|
open PROPLIST, SVN . " proplist '$escapedFile' |" or die;
|
|
while (<PROPLIST>) {
|
|
$addedProperties{$1} = 1 if /^ (.+?)[\r\n]*$/ && $1 ne 'svn:mergeinfo';
|
|
}
|
|
close PROPLIST;
|
|
if ($original) {
|
|
my $escapedOriginal = escapeSubversionPath($original);
|
|
open PROPLIST, SVN . " proplist '$escapedOriginal' |" or die;
|
|
while (<PROPLIST>) {
|
|
next unless /^ (.+?)[\r\n]*$/;
|
|
my $property = $1;
|
|
if (exists $addedProperties{$property}) {
|
|
delete $addedProperties{$1};
|
|
} else {
|
|
$removedProperties{$1} = 1;
|
|
}
|
|
}
|
|
}
|
|
$changes{"A"} = [sort keys %addedProperties] if %addedProperties;
|
|
$changes{"D"} = [sort keys %removedProperties] if %removedProperties;
|
|
} else {
|
|
open DIFF, SVN . " diff '$escapedFile' |" or die;
|
|
while (<DIFF>) {
|
|
if (/^Property changes on:/) {
|
|
while (<DIFF>) {
|
|
my $operation;
|
|
my $property;
|
|
if (/^Added: (\S*)/) {
|
|
$operation = "A";
|
|
$property = $1;
|
|
} elsif (/^Modified: (\S*)/) {
|
|
$operation = "M";
|
|
$property = $1;
|
|
} elsif (/^Deleted: (\S*)/) {
|
|
$operation = "D";
|
|
$property = $1;
|
|
} elsif (/^Name: (\S*)/) {
|
|
# Older versions of svn just say "Name" instead of the type
|
|
# of property change.
|
|
$operation = "C";
|
|
$property = $1;
|
|
}
|
|
if ($operation) {
|
|
$changes{$operation} = [] unless exists $changes{$operation};
|
|
push @{$changes{$operation}}, $property;
|
|
}
|
|
}
|
|
}
|
|
}
|
|
close DIFF;
|
|
}
|
|
return \%changes;
|
|
}
|
|
|
|
sub pluralizeAndList($$@)
|
|
{
|
|
my ($singular, $plural, @items) = @_;
|
|
|
|
return if @items == 0;
|
|
return "$singular $items[0]" if @items == 1;
|
|
return "$plural " . join(", ", @items[0 .. $#items - 1]) . " and " . $items[-1];
|
|
}
|
|
|
|
sub generateFileList(\%$$$\%)
|
|
{
|
|
my ($paths, $gitCommit, $gitIndex, $mergeBase, $attributeCache) = @_;
|
|
|
|
my @changedFiles;
|
|
my @conflictFiles;
|
|
my %functionLists;
|
|
my @addedRegressionTests;
|
|
my @requiresTests;
|
|
print STDERR " Running status to find changed, added, or removed files.\n";
|
|
open STAT, "-|", statusCommand($paths, $gitCommit, $gitIndex, $mergeBase) or die "The status failed: $!.\n";
|
|
while (<STAT>) {
|
|
my $status;
|
|
my $propertyStatus;
|
|
my $propertyChanges;
|
|
my $original;
|
|
my $file;
|
|
|
|
if (isSVN()) {
|
|
my $matches;
|
|
if (isSVNVersion16OrNewer()) {
|
|
$matches = /^([ ACDMR])([ CM]).{5} (.+?)[\r\n]*$/;
|
|
$status = $1;
|
|
$propertyStatus = $2;
|
|
$file = $3;
|
|
} else {
|
|
$matches = /^([ ACDMR])([ CM]).{4} (.+?)[\r\n]*$/;
|
|
$status = $1;
|
|
$propertyStatus = $2;
|
|
$file = $3;
|
|
}
|
|
if ($matches) {
|
|
$file = normalizePath($file);
|
|
$original = findOriginalFileFromSvn($file) if substr($_, 3, 1) eq "+";
|
|
my $isAdd = isAddedStatus($status);
|
|
$propertyChanges = determinePropertyChanges($file, $isAdd, $original) if isModifiedStatus($propertyStatus) || $isAdd;
|
|
} else {
|
|
print; # error output from svn stat
|
|
}
|
|
} elsif (isGit()) {
|
|
if (/^([ADM])\t(.+)$/) {
|
|
$status = $1;
|
|
$propertyStatus = " "; # git doesn't have properties
|
|
$file = normalizePath($2);
|
|
} elsif (/^([CR])[0-9]{1,3}\t([^\t]+)\t([^\t\n]+)$/) { # for example: R90% newfile oldfile
|
|
$status = $1;
|
|
$propertyStatus = " ";
|
|
$original = normalizePath($2);
|
|
$file = normalizePath($3);
|
|
} else {
|
|
print; # error output from git diff
|
|
}
|
|
}
|
|
|
|
next if !$status || isUnmodifiedStatus($status) && isUnmodifiedStatus($propertyStatus);
|
|
|
|
$file = makeFilePathRelative($file);
|
|
|
|
if (isModifiedStatus($status) || isAddedStatus($status) || isModifiedStatus($propertyStatus)) {
|
|
my @components = File::Spec->splitdir($file);
|
|
if ($components[0] eq "LayoutTests") {
|
|
push @addedRegressionTests, $file
|
|
if isAddedStatus($status)
|
|
&& $file =~ /\.([a-zA-Z]+)$/
|
|
&& SupportedTestExtensions->{lc($1)}
|
|
&& $file !~ /-expected(-mismatch)?\.html$/
|
|
&& !scalar(grep(/^resources$/i, @components))
|
|
&& !scalar(grep(/^script-tests$/i, @components));
|
|
} elsif (attributeCommand($attributeCache, $file, "test")) {
|
|
push @addedRegressionTests, $file;
|
|
} elsif (attributeCommand($attributeCache, $file, "requiresTests")) {
|
|
push @requiresTests, $file
|
|
}
|
|
push @changedFiles, $file if $components[$#components] ne "ChangeLog";
|
|
} elsif (isConflictStatus($status, $gitCommit, $gitIndex) || isConflictStatus($propertyStatus, $gitCommit, $gitIndex)) {
|
|
push @conflictFiles, $file;
|
|
}
|
|
if (basename($file) ne "ChangeLog") {
|
|
my $description = statusDescription($status, $propertyStatus, $original, $propertyChanges);
|
|
$functionLists{$file} = $description if defined $description;
|
|
}
|
|
}
|
|
close STAT;
|
|
return (\@changedFiles, \@conflictFiles, \%functionLists, \@addedRegressionTests, \@requiresTests);
|
|
}
|
|
|
|
sub isUnmodifiedStatus($)
|
|
{
|
|
my ($status) = @_;
|
|
|
|
my %statusCodes = (
|
|
" " => 1,
|
|
);
|
|
|
|
return $statusCodes{$status};
|
|
}
|
|
|
|
sub isModifiedStatus($)
|
|
{
|
|
my ($status) = @_;
|
|
|
|
my %statusCodes = (
|
|
"M" => 1,
|
|
);
|
|
|
|
return $statusCodes{$status};
|
|
}
|
|
|
|
sub isAddedStatus($)
|
|
{
|
|
my ($status) = @_;
|
|
|
|
my %statusCodes = (
|
|
"A" => 1,
|
|
"C" => isGit(),
|
|
"R" => 1,
|
|
);
|
|
|
|
return $statusCodes{$status};
|
|
}
|
|
|
|
sub isConflictStatus($$$)
|
|
{
|
|
my ($status, $gitCommit, $gitIndex) = @_;
|
|
|
|
my %svn = (
|
|
"C" => 1,
|
|
);
|
|
|
|
my %git = (
|
|
"U" => 1,
|
|
);
|
|
|
|
return 0 if ($gitCommit || $gitIndex); # an existing commit or staged change cannot have conflicts
|
|
return $svn{$status} if isSVN();
|
|
return $git{$status} if isGit();
|
|
}
|
|
|
|
sub statusDescription($$$$)
|
|
{
|
|
my ($status, $propertyStatus, $original, $propertyChanges) = @_;
|
|
|
|
my $propertyDescription = defined $propertyChanges ? propertyChangeDescription($propertyChanges) : "";
|
|
|
|
my %svn = (
|
|
"A" => defined $original ? sprintf(" Copied from \%s.", $original) : " Added.",
|
|
"D" => " Removed.",
|
|
"M" => "",
|
|
"R" => defined $original ? sprintf(" Replaced with \%s.", $original) : " Replaced.",
|
|
" " => "",
|
|
);
|
|
|
|
my %git = %svn;
|
|
$git{"A"} = " Added.";
|
|
if (defined $original) {
|
|
$git{"C"} = sprintf(" Copied from \%s.", $original);
|
|
$git{"R"} = sprintf(" Renamed from \%s.", $original);
|
|
}
|
|
|
|
my $description;
|
|
$description = $svn{$status} if isSVN() && exists $svn{$status};
|
|
$description = $git{$status} if isGit() && exists $git{$status};
|
|
return unless defined $description;
|
|
|
|
$description .= $propertyDescription unless isAddedStatus($status);
|
|
return $description;
|
|
}
|
|
|
|
sub propertyChangeDescription($)
|
|
{
|
|
my ($propertyChanges) = @_;
|
|
|
|
my %operations = (
|
|
"A" => "Added",
|
|
"M" => "Modified",
|
|
"D" => "Removed",
|
|
"C" => "Changed",
|
|
);
|
|
|
|
my $description = "";
|
|
while (my ($operation, $properties) = each %$propertyChanges) {
|
|
my $word = $operations{$operation};
|
|
my $list = pluralizeAndList("property", "properties", @$properties);
|
|
$description .= " $word $list.";
|
|
}
|
|
return $description;
|
|
}
|
|
|
|
sub extractLineRangeAfterChange($)
|
|
{
|
|
my ($string) = @_;
|
|
my $chunkRange = parseChunkRange($string);
|
|
if (!$chunkRange) {
|
|
return (-1, -1); # Malformed
|
|
}
|
|
if (!$chunkRange->{newStartingLine} || !$chunkRange->{newLineCount}) {
|
|
# Deletion; no lines exist after change.
|
|
return ($chunkRange->{newStartingLine}, $chunkRange->{newStartingLine});
|
|
}
|
|
return ($chunkRange->{newStartingLine}, $chunkRange->{newStartingLine} + $chunkRange->{newLineCount} - 1);
|
|
}
|
|
|
|
sub extractLineRangeBeforeChange($)
|
|
{
|
|
my ($string) = @_;
|
|
my $chunkRange = parseChunkRange($string);
|
|
if (!$chunkRange) {
|
|
return (-1, -1); # Malformed
|
|
}
|
|
if (!$chunkRange->{startingLine} || !$chunkRange->{lineCount}) {
|
|
# Addition; no lines existed before change.
|
|
return ($chunkRange->{startingLine}, $chunkRange->{startingLine});
|
|
}
|
|
return ($chunkRange->{startingLine}, $chunkRange->{startingLine} + $chunkRange->{lineCount} - 1);
|
|
}
|
|
|
|
sub testListForChangeLog(@)
|
|
{
|
|
my (@tests) = @_;
|
|
|
|
return "" unless @tests;
|
|
|
|
my $leadString = " Test" . (@tests == 1 ? "" : "s") . ": ";
|
|
my $list = $leadString;
|
|
foreach my $i (0..$#tests) {
|
|
$list .= " " x length($leadString) if $i;
|
|
my $test = $tests[$i];
|
|
$test =~ s/^LayoutTests\///;
|
|
$list .= "$test\n";
|
|
}
|
|
$list .= "\n";
|
|
|
|
return $list;
|
|
}
|
|
|
|
sub reviewerAndDescriptionForGitCommit($$)
|
|
{
|
|
my ($commit, $gitReviewer) = @_;
|
|
|
|
my $description = '';
|
|
my $reviewer;
|
|
|
|
my @args = qw(rev-list --pretty);
|
|
push @args, '-1' if $commit !~ m/.+\.\..+/;
|
|
my $gitLog;
|
|
{
|
|
local $/ = undef;
|
|
open(GITLOG, "-|", GIT, @args, $commit) || die;
|
|
$gitLog = <GITLOG>;
|
|
close(GITLOG);
|
|
}
|
|
|
|
my @commitLogs = split(/^[Cc]ommit [a-f0-9]{40}/m, $gitLog);
|
|
shift @commitLogs; # Remove initial blank commit log
|
|
my $commitLogCount = 0;
|
|
foreach my $commitLog (@commitLogs) {
|
|
$description .= "\n" if $commitLogCount;
|
|
$commitLogCount++;
|
|
my $inHeader = 1;
|
|
my $commitLogIndent;
|
|
my @lines = split(/\n/, $commitLog);
|
|
shift @lines; # Remove initial blank line
|
|
foreach my $line (@lines) {
|
|
if ($inHeader) {
|
|
if (!$line) {
|
|
$inHeader = 0;
|
|
}
|
|
next;
|
|
} elsif ($line =~ /[Ss]igned-[Oo]ff-[Bb]y: (.+)/) {
|
|
if (!$reviewer) {
|
|
$reviewer = $1;
|
|
} else {
|
|
$reviewer .= ", " . $1;
|
|
}
|
|
} elsif ($line =~ /^\s*$/) {
|
|
$description = $description . "\n";
|
|
} else {
|
|
if (!defined($commitLogIndent)) {
|
|
# Let the first line with non-white space determine
|
|
# the global indent.
|
|
$line =~ /^(\s*)\S/;
|
|
$commitLogIndent = length($1);
|
|
}
|
|
# Strip at most the indent to preserve relative indents.
|
|
$line =~ s/^\s{0,$commitLogIndent}//;
|
|
$description = $description . (" " x 8) . $line . "\n";
|
|
}
|
|
}
|
|
}
|
|
if (!$reviewer) {
|
|
$reviewer = $gitReviewer;
|
|
}
|
|
|
|
return ($reviewer, $description);
|
|
}
|
|
|
|
sub normalizeLineEndings($$)
|
|
{
|
|
my ($string, $endl) = @_;
|
|
$string =~ s/\r?\n/$endl/g;
|
|
return $string;
|
|
}
|
|
|
|
sub decodeEntities($)
|
|
{
|
|
my ($text) = @_;
|
|
$text =~ s/\</</g;
|
|
$text =~ s/\>/>/g;
|
|
$text =~ s/\"/\"/g;
|
|
$text =~ s/\'/\'/g;
|
|
$text =~ s/\&/\&/g;
|
|
return $text;
|
|
}
|