diff -r 000000000000 -r 4f2f89ce4247 WebKitTools/Scripts/prepare-ChangeLog --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/WebKitTools/Scripts/prepare-ChangeLog Fri Sep 17 09:02:29 2010 +0300 @@ -0,0 +1,1710 @@ +#!/usr/bin/perl -w +# -*- Mode: perl; indent-tabs-mode: nil; c-basic-offset: 2 -*- + +# +# Copyright (C) 2000, 2001 Eazel, Inc. +# Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007 Apple Inc. All rights reserved. +# Copyright (C) 2009 Torch Mobile, Inc. +# Copyright (C) 2009 Cameron McCormack +# +# 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 , started 20 April 2000 +# Java support added by Maciej Stachowiak +# Objective-C, C++ and Objective-C++ support added by Maciej Stachowiak +# Git support added by Adam Roben +# --git-index flag added by Joe Mason + + +# +# TODO: +# List functions that have been removed too. +# Decide what a good logical order is for the changed files +# other than a normal text "sort" (top level first?) +# (group directories?) (.h before .c?) +# Handle yacc source files too (other languages?). +# Help merge when there are ChangeLog conflicts or if there's +# already a partly written ChangeLog entry. +# Add command line option to put the ChangeLog into a separate file. +# Add SVN version numbers for commit (can't do that until +# the changes are checked in, though). +# Work around diff stupidity where deleting a function that starts +# with a comment makes diff think that the following function +# has been changed (if the following function starts with a comment +# with the same first line, such as /**) +# Work around diff stupidity where deleting an entire function and +# the blank lines before it makes diff think you've changed the +# previous function. + +use strict; +use warnings; + +use File::Basename; +use File::Spec; +use FindBin; +use Getopt::Long; +use lib $FindBin::Bin; +use POSIX qw(strftime); +use VCSUtils; + +sub changeLogDate($); +sub changeLogEmailAddressFromArgs($); +sub changeLogNameFromArgs($); +sub firstDirectoryOrCwd(); +sub diffFromToString(); +sub diffCommand(@); +sub statusCommand(@); +sub createPatchCommand($); +sub diffHeaderFormat(); +sub findOriginalFileFromSvn($); +sub determinePropertyChanges($$$); +sub pluralizeAndList($$@); +sub generateFileList(\@\@\%); +sub isUnmodifiedStatus($); +sub isModifiedStatus($); +sub isAddedStatus($); +sub isConflictStatus($); +sub statusDescription($$$$); +sub propertyChangeDescription($); +sub extractLineRange($); +sub testListForChangeLog(@); +sub get_function_line_ranges($$); +sub get_function_line_ranges_for_c($$); +sub get_function_line_ranges_for_java($$); +sub get_function_line_ranges_for_javascript($$); +sub get_selector_line_ranges_for_css($$); +sub method_decl_to_selector($); +sub processPaths(\@); +sub reviewerAndDescriptionForGitCommit($); +sub normalizeLineEndings($$); +sub decodeEntities($); + +# Project time zone for Cupertino, CA, US +my $changeLogTimeZone = "PST8PDT"; + +my $bugNumber; +my $name; +my $emailAddress; +my $mergeBase = 0; +my $gitCommit = 0; +my $gitIndex = ""; +my $gitReviewer = ""; +my $openChangeLogs = 0; +my $writeChangeLogs = 1; +my $showHelp = 0; +my $spewDiff = $ENV{"PREPARE_CHANGELOG_DIFF"}; +my $updateChangeLogs = 1; +my $parseOptionsResult = + GetOptions("diff|d!" => \$spewDiff, + "bug:i" => \$bugNumber, + "name:s" => \$name, + "email:s" => \$emailAddress, + "merge-base:s" => \$mergeBase, + "git-commit:s" => \$gitCommit, + "git-index" => \$gitIndex, + "git-reviewer:s" => \$gitReviewer, + "help|h!" => \$showHelp, + "open|o!" => \$openChangeLogs, + "write!" => \$writeChangeLogs, + "update!" => \$updateChangeLogs); +if (!$parseOptionsResult || $showHelp) { + print STDERR basename($0) . " [--bug] [-d|--diff] [-h|--help] [-o|--open] [--git-commit=] [--git-reviewer=] [svndir1 [svndir2 ...]]\n"; + print STDERR " --bug Fill in the ChangeLog bug information from the given bug.\n"; + print STDERR " -d|--diff Spew diff to stdout when running\n"; + print STDERR " --merge-base Populate the ChangeLogs with the diff to this branch\n"; + print STDERR " --git-commit Populate the ChangeLogs from the specified git commit\n"; + print STDERR " --git-index Populate the ChangeLogs from the git index only\n"; + print STDERR " --git-reviewer When populating the ChangeLogs from a git commit claim that the spcified name reviewed the change.\n"; + print STDERR " This option is useful when the git commit lacks a Signed-Off-By: line\n"; + print STDERR " -h|--help Show this help message\n"; + print STDERR " -o|--open Open ChangeLogs in an editor when done\n"; + print STDERR " --[no-]update Update ChangeLogs from svn before adding entry (default: update)\n"; + print STDERR " --[no-]write Write ChangeLogs to disk (otherwise send new entries to stdout) (default: write)\n"; + exit 1; +} + +die "--git-commit and --git-index are incompatible." if ($gitIndex && $gitCommit); + +my %paths = processPaths(@ARGV); + +my $isGit = isGitDirectory(firstDirectoryOrCwd()); +my $isSVN = isSVNDirectory(firstDirectoryOrCwd()); + +$isSVN || $isGit || die "Couldn't determine your version control system."; + +my $SVN = "svn"; +my $GIT = "git"; + +# Find the list of modified files +my @changed_files; +my $changed_files_string; +my %changed_line_ranges; +my %function_lists; +my @conflict_files; + + +my %supportedTestExtensions = map { $_ => 1 } qw(html shtml svg xml xhtml pl php); +my @addedRegressionTests = (); +my $didChangeRegressionTests = 0; + +generateFileList(@changed_files, @conflict_files, %function_lists); + +if (!@changed_files && !@conflict_files && !keys %function_lists) { + print STDERR " No changes found.\n"; + exit 1; +} + +if (@conflict_files) { + print STDERR " The following files have conflicts. Run prepare-ChangeLog again after fixing the conflicts:\n"; + print STDERR join("\n", @conflict_files), "\n"; + exit 1; +} + +if (@changed_files) { + $changed_files_string = "'" . join ("' '", @changed_files) . "'"; + + # For each file, build a list of modified lines. + # Use line numbers from the "after" side of each diff. + print STDERR " Reviewing diff to determine which lines changed.\n"; + my $file; + open DIFF, "-|", diffCommand(@changed_files) or die "The diff failed: $!.\n"; + while () { + $file = makeFilePathRelative($1) if $_ =~ diffHeaderFormat(); + if (defined $file) { + my ($start, $end) = extractLineRange($_); + if ($start >= 0 && $end >= 0) { + push @{$changed_line_ranges{$file}}, [ $start, $end ]; + } elsif (/DO_NOT_COMMIT/) { + print STDERR "WARNING: file $file contains the string DO_NOT_COMMIT, line $.\n"; + } + } + } + close DIFF; +} + +# For each source file, convert line range to function list. +if (%changed_line_ranges) { + print STDERR " Extracting affected function names from source files.\n"; + foreach my $file (keys %changed_line_ranges) { + # Only look for function names in certain source files. + next unless $file =~ /\.(c|cpp|m|mm|h|java|js)/; + + # Find all the functions in the file. + open SOURCE, $file or next; + my @function_ranges = get_function_line_ranges(\*SOURCE, $file); + close SOURCE; + + # Find all the modified functions. + my @functions; + my %saw_function; + my @change_ranges = (@{$changed_line_ranges{$file}}, []); + my @change_range = (0, 0); + FUNCTION: foreach my $function_range_ref (@function_ranges) { + my @function_range = @$function_range_ref; + + # Advance to successive change ranges. + for (;; @change_range = @{shift @change_ranges}) { + last FUNCTION unless @change_range; + + # If past this function, move on to the next one. + next FUNCTION if $change_range[0] > $function_range[1]; + + # If an overlap with this function range, record the function name. + if ($change_range[1] >= $function_range[0] + and $change_range[0] <= $function_range[1]) { + if (!$saw_function{$function_range[2]}) { + $saw_function{$function_range[2]} = 1; + push @functions, $function_range[2]; + } + next FUNCTION; + } + } + } + + # Format the list of functions now. + + if (@functions) { + $function_lists{$file} = "" if !defined $function_lists{$file}; + $function_lists{$file} .= "\n (" . join("):\n (", @functions) . "):"; + } + } +} + +# Get some parameters for the ChangeLog we are about to write. +my $date = changeLogDate($changeLogTimeZone); +$name = changeLogNameFromArgs($name); +$emailAddress = changeLogEmailAddressFromArgs($emailAddress); + +print STDERR " Change author: $name <$emailAddress>.\n"; + +my $bugDescription; +my $bugURL; +if ($bugNumber) { + $bugURL = "https://bugs.webkit.org/show_bug.cgi?id=$bugNumber"; + my $bugXMLURL = "$bugURL&ctype=xml"; + # Perl has no built in XML processing, so we'll fetch and parse with curl and grep + # Pass --insecure because some cygwin installs have no certs we don't + # care about validating that bugs.webkit.org is who it says it is here. + my $descriptionLine = `curl --insecure --silent "$bugXMLURL" | grep short_desc`; + if ($descriptionLine !~ /(.*)<\/short_desc>/) { + print STDERR " Bug $bugNumber has no bug description. Maybe you set wrong bug ID?\n"; + print STDERR " The bug URL: $bugXMLURL\n"; + exit 1; + } + $bugDescription = decodeEntities($1); + print STDERR " Description from bug $bugNumber:\n \"$bugDescription\".\n"; +} + +# Remove trailing parenthesized notes from user name (bit of hack). +$name =~ s/\(.*?\)\s*$//g; + +# Find the change logs. +my %has_log; +my %files; +foreach my $file (sort keys %function_lists) { + my $prefix = $file; + my $has_log = 0; + while ($prefix) { + $prefix =~ s-/[^/]+/?$-/- or $prefix = ""; + $has_log = $has_log{$prefix}; + if (!defined $has_log) { + $has_log = -f "${prefix}ChangeLog"; + $has_log{$prefix} = $has_log; + } + last if $has_log; + } + if (!$has_log) { + print STDERR "No ChangeLog found for $file.\n"; + } else { + push @{$files{$prefix}}, $file; + } +} + +# Build the list of ChangeLog prefixes in the correct project order +my @prefixes; +my %prefixesSort; +foreach my $prefix (keys %files) { + my $prefixDir = substr($prefix, 0, length($prefix) - 1); # strip trailing / + my $sortKey = lc $prefix; + $sortKey = "top level" unless length $sortKey; + + if ($prefixDir eq "top level") { + $sortKey = ""; + } elsif ($prefixDir eq "Tools") { + $sortKey = "-, just after top level"; + } elsif ($prefixDir eq "WebBrowser") { + $sortKey = lc "WebKit, WebBrowser after"; + } elsif ($prefixDir eq "WebCore") { + $sortKey = lc "WebFoundation, WebCore after"; + } elsif ($prefixDir eq "LayoutTests") { + $sortKey = lc "~, LayoutTests last"; + } + + $prefixesSort{$sortKey} = $prefix; +} +foreach my $prefixSort (sort keys %prefixesSort) { + push @prefixes, $prefixesSort{$prefixSort}; +} + +# Get the latest ChangeLog files from svn. +my @logs = (); +foreach my $prefix (@prefixes) { + push @logs, File::Spec->catfile($prefix || ".", "ChangeLog"); +} + +if (@logs && $updateChangeLogs && $isSVN) { + print STDERR " Running 'svn update' to update ChangeLog files.\n"; + open ERRORS, "-|", $SVN, "update", @logs + or die "The svn update of ChangeLog files failed: $!.\n"; + my @conflictedChangeLogs; + while (my $line = ) { + print STDERR " ", $line; + push @conflictedChangeLogs, $1 if $line =~ m/^C\s+(.+?)[\r\n]*$/; + } + close ERRORS; + + if (@conflictedChangeLogs) { + print STDERR " Attempting to merge conflicted ChangeLogs.\n"; + my $resolveChangeLogsPath = File::Spec->catfile(dirname($0), "resolve-ChangeLogs"); + open RESOLVE, "-|", $resolveChangeLogsPath, "--no-warnings", @conflictedChangeLogs + or die "Could not open resolve-ChangeLogs script: $!.\n"; + print STDERR " $_" while ; + close RESOLVE; + } +} + +# Generate new ChangeLog entries and (optionally) write out new ChangeLog files. +foreach my $prefix (@prefixes) { + my $endl = "\n"; + my @old_change_log; + + if ($writeChangeLogs) { + my $changeLogPath = File::Spec->catfile($prefix || ".", "ChangeLog"); + print STDERR " Editing the ${changeLogPath} file.\n"; + open OLD_CHANGE_LOG, ${changeLogPath} or die "Could not open ${changeLogPath} file: $!.\n"; + # It's less efficient to read the whole thing into memory than it would be + # to read it while we prepend to it later, but I like doing this part first. + @old_change_log = ; + close OLD_CHANGE_LOG; + # We want to match the ChangeLog's line endings in case it doesn't match + # the native line endings for this version of perl. + if ($old_change_log[0] =~ /(\r?\n)$/g) { + $endl = "$1"; + } + open CHANGE_LOG, "> ${changeLogPath}" or die "Could not write ${changeLogPath}\n."; + } else { + open CHANGE_LOG, ">-" or die "Could not write to STDOUT\n."; + print substr($prefix, 0, length($prefix) - 1) . ":\n\n" unless (scalar @prefixes) == 1; + } + + print CHANGE_LOG normalizeLineEndings("$date $name <$emailAddress>\n\n", $endl); + + my ($reviewer, $description) = reviewerAndDescriptionForGitCommit($gitCommit) if $gitCommit; + $reviewer = "NOBODY (OO" . "PS!)" if !$reviewer; + + print CHANGE_LOG normalizeLineEndings(" Reviewed by $reviewer.\n\n", $endl); + print CHANGE_LOG normalizeLineEndings($description . "\n", $endl) if $description; + + $bugDescription = "Need a short description and bug URL (OOPS!)" unless $bugDescription; + print CHANGE_LOG normalizeLineEndings(" $bugDescription\n", $endl) if $bugDescription; + print CHANGE_LOG normalizeLineEndings(" $bugURL\n", $endl) if $bugURL; + print CHANGE_LOG normalizeLineEndings("\n", $endl); + + if ($prefix =~ m/WebCore/ || `pwd` =~ m/WebCore/) { + if ($didChangeRegressionTests) { + print CHANGE_LOG normalizeLineEndings(testListForChangeLog(sort @addedRegressionTests), $endl); + } else { + print CHANGE_LOG normalizeLineEndings(" No new tests. (OOPS!)\n\n", $endl); + } + } + + foreach my $file (sort @{$files{$prefix}}) { + my $file_stem = substr $file, length $prefix; + print CHANGE_LOG normalizeLineEndings(" * $file_stem:$function_lists{$file}\n", $endl); + } + + if ($writeChangeLogs) { + print CHANGE_LOG normalizeLineEndings("\n", $endl), @old_change_log; + } else { + print CHANGE_LOG "\n"; + } + + close CHANGE_LOG; +} + +if ($writeChangeLogs) { + print STDERR "-- Please remember to include a detailed description in your ChangeLog entry. --\n-- See for more info --\n"; +} + +# Write out another diff. +if ($spewDiff && @changed_files) { + print STDERR " Running diff to help you write the ChangeLog entries.\n"; + local $/ = undef; # local slurp mode + open DIFF, "-|", createPatchCommand($changed_files_string) or die "The diff failed: $!.\n"; + print ; + close DIFF; +} + +# Open ChangeLogs. +if ($openChangeLogs && @logs) { + print STDERR " Opening the edited ChangeLog files.\n"; + my $editor = $ENV{"CHANGE_LOG_EDIT_APPLICATION"}; + if ($editor) { + system "open", "-a", $editor, @logs; + } else { + system "open", "-e", @logs; + } +} + +# Done. +exit; + + +sub changeLogDate($) +{ + my ($timeZone) = @_; + my $savedTimeZone = $ENV{'TZ'}; + # Set TZ temporarily so that localtime() is in that time zone + $ENV{'TZ'} = $timeZone; + my $date = strftime("%Y-%m-%d", localtime()); + if (defined $savedTimeZone) { + $ENV{'TZ'} = $savedTimeZone; + } else { + delete $ENV{'TZ'}; + } + return $date; +} + +sub changeLogNameFromArgs($) +{ + my ($nameFromArgs) = @_; + # Silently allow --git-commit to win, we could warn if $nameFromArgs is defined. + return `$GIT log --max-count=1 --pretty=\"format:%an\" \"$gitCommit\"` if $gitCommit; + + return $nameFromArgs || changeLogName(); +} + +sub changeLogEmailAddressFromArgs($) +{ + my ($emailAddressFromArgs) = @_; + # Silently allow --git-commit to win, we could warn if $emailAddressFromArgs is defined. + return `$GIT log --max-count=1 --pretty=\"format:%ae\" \"$gitCommit\"` if $gitCommit; + + return $emailAddressFromArgs || changeLogEmailAddress(); +} + +sub get_function_line_ranges($$) +{ + my ($file_handle, $file_name) = @_; + + if ($file_name =~ /\.(c|cpp|m|mm|h)$/) { + return get_function_line_ranges_for_c ($file_handle, $file_name); + } elsif ($file_name =~ /\.java$/) { + return get_function_line_ranges_for_java ($file_handle, $file_name); + } elsif ($file_name =~ /\.js$/) { + return get_function_line_ranges_for_javascript ($file_handle, $file_name); + } elsif ($file_name =~ /\.css$/) { + return get_selector_line_ranges_for_css ($file_handle, $file_name); + } + return (); +} + + +sub method_decl_to_selector($) +{ + (my $method_decl) = @_; + + $_ = $method_decl; + + if ((my $comment_stripped) = m-([^/]*)(//|/*).*-) { + $_ = $comment_stripped; + } + + s/,\s*...//; + + if (/:/) { + my @components = split /:/; + pop @components if (scalar @components > 1); + $_ = (join ':', map {s/.*[^[:word:]]//; scalar $_;} @components) . ':'; + } else { + s/\s*$//; + s/.*[^[:word:]]//; + } + + return $_; +} + + + +# Read a file and get all the line ranges of the things that look like C functions. +# A function name is the last word before an open parenthesis before the outer +# level open brace. A function starts at the first character after the last close +# brace or semicolon before the function name and ends at the close brace. +# Comment handling is simple-minded but will work for all but pathological cases. +# +# Result is a list of triples: [ start_line, end_line, function_name ]. + +sub get_function_line_ranges_for_c($$) +{ + my ($file_handle, $file_name) = @_; + + my @ranges; + + my $in_comment = 0; + my $in_macro = 0; + my $in_method_declaration = 0; + my $in_parentheses = 0; + my $in_braces = 0; + my $brace_start = 0; + my $brace_end = 0; + my $skip_til_brace_or_semicolon = 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; + + 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.*--; + } + } + } + + + # 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) { + # interface name + if ($2) { + $interface_name = $2; + next; + } + + # Open parenthesis. + if ($1 eq "(") { + $potential_name = $word unless $in_parentheses || $skip_til_brace_or_semicolon; + $in_parentheses++; + next; + } + + # Close parenthesis. + if ($1 eq ")") { + $in_parentheses--; + 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 ($potential_namespace) { + push @namespaces, $potential_namespace; + $potential_namespace = ""; + next; + } + + # Promote potential name to real function name at the + # start of the outer level set of braces (function body?). + if (!$in_braces and $potential_start) { + $start = $potential_start; + $name = $potential_name; + if (@namespaces && (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) { + pop @namespaces; + 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) { + push @ranges, [ $start, $., $name ]; + $name = ""; + } + + $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 @ranges; +} + + + +# 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 $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 "{") { + # 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" or $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. +# +# 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. +# +# An anonymous function name is the identifier chain immediately before +# an assignment with the equals operator or object notation that has a +# value starting with `function' followed by an open curly brace. +# +# A getter or setter name is the word that immediately follows `get' or +# `set' when followed by an open curly 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_javascript($$) +{ + my ($fileHandle, $fileName) = @_; + + my @currentScopes; + my @currentIdentifiers; + my @currentFunctionNames; + my @currentFunctionDepths; + my @currentFunctionStartLines; + + my @ranges; + + my $inComment = 0; + my $inQuotedText = ""; + my $parenthesesDepth = 0; + my $bracesDepth = 0; + + my $functionJustSeen = 0; + my $getterJustSeen = 0; + my $setterJustSeen = 0; + my $assignmentJustSeen = 0; + + 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--) { + $inQuotedText = $match if /\\$/; + warn "mismatched quotes at line $. in $fileName\n" if $inQuotedText eq ""; + s-$match.*--; + } + } + } + + # Find function names. + while (m-(\w+|[(){}=:;])-g) { + # Open parenthesis. + if ($1 eq '(') { + $parenthesesDepth++; + next; + } + + # Close parenthesis. + if ($1 eq ')') { + $parenthesesDepth--; + next; + } + + # Open brace. + if ($1 eq '{') { + push(@currentScopes, join(".", @currentIdentifiers)); + @currentIdentifiers = (); + + $bracesDepth++; + next; + } + + # Close brace. + if ($1 eq '}') { + $bracesDepth--; + + if (@currentFunctionDepths and $bracesDepth == $currentFunctionDepths[$#currentFunctionDepths]) { + pop(@currentFunctionDepths); + + my $currentFunction = pop(@currentFunctionNames); + my $start = pop(@currentFunctionStartLines); + + push(@ranges, [$start, $., $currentFunction]); + } + + pop(@currentScopes); + @currentIdentifiers = (); + + next; + } + + # Semicolon. + if ($1 eq ';') { + @currentIdentifiers = (); + next; + } + + # Function. + if ($1 eq 'function') { + $functionJustSeen = 1; + + if ($assignmentJustSeen) { + my $currentFunction = join('.', (@currentScopes, @currentIdentifiers)); + $currentFunction =~ s/\.{2,}/\./g; # Removes consecutive periods. + + push(@currentFunctionNames, $currentFunction); + push(@currentFunctionDepths, $bracesDepth); + push(@currentFunctionStartLines, $.); + } + + next; + } + + # Getter prefix. + if ($1 eq 'get') { + $getterJustSeen = 1; + next; + } + + # Setter prefix. + if ($1 eq 'set') { + $setterJustSeen = 1; + next; + } + + # Assignment operator. + if ($1 eq '=' or $1 eq ':') { + $assignmentJustSeen = 1; + next; + } + + next if $parenthesesDepth; + + # Word. + $word = $1; + $word = "get $word" if $getterJustSeen; + $word = "set $word" if $setterJustSeen; + + if (($functionJustSeen and !$assignmentJustSeen) or $getterJustSeen or $setterJustSeen) { + push(@currentIdentifiers, $word); + + my $currentFunction = join('.', (@currentScopes, @currentIdentifiers)); + $currentFunction =~ s/\.{2,}/\./g; # Removes consecutive periods. + + 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); + } + + $functionJustSeen = 0; + $getterJustSeen = 0; + $setterJustSeen = 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 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. +# FIXME: Comments are parsed just like uncommented text. +# +# Result is a list of triples: [ start_line, end_line, selector ]. + +sub get_selector_line_ranges_for_css($$) +{ + my ($fileHandle, $fileName) = @_; + + my @ranges; + + my $currentSelector = ""; + my $start = 0; + + while (<$fileHandle>) { + if (/^[ \t]*(.*[^ \t])[ \t]*{/) { + $currentSelector = $1; + $start = $.; + } + if (index($_, "}") >= 0) { + unless ($start) { + warn "mismatched braces in $fileName\n"; + next; + } + push(@ranges, [$start, $., $currentSelector]); + $currentSelector = ""; + $start = 0; + next; + } + } + + return @ranges; +} + +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() +{ + 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 = @_; + + my $pathsString = "'" . join("' '", @paths) . "'"; + + my $command; + if ($isSVN) { + $command = "$SVN diff --diff-cmd diff -x -N $pathsString"; + } elsif ($isGit) { + $command = "$GIT diff --no-ext-diff -U0 " . diffFromToString(); + $command .= " -- $pathsString" unless $gitCommit or $mergeBase; + } + + return $command; +} + +sub statusCommand(@) +{ + my @files = @_; + + my $filesString = "'" . join ("' '", @files) . "'"; + my $command; + if ($isSVN) { + $command = "$SVN stat $filesString"; + } elsif ($isGit) { + $command = "$GIT diff -r --name-status -C -C -M " . diffFromToString(); + $command .= " -- $filesString" unless $gitCommit; + } + + return "$command 2>&1"; +} + +sub createPatchCommand($) +{ + my ($changedFilesString) = @_; + + my $command; + if ($isSVN) { + $command = "'$FindBin::Bin/svn-create-patch' $changedFilesString"; + } elsif ($isGit) { + $command = "$GIT diff -C -C -M " . diffFromToString(); + $command .= " -- $changedFilesString" unless $gitCommit; + } + + return $command; +} + +sub diffHeaderFormat() +{ + return qr/^Index: (\S+)[\r\n]*$/ if $isSVN; + return qr/^diff --git a\/.+ b\/(.+)$/ if $isGit; +} + +sub findOriginalFileFromSvn($) +{ + my ($file) = @_; + my $baseUrl; + open INFO, "$SVN info . |" or die; + while () { + if (/^URL: (.+?)[\r\n]*$/) { + $baseUrl = $1; + } + } + close INFO; + my $sourceFile; + open INFO, "$SVN info '$file' |" or die; + while () { + if (/^Copied From URL: (.+?)[\r\n]*$/) { + $sourceFile = File::Spec->abs2rel($1, $baseUrl); + } + } + close INFO; + return $sourceFile; +} + +sub determinePropertyChanges($$$) +{ + my ($file, $isAdd, $original) = @_; + + my %changes; + if ($isAdd) { + my %addedProperties; + my %removedProperties; + open PROPLIST, "$SVN proplist '$file' |" or die; + while () { + $addedProperties{$1} = 1 if /^ (.+?)[\r\n]*$/ && $1 ne 'svn:mergeinfo'; + } + close PROPLIST; + if ($original) { + open PROPLIST, "$SVN proplist '$original' |" or die; + while () { + 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 '$file' |" or die; + while () { + if (/^Property changes on:/) { + while () { + 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 ($changedFiles, $conflictFiles, $functionLists) = @_; + print STDERR " Running status to find changed, added, or removed files.\n"; + open STAT, "-|", statusCommand(keys %paths) or die "The status failed: $!.\n"; + while () { + 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") { + $didChangeRegressionTests = 1; + push @addedRegressionTests, $file + if isAddedStatus($status) + && $file =~ /\.([a-zA-Z]+)$/ + && $supportedTestExtensions{lc($1)} + && !scalar(grep(/^resources$/i, @components)) + && !scalar(grep(/^script-tests$/i, @components)); + } + push @{$changedFiles}, $file if $components[$#components] ne "ChangeLog"; + } elsif (isConflictStatus($status) || isConflictStatus($propertyStatus)) { + push @{$conflictFiles}, $file; + } + if (basename($file) ne "ChangeLog") { + my $description = statusDescription($status, $propertyStatus, $original, $propertyChanges); + $functionLists->{$file} = $description if defined $description; + } + } + close STAT; +} + +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) = @_; + + 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 ? " Copied from \%s." : " Added.", + "D" => " Removed.", + "M" => "", + "R" => defined $original ? " Replaced with \%s." : " Replaced.", + " " => "", + ); + + my %git = %svn; + $git{"A"} = " Added."; + $git{"C"} = " Copied from \%s."; + $git{"R"} = " Renamed from \%s."; + + my $description; + $description = sprintf($svn{$status}, $original) if $isSVN && exists $svn{$status}; + $description = sprintf($git{$status}, $original) 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 extractLineRange($) +{ + my ($string) = @_; + + my ($start, $end) = (-1, -1); + + if ($isSVN && $string =~ /^\d+(,\d+)?[acd](\d+)(,(\d+))?/) { + $start = $2; + $end = $4 || $2; + } elsif ($isGit && $string =~ /^@@ -\d+(,\d+)? \+(\d+)(,(\d+))? @@/) { + $start = $2; + $end = defined($4) ? $4 + $2 - 1 : $2; + } + + return ($start, $end); +} + +sub firstDirectoryOrCwd() +{ + my $dir = "."; + my @dirs = keys(%paths); + + $dir = -d $dirs[0] ? $dirs[0] : dirname($dirs[0]) if @dirs; + + return $dir; +} + +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) = @_; + + my $description = ''; + my $reviewer; + + my @args = qw(rev-list --pretty); + push @args, '-1' if $commit !~ m/.+\.\..+/; + my $gitLog; + { + local $/ = undef; + open(GIT, "-|", $GIT, @args, $commit) || die; + $gitLog = ; + close(GIT); + } + + 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; + return $text; +}