summaryrefslogtreecommitdiffstats
path: root/WebKitTools/Scripts/prepare-ChangeLog
diff options
context:
space:
mode:
Diffstat (limited to 'WebKitTools/Scripts/prepare-ChangeLog')
-rwxr-xr-xWebKitTools/Scripts/prepare-ChangeLog1436
1 files changed, 0 insertions, 1436 deletions
diff --git a/WebKitTools/Scripts/prepare-ChangeLog b/WebKitTools/Scripts/prepare-ChangeLog
deleted file mode 100755
index ff4ce80..0000000
--- a/WebKitTools/Scripts/prepare-ChangeLog
+++ /dev/null
@@ -1,1436 +0,0 @@
-#!/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.
-#
-# 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>
-
-
-#
-# 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 or just spew it out stdout.
-# 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 firstDirectoryOrCwd();
-sub diffFromToString();
-sub diffCommand(@);
-sub statusCommand(@);
-sub createPatchCommand($);
-sub diffHeaderFormat();
-sub findOriginalFileFromSvn($);
-sub generateFileList(\@\@\%);
-sub gitConfig($);
-sub isModifiedStatus($);
-sub isAddedStatus($);
-sub isConflictStatus($);
-sub statusDescription($$);
-sub extractLineRange($);
-sub canonicalizePath($);
-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 method_decl_to_selector($);
-sub processPaths(\@);
-sub reviewerAndDescriptionForGitCommit($);
-
-# Project time zone for Cupertino, CA, US
-my $changeLogTimeZone = "PST8PDT";
-
-my $gitCommit = 0;
-my $gitReviewer = "";
-my $openChangeLogs = 0;
-my $showHelp = 0;
-my $spewDiff = $ENV{"PREPARE_CHANGELOG_DIFF"};
-my $updateChangeLogs = 1;
-my $parseOptionsResult =
- GetOptions("diff|d!" => \$spewDiff,
- "git-commit:s" => \$gitCommit,
- "git-reviewer:s" => \$gitReviewer,
- "help|h!" => \$showHelp,
- "open|o!" => \$openChangeLogs,
- "update!" => \$updateChangeLogs);
-if (!$parseOptionsResult || $showHelp) {
- print STDERR basename($0) . " [-d|--diff] [-h|--help] [-o|--open] [--git-commit=<committish>] [--git-reviewer=<name>] [svndir1 [svndir2 ...]]\n";
- print STDERR " -d|--diff Spew diff to stdout when running\n";
- print STDERR " --git-commit Populate the ChangeLogs from the specified git commit\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";
- exit 1;
-}
-
-my %paths = processPaths(@ARGV);
-
-my $isGit = isGitDirectory(firstDirectoryOrCwd());
-my $isSVN = isSVNDirectory(firstDirectoryOrCwd());
-
-$isSVN || $isGit || die "Couldn't determine your version control system.";
-
-# Find the list of modified files
-my @changed_files;
-my $changed_files_string;
-my %changed_line_ranges;
-my %function_lists;
-my @conflict_files;
-
-my $SVN = "svn";
-my $GIT = "git";
-
-my %supportedTestExtensions = map { $_ => 1 } qw(html shtml svg xml xhtml pl php);
-my @addedRegressionTests = ();
-my $didChangeRegressionTests = 0;
-
-generateFileList(@changed_files, @conflict_files, %function_lists);
-
-if (!@changed_files && !@conflict_files && !keys %function_lists) {
- print STDERR " No changes found.\n";
- exit 1;
-}
-
-if (@conflict_files) {
- print STDERR " The following files have conflicts. Run prepare-ChangeLog again after fixing the conflicts:\n";
- print STDERR join("\n", @conflict_files), "\n";
- exit 1;
-}
-
-if (@changed_files) {
- $changed_files_string = "'" . join ("' '", @changed_files) . "'";
-
- # For each file, build a list of modified lines.
- # Use line numbers from the "after" side of each diff.
- print STDERR " Reviewing diff to determine which lines changed.\n";
- my $file;
- open DIFF, "-|", diffCommand(@changed_files) or die "The diff failed: $!.\n";
- while (<DIFF>) {
- $file = makeFilePathRelative($1) if $_ =~ diffHeaderFormat();
- if (defined $file) {
- my ($start, $end) = extractLineRange($_);
- if ($start >= 0 && $end >= 0) {
- push @{$changed_line_ranges{$file}}, [ $start, $end ];
- } elsif (/DO_NOT_COMMIT/) {
- print STDERR "WARNING: file $file contains the string DO_NOT_COMMIT, line $.\n";
- }
- }
- }
- close DIFF;
-}
-
-# For each source file, convert line range to function list.
-if (%changed_line_ranges) {
- print STDERR " Extracting affected function names from source files.\n";
- foreach my $file (keys %changed_line_ranges) {
- # Only look for function names in certain source files.
- next unless $file =~ /\.(c|cpp|m|mm|h|java|js)/;
-
- # Find all the functions in the file.
- open SOURCE, $file or next;
- my @function_ranges = get_function_line_ranges(\*SOURCE, $file);
- close SOURCE;
-
- # Find all the modified functions.
- my @functions;
- my %saw_function;
- my @change_ranges = (@{$changed_line_ranges{$file}}, []);
- my @change_range = (0, 0);
- FUNCTION: foreach my $function_range_ref (@function_ranges) {
- my @function_range = @$function_range_ref;
-
- # Advance to successive change ranges.
- for (;; @change_range = @{shift @change_ranges}) {
- last FUNCTION unless @change_range;
-
- # If past this function, move on to the next one.
- next FUNCTION if $change_range[0] > $function_range[1];
-
- # If an overlap with this function range, record the function name.
- if ($change_range[1] >= $function_range[0]
- and $change_range[0] <= $function_range[1]) {
- if (!$saw_function{$function_range[2]}) {
- $saw_function{$function_range[2]} = 1;
- push @functions, $function_range[2];
- }
- next FUNCTION;
- }
- }
- }
-
- # Format the list of functions now.
-
- if (@functions) {
- $function_lists{$file} = "" if !defined $function_lists{$file};
- $function_lists{$file} .= "\n (" . join("):\n (", @functions) . "):";
- }
- }
-}
-
-# Get some parameters for the ChangeLog we are about to write.
-my $date = changeLogDate($changeLogTimeZone);
-my $name = $ENV{CHANGE_LOG_NAME}
- || $ENV{REAL_NAME}
- || gitConfig("user.name")
- || (split /\s*,\s*/, (getpwuid $<)[6])[0]
- || "set REAL_NAME environment variable";
-my $email_address = $ENV{CHANGE_LOG_EMAIL_ADDRESS}
- || $ENV{EMAIL_ADDRESS}
- || gitConfig("user.email")
- || "set EMAIL_ADDRESS environment variable";
-
-if ($gitCommit) {
- $name = `$GIT log --max-count=1 --pretty=\"format:%an\" \"$gitCommit\"`;
- $email_address = `$GIT log --max-count=1 --pretty=\"format:%ae\" \"$gitCommit\"`;
-}
-
-# 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;
- }
-}
-
-# Get the latest ChangeLog files from svn.
-my @logs = ();
-foreach my $prefix (sort keys %files) {
- push @logs, File::Spec->catfile($prefix || ".", "ChangeLog");
-}
-
-if (@logs && $updateChangeLogs && $isSVN) {
- print STDERR " Running 'svn update' to update ChangeLog files.\n";
- open ERRORS, "-|", $SVN, "update", @logs
- or die "The svn update of ChangeLog files failed: $!.\n";
- my @conflictedChangeLogs;
- while (my $line = <ERRORS>) {
- print STDERR " ", $line;
- push @conflictedChangeLogs, $1 if $line =~ m/^C\s+(.+)\s*$/;
- }
- close ERRORS;
-
- if (@conflictedChangeLogs) {
- print STDERR " Attempting to merge conflicted ChangeLogs.\n";
- my $resolveChangeLogsPath = File::Spec->catfile(dirname($0), "resolve-ChangeLogs");
- open RESOLVE, "-|", $resolveChangeLogsPath, "--no-warnings", @conflictedChangeLogs
- or die "Could not open resolve-ChangeLogs script: $!.\n";
- print STDERR " $_" while <RESOLVE>;
- close RESOLVE;
- }
-}
-
-# Write out a new ChangeLog file.
-foreach my $prefix (sort keys %files) {
- 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.
- my @old_change_log = <OLD_CHANGE_LOG>;
- close OLD_CHANGE_LOG;
- open CHANGE_LOG, "> ${changeLogPath}" or die "Could not write ${changeLogPath}\n.";
- print CHANGE_LOG "$date $name <$email_address>\n\n";
-
- my ($reviewer, $description) = reviewerAndDescriptionForGitCommit($gitCommit) if $gitCommit;
- $reviewer = "NOBODY (OO" . "PS!)" if !$reviewer;
-
- print CHANGE_LOG " Reviewed by $reviewer.\n\n";
- print CHANGE_LOG $description . "\n" if $description;
-
- if ($prefix =~ m/WebCore/ || `pwd` =~ m/WebCore/) {
- if ($didChangeRegressionTests) {
- print CHANGE_LOG testListForChangeLog(sort @addedRegressionTests);
- } else {
- print CHANGE_LOG " WARNING: NO TEST CASES ADDED OR CHANGED\n\n";
- }
- }
-
- foreach my $file (sort @{$files{$prefix}}) {
- my $file_stem = substr $file, length $prefix;
- print CHANGE_LOG " * $file_stem:$function_lists{$file}\n";
- }
- print CHANGE_LOG "\n", @old_change_log;
- close CHANGE_LOG;
-}
-
-# Write out another diff.
-if ($spewDiff && @changed_files) {
- print STDERR " Running diff to help you write the ChangeLog entries.\n";
- local $/ = undef; # local slurp mode
- open DIFF, "-|", createPatchCommand($changed_files_string) or die "The diff failed: $!.\n";
- print <DIFF>;
- close DIFF;
-}
-
-# Open ChangeLogs.
-if ($openChangeLogs && @logs) {
- print STDERR " Opening the edited ChangeLog files.\n";
- my $editor = $ENV{"CHANGE_LOG_EDIT_APPLICATION"};
- if ($editor) {
- system "open", "-a", $editor, @logs;
- } else {
- system "open", "-e", @logs;
- }
-}
-
-# Done.
-exit;
-
-sub canonicalizePath($)
-{
- my ($file) = @_;
-
- # Remove extra slashes and '.' directories in path
- $file = File::Spec->canonpath($file);
-
- # Remove '..' directories in path
- my @dirs = ();
- foreach my $dir (File::Spec->splitdir($file)) {
- if ($dir eq '..' && $#dirs >= 0 && $dirs[$#dirs] ne '..') {
- pop(@dirs);
- } else {
- push(@dirs, $dir);
- }
- }
- return ($#dirs >= 0) ? File::Spec->catdir(@dirs) : ".";
-}
-
-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 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);
- }
- 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 $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 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--) {
- warn "mismatched quotes at line $. in $fileName\n";
- 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;
-}
-
-
-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 "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 -U0 " . diffFromToString();
- $command .= " -- $pathsString" unless $gitCommit;
- }
-
- 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+)$/ if $isSVN;
- return qr/^diff --git a\/.+ b\/(.+)$/ if $isGit;
-}
-
-sub findOriginalFileFromSvn($)
-{
- my ($file) = @_;
- my $baseUrl;
- open INFO, "$SVN info . |" or die;
- while (<INFO>) {
- if (/^URL: (.+)/) {
- $baseUrl = $1;
- last;
- }
- }
- close INFO;
- my $sourceFile;
- open INFO, "$SVN info '$file' |" or die;
- while (<INFO>) {
- if (/^Copied From URL: (.+)/) {
- $sourceFile = File::Spec->abs2rel($1, $baseUrl);
- last;
- }
- }
- close INFO;
- return $sourceFile;
-}
-
-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";
- my $inGitCommitSection = 0;
- while (<STAT>) {
- my $status;
- my $original;
- my $file;
-
- if ($isSVN) {
- if (/^([ACDMR]).{5} (.+)$/) {
- $status = $1;
- $file = $2;
- $original = findOriginalFileFromSvn($file) if substr($_, 3, 1) eq "+";
- } else {
- print; # error output from svn stat
- }
- } elsif ($isGit) {
- if (/^([ADM])\t(.+)$/) {
- $status = $1;
- $file = $2;
- } elsif (/^([CR])[0-9]{1,3}\t([^\t]+)\t([^\t\n]+)$/) { # for example: R90% newfile oldfile
- $status = $1;
- $original = $2;
- $file = $3;
- } else {
- print; # error output from git diff
- }
- }
-
- next unless $status;
-
- $file = makeFilePathRelative($file);
-
- if (isModifiedStatus($status) || isAddedStatus($status)) {
- 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));
- }
- push @{$changedFiles}, $file if $components[$#components] ne "ChangeLog";
- } elsif (isConflictStatus($status)) {
- push @{$conflictFiles}, $file;
- }
- if (basename($file) ne "ChangeLog") {
- my $description = statusDescription($status, $original);
- $functionLists->{$file} = $description if defined $description;
- }
- }
- close STAT;
-}
-
-sub gitConfig($)
-{
- return unless $isGit;
-
- my ($config) = @_;
-
- my $result = `$GIT config $config`;
- if (($? >> 8) != 0) {
- $result = `$GIT repo-config $config`;
- }
- chomp $result;
- return $result;
-}
-
-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; # an existing commit cannot have conflicts
- return $svn{$status} if $isSVN;
- return $git{$status} if $isGit;
-}
-
-sub statusDescription($$)
-{
- my ($status, $original) = @_;
-
- 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.";
-
- return sprintf($svn{$status}, $original) if $isSVN && exists $svn{$status};
- return sprintf($git{$status}, $original) if $isGit && exists $git{$status};
- return undef;
-}
-
-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 = <GIT>;
- 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 @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 (length $line == 0) {
- $description = $description . "\n";
- } else {
- $line =~ s/^\s*//;
- $description = $description . " " . $line . "\n";
- }
- }
- }
- if (!$reviewer) {
- $reviewer = $gitReviewer;
- }
-
- return ($reviewer, $description);
-}
generated by cgit v1.1 at 2025-08-16 10:20:59 +0000