#!/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 Torchmobile, Inc.
#
#  prepare-ChangeLog is free software; you can redistribute it and/or
#  modify it under the terms of the GNU General Public
#  License as published by the Free Software Foundation; either
#  version 2 of the License, or (at your option) any later version.
#
#  prepare-ChangeLog is distributed in the hope that it will be useful,
#  but WITHOUT ANY WARRANTY; without even the implied warranty of
#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
#  General Public License for more details.
#
#  You should have received a copy of the GNU General Public
#  License along with this program; if not, write to the Free
#  Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
#


# Perl script to create a ChangeLog entry with names of files
# and functions from a diff.
#
# Darin Adler <darin@bentspoon.com>, started 20 April 2000
# Java support added by Maciej Stachowiak <mjs@eazel.com>
# Objective-C, C++ and Objective-C++ support added by Maciej Stachowiak <mjs@apple.com>
# Git support added by Adam Roben <aroben@apple.com>
# --git-index flag added by Joe Mason <joe.mason@torchmobile.com>


#
# TODO:
#   List functions that have been removed too.
#   Decide what a good logical order is for the changed files
#     other than a normal text "sort" (top level first?)
#     (group directories?) (.h before .c?)
#   Handle yacc source files too (other languages?).
#   Help merge when there are ChangeLog conflicts or if there's
#     already a partly written ChangeLog entry.
#   Add command line option to put the ChangeLog into a separate
#     file 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 changeLogEmailAddress($);
sub changeLogName($);
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($);
sub normalizeLineEndings($$);
sub normalizePath($);

# Project time zone for Cupertino, CA, US
my $changeLogTimeZone = "PST8PDT";

my $bugNumber;
my $name;
my $emailAddress;
my $gitCommit = 0;
my $gitIndex = "";
my $gitReviewer = "";
my $openChangeLogs = 0;
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,
               "git-commit:s" => \$gitCommit,
               "git-index" => \$gitIndex,
               "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-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";
    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";

my $svnVersion = `svn --version --quiet` if $isSVN;

# Find the list of modified files
my @changed_files;
my $changed_files_string;
my %changed_line_ranges;
my %function_lists;
my @conflict_files;


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

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

if (!@changed_files && !@conflict_files && !keys %function_lists) {
    print STDERR "  No changes found.\n";
    exit 1;
}

if (@conflict_files) {
    print STDERR "  The following files have conflicts. Run prepare-ChangeLog again after fixing the conflicts:\n";
    print STDERR join("\n", @conflict_files), "\n";
    exit 1;
}

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

    # For each file, build a list of modified lines.
    # Use line numbers from the "after" side of each diff.
    print STDERR "  Reviewing diff to determine which lines changed.\n";
    my $file;
    open DIFF, "-|", diffCommand(@changed_files) or die "The diff failed: $!.\n";
    while (<DIFF>) {
        $file = makeFilePathRelative($1) if $_ =~ diffHeaderFormat();
        if (defined $file) {
            my ($start, $end) = extractLineRange($_);
            if ($start >= 0 && $end >= 0) {
                push @{$changed_line_ranges{$file}}, [ $start, $end ];
            } elsif (/DO_NOT_COMMIT/) {
                print STDERR "WARNING: file $file contains the string DO_NOT_COMMIT, line $.\n";
            }
        }
    }
    close DIFF;
}

# For each source file, convert line range to function list.
if (%changed_line_ranges) {
    print STDERR "  Extracting affected function names from source files.\n";
    foreach my $file (keys %changed_line_ranges) {
        # Only look for function names in certain source files.
        next unless $file =~ /\.(c|cpp|m|mm|h|java|js)/;
    
        # Find all the functions in the file.
        open SOURCE, $file or next;
        my @function_ranges = get_function_line_ranges(\*SOURCE, $file);
        close SOURCE;
    
        # Find all the modified functions.
        my @functions;
        my %saw_function;
        my @change_ranges = (@{$changed_line_ranges{$file}}, []);
        my @change_range = (0, 0);
        FUNCTION: foreach my $function_range_ref (@function_ranges) {
            my @function_range = @$function_range_ref;
    
            # Advance to successive change ranges.
            for (;; @change_range = @{shift @change_ranges}) {
                last FUNCTION unless @change_range;
    
                # If past this function, move on to the next one.
                next FUNCTION if $change_range[0] > $function_range[1];
    
                # If an overlap with this function range, record the function name.
                if ($change_range[1] >= $function_range[0]
                    and $change_range[0] <= $function_range[1]) {
                    if (!$saw_function{$function_range[2]}) {
                        $saw_function{$function_range[2]} = 1;
                        push @functions, $function_range[2];
                    }
                    next FUNCTION;
                }
            }
        }
    
        # Format the list of functions now.

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

# Get some parameters for the ChangeLog we are about to write.
my $date = changeLogDate($changeLogTimeZone);
$name = changeLogName($name);
$emailAddress = changeLogEmailAddress($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
    my $descriptionLine = `curl --silent "$bugXMLURL" | grep short_desc`;
    $descriptionLine =~ /<short_desc>(.*)<\/short_desc>/;
    $bugDescription = $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;
    }
}

# 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;
    # We want to match the ChangeLog's line endings in case it doesn't match
    # the native line endings for this version of perl.
    my $endl = "\n";
    if ($old_change_log[0] =~ /(\r?\n)/g) {
        $endl = "$1";
    }
    open CHANGE_LOG, "> ${changeLogPath}" or die "Could not write ${changeLogPath}\n.";
    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 "\n";

    # We could pre-populate this with the git commit log or with the bug description.
    print ("-- Please remember to include a detailed description in your ChangeLog entry. --\n-- See <http://webkit.org/coding/contributing.html> for more info --\n");

    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 = normalizePath(substr $file, length $prefix);
        print CHANGE_LOG normalizeLineEndings("        * $file_stem:$function_lists{$file}\n", $endl);;
    }
    print CHANGE_LOG normalizeLineEndings("\n", $endl), @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 changeLogNameError($)
{
    my ($message) = @_;
    print STDERR "$message\nEither:\n";
    print STDERR "  set CHANGE_LOG_NAME in your environment\n";
    print STDERR "  OR pass --name= on the command line\n";
    print STDERR "  OR set REAL_NAME in your environment";
    print STDERR "  OR git users can set 'git config user.name'\n";
    exit(1);
}

sub changeLogName($)
{
    my ($nameFromArgs) = @_;
    # Silently allow --git-commit to win, we could warn if $emailAddressFromArgs is defined.
    return `$GIT log --max-count=1 --pretty=\"format:%an\" \"$gitCommit\"` if $gitCommit;

    my $name = $nameFromArgs
        || $ENV{CHANGE_LOG_NAME}
        || $ENV{REAL_NAME}
        || gitConfig("user.name")
        || (split /\s*,\s*/, (getpwuid $<)[6])[0];

    changeLogNameError("Failed to determine ChangeLog name.") unless $name;
    # getpwuid seems to always succeed on windows, returning the username instead of the full name.  This check will catch that case.
    changeLogNameError("'$name' does not contain a space!  ChangeLogs should contain your full name.") unless ($name =~ /\w \w/);

    return $name;
}

sub changeLogEmailAddressError($)
{
    my ($message) = @_;
    print STDERR "$message\nEither:\n";
    print STDERR "  set CHANGE_LOG_EMAIL_ADDRESS in your environment\n";
    print STDERR "  OR pass --email= on the command line\n";
    print STDERR "  OR set EMAIL_ADDRESS in your environment\n";
    print STDERR "  OR git users can set 'git config user.email'\n";
    exit(1);
}

sub changeLogEmailAddress($)
{
    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;

    my $emailAddress = $emailAddressFromArgs
        || $ENV{CHANGE_LOG_EMAIL_ADDRESS}
        || $ENV{EMAIL_ADDRESS}
        || gitConfig("user.email");

    changeLogEmailAddressError("Failed to determine email address for ChangeLog.") unless $emailAddress;
    changeLogEmailAddressError("Email address '$emailAddress' does not contain '\@' and is likely invalid.") unless ($emailAddress =~ /\@/);

    return $emailAddress;
}

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 $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;
}


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

    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;
        }
    }
    close INFO;
    my $sourceFile;
    open INFO, "$SVN info '$file' |" or die;
    while (<INFO>) {
        if (/^Copied From URL: (.+)/) {
            $sourceFile = File::Spec->abs2rel($1, $baseUrl);
        }
    }
    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";
    while (<STAT>) {
        my $status;
        my $original;
        my $file;

        if ($isSVN) {
            my $matches;
            if (eval "v$svnVersion" ge v1.6) {
                $matches = /^([ACDMR]).{6} (.+)$/;
                $status = $1;
                $file = $2;
            } else {
                $matches = /^([ACDMR]).{5} (.+)$/;
                $status = $1;
                $file = $2;
            }
            if ($matches) {
                $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 || $gitIndex); # an existing commit or staged change 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);
}

sub normalizeLineEndings($$)
{
    my ($string, $endl) = @_;
    $string =~ s/\r?\n/$endl/g;
    return $string;
}

sub normalizePath($)
{
    my ($path) = @_;
    $path =~ s/\\/\//g;
    return $path;
}