Move cursor to corner and fix safari window size before running benchmark
[WebKit-https.git] / Tools / Scripts / prepare-ChangeLog
1 #!/usr/bin/env perl
2 # -*- Mode: perl; indent-tabs-mode: nil; c-basic-offset: 2  -*-
3
4 #
5 #  Copyright (C) 2000, 2001 Eazel, Inc.
6 #  Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007 Apple Inc.  All rights reserved.
7 #  Copyright (C) 2009 Torch Mobile, Inc.
8 #  Copyright (C) 2009 Cameron McCormack <cam@mcc.id.au>
9 #
10 #  prepare-ChangeLog is free software; you can redistribute it and/or
11 #  modify it under the terms of the GNU General Public
12 #  License as published by the Free Software Foundation; either
13 #  version 2 of the License, or (at your option) any later version.
14 #
15 #  prepare-ChangeLog is distributed in the hope that it will be useful,
16 #  but WITHOUT ANY WARRANTY; without even the implied warranty of
17 #  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
18 #  General Public License for more details.
19 #
20 #  You should have received a copy of the GNU General Public
21 #  License along with this program; if not, write to the Free
22 #  Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
23 #
24
25
26 # Perl script to create a ChangeLog entry with names of files
27 # and functions from a diff.
28 #
29 # Darin Adler <darin@bentspoon.com>, started 20 April 2000
30 # Java support added by Maciej Stachowiak <mjs@eazel.com>
31 # Objective-C, C++ and Objective-C++ support added by Maciej Stachowiak <mjs@apple.com>
32 # Git support added by Adam Roben <aroben@apple.com>
33 # --git-index flag added by Joe Mason <joe.mason@torchmobile.com>
34
35
36 #
37 # TODO:
38 #   Decide what a good logical order is for the changed files
39 #     other than a normal text "sort" (top level first?)
40 #     (group directories?) (.h before .c?)
41 #   Handle yacc source files too (other languages?).
42 #   Help merge when there are ChangeLog conflicts or if there's
43 #     already a partly written ChangeLog entry.
44 #   Add command line option to put the ChangeLog into a separate file.
45 #   Add SVN version numbers for commit (can't do that until
46 #     the changes are checked in, though).
47 #   Work around diff stupidity where deleting a function that starts
48 #     with a comment makes diff think that the following function
49 #     has been changed (if the following function starts with a comment
50 #     with the same first line, such as /**)
51 #   Work around diff stupidity where deleting an entire function and
52 #     the blank lines before it makes diff think you've changed the
53 #     previous function.
54
55 use strict;
56 use warnings;
57
58 use File::Basename;
59 use File::Spec;
60 use FindBin;
61 use Getopt::Long;
62 use lib $FindBin::Bin;
63 use List::Util qw/max/;
64 use POSIX qw(strftime);
65 use VCSUtils;
66
67 sub changeLogDate($);
68 sub changeLogEmailAddressFromArgs($$);
69 sub changeLogNameFromArgs($$);
70 sub createPatchCommand($$$$);
71 sub decodeEntities($);
72 sub determinePropertyChanges($$$);
73 sub diffCommand($$$$);
74 sub diffFromToString($$$);
75 sub diffHeaderFormat();
76 sub extractLineRangeAfterChange($);
77 sub extractLineRangeBeforeChange($);
78 sub fetchBugDescriptionFromURL($$);
79 sub findChangeLogs($$);
80 sub findOriginalFileFromSvn($);
81 sub generateFileList(\%$$$);
82 sub generateFunctionLists($$$$$);
83 sub generateFunctionListsByRanges($$$$);
84 sub generateNewChangeLogs($$$$$$$$$$$$);
85 sub getLatestChangeLogs($);
86 sub get_function_line_ranges($$);
87 sub get_function_line_ranges_for_cpp($$);
88 sub delete_namespaces_from_ranges_for_cpp(\@\@);
89 sub is_function_in_namespace($$);
90 sub get_function_line_ranges_for_java($$);
91 sub get_function_line_ranges_for_javascript($$);
92 sub get_function_line_ranges_for_perl($$);
93 sub get_selector_line_ranges_for_css($$);
94 sub isAddedStatus($);
95 sub isConflictStatus($$$);
96 sub isModifiedStatus($);
97 sub isUnmodifiedStatus($);
98 sub main();
99 sub method_decl_to_selector($);
100 sub normalizeLineEndings($$);
101 sub openChangeLogs($);
102 sub originalFile($$$$);
103 sub pluralizeAndList($$@);
104 sub printDiff($$$$);
105 sub processPaths(\@);
106 sub propertyChangeDescription($);
107 sub resolveConflictedChangeLogs($);
108 sub reviewerAndDescriptionForGitCommit($$);
109 sub statusCommand($$$$);
110 sub statusDescription($$$$);
111 sub testListForChangeLog(@);
112
113 ### Constant variables.
114 # Project time zone for Cupertino, CA, US
115 use constant ChangeLogTimeZone => "PST8PDT";
116 use constant SVN => "svn";
117 use constant GIT => "git";
118 use constant SupportedTestExtensions => {map { $_ => 1 } qw(html shtml svg xml xhtml pl php)};
119
120 exit(main());
121
122 sub main()
123 {
124     my $bugDescription;
125     my $bugNumber;
126     my $name;
127     my $emailAddress;
128     my $mergeBase = 0;
129     my $gitCommit = 0;
130     my $gitIndex = "";
131     my $gitReviewer = "";
132     my $checkWebKitStyle;
133     my $openChangeLogs = 0;
134     my $writeChangeLogs = 1;
135     my $delimiters = 0;
136     my $showHelp = 0;
137     my $spewDiff = $ENV{"PREPARE_CHANGELOG_DIFF"};
138     my $updateChangeLogs = 1;
139     my $parseOptionsResult =
140         GetOptions("diff|d!" => \$spewDiff,
141                    "bug|b:i" => \$bugNumber,
142                    "delimiters" => \$delimiters,
143                    "description:s" => \$bugDescription,
144                    "name:s" => \$name,
145                    "email:s" => \$emailAddress,
146                    "merge-base:s" => \$mergeBase,
147                    "git-commit|g:s" => \$gitCommit,
148                    "git-index" => \$gitIndex,
149                    "git-reviewer:s" => \$gitReviewer,
150                    "help|h!" => \$showHelp,
151                    "style!" => \$checkWebKitStyle,
152                    "open|o!" => \$openChangeLogs,
153                    "write!" => \$writeChangeLogs,
154                    "update!" => \$updateChangeLogs);
155     if (!$parseOptionsResult || $showHelp) {
156         print STDERR basename($0) . " [-b|--bug=<bugid>] [-d|--diff] [-h|--help] [-o|--open] [-g|--git-commit=<committish>] [--git-reviewer=<name>] [svndir1 [svndir2 ...]]\n";
157         print STDERR "  -b|--bug        Fill in the ChangeLog bug information from the given bug.\n";
158         print STDERR "  --description   One-line description that matches the bug title.\n";
159         print STDERR "  -d|--diff       Spew diff to stdout when running\n";
160         print STDERR "  --merge-base    Populate the ChangeLogs with the diff to this branch\n";
161         print STDERR "  -g|--git-commit Populate the ChangeLogs from the specified git commit\n";
162         print STDERR "  --git-index     Populate the ChangeLogs from the git index only\n";
163         print STDERR "  --git-reviewer  When populating the ChangeLogs from a git commit claim that the spcified name reviewed the change.\n";
164         print STDERR "                  This option is useful when the git commit lacks a Signed-Off-By: line\n";
165         print STDERR "  -h|--help       Show this help message\n";
166         print STDERR "  --[no-]style    Run check-webkit-style script when done (default: style)\n";
167         print STDERR "  -o|--open       Open ChangeLogs in an editor when done\n";
168         print STDERR "  --[no-]update   Update ChangeLogs from svn before adding entry (default: update)\n";
169         print STDERR "  --[no-]write    Write ChangeLogs to disk (otherwise send new entries to stdout) (default: write)\n";
170         print STDERR "  --delimiters    When writing to stdout, label and print a \"~\" after each entry\n";
171         print STDERR "  --email=        Specify the email address to be used in the patch\n";
172         return 1;
173     }
174
175     if ($checkWebKitStyle) {
176         print STDERR "  Running check-webkit-style.\n  ";
177         system "$FindBin::Bin/check-webkit-style";
178     }
179
180     die "--git-commit and --git-index are incompatible." if ($gitIndex && $gitCommit);
181
182     isSVN() || isGit() || die "Couldn't determine your version control system.";
183
184     my %paths = processPaths(@ARGV);
185
186     # Find the list of modified files
187     my ($changedFiles, $conflictFiles, $functionLists, $addedRegressionTests) = generateFileList(%paths, $gitCommit, $gitIndex, $mergeBase);
188
189     if (!@$changedFiles && !@$conflictFiles && !keys %$functionLists) {
190         print STDERR "  No changes found.\n";
191         return 1;
192     }
193
194     if (@$conflictFiles) {
195         print STDERR "  The following files have conflicts. Run prepare-ChangeLog again after fixing the conflicts:\n";
196         print STDERR join("\n", @$conflictFiles), "\n";
197         return 1;
198     }
199
200     generateFunctionLists($changedFiles, $functionLists, $gitCommit, $gitIndex, $mergeBase);
201
202     # Get some parameters for the ChangeLog we are about to write.
203     $name = changeLogNameFromArgs($name, $gitCommit);
204     $emailAddress = changeLogEmailAddressFromArgs($emailAddress, $gitCommit);
205
206     print STDERR "  Change author: $name <$emailAddress>.\n";
207
208     # Remove trailing parenthesized notes from user name (bit of hack).
209     $name =~ s/\(.*?\)\s*$//g;
210
211     my $bugURL;
212     if ($bugNumber) {
213         $bugURL = "https://bugs.webkit.org/show_bug.cgi?id=$bugNumber";
214     }
215
216     if ($bugNumber && !$bugDescription) {
217         $bugDescription = fetchBugDescriptionFromURL($bugURL, $bugNumber);
218     }
219
220     my ($filesInChangeLog, $prefixes) = findChangeLogs($functionLists, $writeChangeLogs);
221
222     # Get the latest ChangeLog files from svn.
223     my $changeLogs = getLatestChangeLogs($prefixes);
224
225     if (@$changeLogs && $updateChangeLogs && isSVN()) {
226         resolveConflictedChangeLogs($changeLogs);
227     }
228
229     generateNewChangeLogs($prefixes, $filesInChangeLog, $addedRegressionTests, $functionLists, $bugURL, $bugDescription, $name, $emailAddress, $gitReviewer, $gitCommit, $writeChangeLogs, $delimiters);
230
231     if ($writeChangeLogs) {
232         print STDERR "-- Please remember to include a detailed description in your ChangeLog entry. --\n-- See <http://webkit.org/coding/contributing.html> for more info --\n";
233     }
234
235     # Write out another diff.
236     if ($spewDiff && @$changedFiles) {
237         printDiff($changedFiles, $gitCommit, $gitIndex, $mergeBase);
238     }
239
240     # Open ChangeLogs.
241     if ($openChangeLogs && @$changeLogs) {
242         openChangeLogs($changeLogs);
243     }
244     return 0;
245 }
246
247 sub originalFile($$$$)
248 {
249     my ($file, $gitCommit, $gitIndex, $mergeBase) = @_;
250
251     my $command;
252     if (isSVN()) {
253         my $escapedPathsString = escapeSubversionPath($file);
254         $command = SVN . " cat $escapedPathsString";
255     } elsif (isGit()) {
256         $command = GIT . " show ";
257         if ($mergeBase) {
258             $command .= "$mergeBase";
259         } else {
260             $command .= "HEAD";
261         }
262         $command .= ":$file";
263     }
264
265     return $command;
266 }
267
268 sub generateFunctionLists($$$$$)
269 {
270     my ($changedFiles, $functionLists, $gitCommit, $gitIndex, $mergeBase) = @_;
271
272     my %line_ranges_after_changed;
273     my %line_ranges_before_changed;
274     if (@$changedFiles) {
275         # For each file, build a list of modified lines.
276         # Use line numbers from the "after" side of each diff.
277         print STDERR "  Reviewing diff to determine which lines changed.\n";
278         my $file;
279         open DIFF, "-|", diffCommand($changedFiles, $gitCommit, $gitIndex, $mergeBase) or die "The diff failed: $!.\n";
280         while (<DIFF>) {
281             $file = makeFilePathRelative($1) if $_ =~ diffHeaderFormat();
282             if (defined $file) {
283                 my ($before_start, $before_end) = extractLineRangeBeforeChange($_);
284                 if ($before_start >= 1 && $before_end >= 1) {
285                     push @{$line_ranges_before_changed{$file}}, [ $before_start, $before_end ];
286                 } elsif (/DO_NOT_COMMIT/) {
287                     print STDERR "WARNING: file $file contains the string DO_NOT_COMMIT, line $.\n";
288                 }
289                 my ($after_start, $after_end) = extractLineRangeAfterChange($_);
290                 if ($after_start >= 1 && $after_end >= 1) {
291                     push @{$line_ranges_after_changed{$file}}, [ $after_start, $after_end ];
292                 } elsif (/DO_NOT_COMMIT/) {
293                     print STDERR "WARNING: file $file contains the string DO_NOT_COMMIT, line $.\n";
294                 }
295             }
296         }
297         close DIFF;
298     }
299
300     # For each source file, convert line range to function list.
301     print STDERR "  Extracting affected function names from source files.\n";
302     my %filesToExamine = map { $_ => 1 } (keys(%line_ranges_before_changed), keys(%line_ranges_after_changed));
303     foreach my $file (keys %filesToExamine) {
304         my %saw_function;
305         # Find all the functions in the file.
306         if ($line_ranges_after_changed{$file}) {
307             open SOURCE, $file or next;
308             my @function_ranges = get_function_line_ranges(\*SOURCE, $file);
309             close SOURCE;
310
311             my @change_ranges = (@{$line_ranges_after_changed{$file}}, []);
312             my @functions = generateFunctionListsByRanges($file, \@change_ranges, \@function_ranges, \%saw_function);
313
314             # Format the list of functions.
315             if (@functions) {
316                 $functionLists->{$file} = "" if !defined $functionLists->{$file};
317                 $functionLists->{$file} .= "\n        (" . join("):\n        (", @functions) . "):";
318             }
319         }
320         # Find the deleted functions in the original file.
321         if($line_ranges_before_changed{$file}) {
322             open SOURCE, "-|", originalFile($file, $gitCommit, $gitIndex, $mergeBase) or next;
323                 my @deleted_function_ranges = get_function_line_ranges(\*SOURCE, $file);
324             close SOURCE;
325
326             my @change_ranges = (@{$line_ranges_before_changed{$file}}, []);
327             my @functions = generateFunctionListsByRanges($file, \@change_ranges, \@deleted_function_ranges, \%saw_function);
328
329             # Format the list of deleted functions.
330             if (@functions) {
331                 $functionLists->{$file} = "" if !defined $functionLists->{$file};
332                 $functionLists->{$file} .= "\n        (" . join("): Deleted.\n        (", @functions) . "): Deleted.";
333             }
334         }
335     }
336 }
337
338 sub generateFunctionListsByRanges($$$$)
339 {
340     my ($file, $changed_line_ranges, $function_ranges, $saw_function) = @_;
341
342     # Find all the modified functions.
343     my @functions;
344     my @change_ranges = @{$changed_line_ranges};
345     my @change_range = (0, 0);
346     FUNCTION: foreach my $function_range_ref (@{$function_ranges}) {
347         my @function_range = @{$function_range_ref};
348
349         # FIXME: This is a hack. If the function name is empty, skip it.
350         # The cpp, python, javascript, perl, css and java parsers
351         # are not perfectly implemented and sometimes function names cannot be retrieved
352         # correctly. As you can see in get_function_line_ranges_XXXX(), those parsers
353         # are not intended to implement real parsers but intended to just retrieve function names
354         # for most practical syntaxes.
355         next unless $function_range[2];
356
357         # Advance to successive change ranges.
358         for (;; @change_range = @{shift @change_ranges}) {
359             last FUNCTION unless @change_range;
360
361             # If past this function, move on to the next one.
362             next FUNCTION if $change_range[0] > $function_range[1];
363
364             # If an overlap with this function range, record the function name.
365             if ($change_range[1] >= $function_range[0]
366                 and $change_range[0] <= $function_range[1]) {
367                 if (!$saw_function->{$function_range[2]}) {
368                     $saw_function->{$function_range[2]} = 1;
369                     push @functions, $function_range[2];
370                 }
371                 next FUNCTION;
372             }
373         }
374     }
375
376     return @functions;
377 }
378
379 sub changeLogDate($)
380 {
381     my ($timeZone) = @_;
382     my $savedTimeZone = $ENV{'TZ'};
383     # Set TZ temporarily so that localtime() is in that time zone
384     $ENV{'TZ'} = $timeZone;
385     my $date = strftime("%Y-%m-%d", localtime());
386     if (defined $savedTimeZone) {
387          $ENV{'TZ'} = $savedTimeZone;
388     } else {
389          delete $ENV{'TZ'};
390     }
391     return $date;
392 }
393
394 sub changeLogNameFromArgs($$)
395 {
396     my ($nameFromArgs, $gitCommit) = @_;
397     # Silently allow --git-commit to win, we could warn if $nameFromArgs is defined.
398     my $command = GIT . ' log --max-count=1 --pretty="format:%an" "' . $gitCommit . '"';
399     return `$command` if $gitCommit;
400
401     return $nameFromArgs || changeLogName();
402 }
403
404 sub changeLogEmailAddressFromArgs($$)
405 {
406     my ($emailAddressFromArgs, $gitCommit) = @_;
407     # Silently allow --git-commit to win, we could warn if $emailAddressFromArgs is defined.
408     my $command = GIT . ' log --max-count=1 --pretty="format:%ae" "' . $gitCommit . '"';
409     return `$command` if $gitCommit;
410
411     return $emailAddressFromArgs || changeLogEmailAddress();
412 }
413
414 sub fetchBugDescriptionFromURL($$)
415 {
416     my ($bugURL, $bugNumber) = @_;
417
418     my $bugXMLURL = "$bugURL&ctype=xml&excludefield=attachmentdata";
419     # Perl has no built in XML processing, so we'll fetch and parse with curl and grep
420     # Pass --insecure because some cygwin installs have no certs we don't
421     # care about validating that bugs.webkit.org is who it says it is here.
422     my $descriptionLine = `curl --insecure --silent "$bugXMLURL" | grep short_desc`;
423     if ($descriptionLine !~ /<short_desc>(.*)<\/short_desc>/) {
424         # Maybe the reason the above did not work is because the curl that is installed doesn't
425         # support ssl at all.
426         if (`curl --version | grep ^Protocols` !~ /\bhttps\b/) {
427             print STDERR "  Could not get description for bug $bugNumber.\n";
428             print STDERR "  It looks like your version of curl does not support ssl.\n";
429             print STDERR "  If you are using macports, this can be fixed with sudo port install curl +ssl.\n";
430         } else {
431             print STDERR "  Bug $bugNumber has no bug description. Maybe you set wrong bug ID?\n";
432             print STDERR "  The bug URL: $bugXMLURL\n";
433         }
434         exit 1;
435     }
436     my $bugDescription = decodeEntities($1);
437     print STDERR "  Description from bug $bugNumber:\n    \"$bugDescription\".\n";
438     return $bugDescription;
439 }
440
441 sub findChangeLogs($$)
442 {
443     my ($functionLists, $requireChangeLogToExist) = @_;
444
445     # Find the change logs.
446     my %has_log;
447     my %filesInChangeLog;
448     foreach my $file (sort keys %$functionLists) {
449         my $prefix = $file;
450         my $has_log = 0;
451         while ($prefix) {
452             $prefix =~ s-/[^/]+/?$-/- or $prefix = "";
453             $has_log = $has_log{$prefix};
454             if (!defined $has_log) {
455                 $has_log = -f "${prefix}ChangeLog";
456                 $has_log{$prefix} = $has_log;
457             }
458             last if $has_log;
459         }
460         if (!$has_log && $requireChangeLogToExist) {
461             print STDERR "No ChangeLog found for $file.\n";
462         } else {
463             push @{$filesInChangeLog{$prefix}}, $file;
464         }
465     }
466
467     # Build the list of ChangeLog prefixes in the correct project order
468     my @prefixes;
469     my %prefixesSort;
470     foreach my $prefix (keys %filesInChangeLog) {
471         my $prefixDir = substr($prefix, 0, length($prefix) - 1); # strip trailing /
472         my $sortKey = lc $prefix;
473         $sortKey = "top level" unless length $sortKey;
474
475         if ($prefixDir eq "top level") {
476             $sortKey = "";
477         } elsif ($prefixDir eq "Tools") {
478             $sortKey = "-, just after top level";
479         } elsif ($prefixDir eq "WebBrowser") {
480             $sortKey = lc "WebKit, WebBrowser after";
481         } elsif ($prefixDir eq "Source/WebCore") {
482             $sortKey = lc "WebFoundation, WebCore after";
483         } elsif ($prefixDir eq "LayoutTests") {
484             $sortKey = lc "~, LayoutTests last";
485         }
486
487         $prefixesSort{$sortKey} = $prefix;
488     }
489     foreach my $prefixSort (sort keys %prefixesSort) {
490         push @prefixes, $prefixesSort{$prefixSort};
491     }
492     return (\%filesInChangeLog, \@prefixes);
493 }
494
495 sub getLatestChangeLogs($)
496 {
497     my ($prefixes) = @_;
498
499     my @changeLogs = ();
500     foreach my $prefix (@$prefixes) {
501         push @changeLogs, File::Spec->catfile($prefix || ".", "ChangeLog");
502     }
503     return \@changeLogs;
504 }
505
506 sub resolveConflictedChangeLogs($)
507 {
508     my ($changeLogs) = @_;
509
510     print STDERR "  Running 'svn update' to update ChangeLog files.\n";
511     open ERRORS, "-|", SVN, "update", @$changeLogs
512         or die "The svn update of ChangeLog files failed: $!.\n";
513     my @conflictedChangeLogs;
514     while (my $line = <ERRORS>) {
515         print STDERR "    ", $line;
516         push @conflictedChangeLogs, $1 if $line =~ m/^C\s+(.+?)[\r\n]*$/;
517     }
518     close ERRORS;
519
520     return if !@conflictedChangeLogs;
521
522     print STDERR "  Attempting to merge conflicted ChangeLogs.\n";
523     my $resolveChangeLogsPath = File::Spec->catfile(dirname($0), "resolve-ChangeLogs");
524     open RESOLVE, "-|", $resolveChangeLogsPath, "--no-warnings", @conflictedChangeLogs
525         or die "Could not open resolve-ChangeLogs script: $!.\n";
526     print STDERR "    $_" while <RESOLVE>;
527     close RESOLVE;
528 }
529
530 sub generateNewChangeLogs($$$$$$$$$$$$)
531 {
532     my ($prefixes, $filesInChangeLog, $addedRegressionTests, $functionLists, $bugURL, $bugDescription, $name, $emailAddress, $gitReviewer, $gitCommit, $writeChangeLogs, $delimiters) = @_;
533
534     # Generate new ChangeLog entries and (optionally) write out new ChangeLog files.
535     foreach my $prefix (@$prefixes) {
536         my $endl = "\n";
537         my @old_change_log;
538
539         if ($writeChangeLogs) {
540             my $changeLogPath = File::Spec->catfile($prefix || ".", "ChangeLog");
541             print STDERR "  Editing the ${changeLogPath} file.\n";
542             open OLD_CHANGE_LOG, ${changeLogPath} or die "Could not open ${changeLogPath} file: $!.\n";
543             # It's less efficient to read the whole thing into memory than it would be
544             # to read it while we prepend to it later, but I like doing this part first.
545             @old_change_log = <OLD_CHANGE_LOG>;
546             close OLD_CHANGE_LOG;
547             # We want to match the ChangeLog's line endings in case it doesn't match
548             # the native line endings for this version of perl.
549             if ($old_change_log[0] =~ /(\r?\n)$/g) {
550                 $endl = "$1";
551             }
552             open CHANGE_LOG, "> ${changeLogPath}" or die "Could not write ${changeLogPath}\n.";
553         } else {
554             open CHANGE_LOG, ">-" or die "Could not write to STDOUT\n.";
555             print substr($prefix, 0, length($prefix) - 1) . ":\n\n" unless (scalar @$prefixes) == 1 && !$delimiters;
556         }
557
558         my $date = changeLogDate(ChangeLogTimeZone);
559         print CHANGE_LOG normalizeLineEndings("$date  $name  <$emailAddress>\n\n", $endl);
560
561         my ($reviewer, $description) = reviewerAndDescriptionForGitCommit($gitCommit, $gitReviewer) if $gitCommit;
562         $reviewer = "NOBODY (OO" . "PS!)" if !$reviewer;
563
564         print CHANGE_LOG normalizeLineEndings($description . "\n", $endl) if $description;
565
566         $bugDescription = "Need a short description (OOPS!).\n        Need the bug URL (OOPS!)." unless $bugDescription;
567         print CHANGE_LOG normalizeLineEndings("        $bugDescription\n", $endl) if $bugDescription;
568         print CHANGE_LOG normalizeLineEndings("        $bugURL\n", $endl) if $bugURL;
569         print CHANGE_LOG normalizeLineEndings("\n", $endl);
570
571         print CHANGE_LOG normalizeLineEndings("        Reviewed by $reviewer.\n\n", $endl);
572
573         if ($prefix =~ m/WebCore/ || `pwd` =~ m/WebCore/) {
574             if (@$addedRegressionTests) {
575                 print CHANGE_LOG normalizeLineEndings(testListForChangeLog(sort @$addedRegressionTests), $endl);
576             } else {
577                 print CHANGE_LOG normalizeLineEndings("        No new tests (OOPS!).\n\n", $endl);
578             }
579         }
580
581         foreach my $file (sort @{$filesInChangeLog->{$prefix}}) {
582             my $file_stem = substr $file, length $prefix;
583             print CHANGE_LOG normalizeLineEndings("        * $file_stem:$functionLists->{$file}\n", $endl);
584         }
585
586         if ($writeChangeLogs) {
587             print CHANGE_LOG normalizeLineEndings("\n", $endl), @old_change_log;
588         } else {
589             print CHANGE_LOG "\n";
590             print "~\n"  if $delimiters;
591         }
592
593         close CHANGE_LOG;
594     }
595 }
596
597 sub printDiff($$$$)
598 {
599     my ($changedFiles, $gitCommit, $gitIndex, $mergeBase) = @_;
600
601     print STDERR "  Running diff to help you write the ChangeLog entries.\n";
602     local $/ = undef; # local slurp mode
603     my $changedFilesString = "'" . join("' '", @$changedFiles) . "'";
604     open DIFF, "-|", createPatchCommand($changedFilesString, $gitCommit, $gitIndex, $mergeBase) or die "The diff failed: $!.\n";
605     print <DIFF>;
606     close DIFF;
607 }
608
609 sub openChangeLogs($)
610 {
611     my ($changeLogs) = @_;
612
613     print STDERR "  Opening the edited ChangeLog files.\n";
614     my $editor = $ENV{CHANGE_LOG_EDITOR} || $ENV{VISUAL} || $ENV{EDITOR};
615     if ($editor) {
616         system ((split ' ', $editor), @$changeLogs);
617     } else {
618         $editor = $ENV{CHANGE_LOG_EDIT_APPLICATION};
619         if ($editor) {
620             system "open", "-a", $editor, @$changeLogs;
621         } else {
622             system "open", "-e", @$changeLogs;
623         }
624     }
625 }
626
627 sub get_function_line_ranges($$)
628 {
629     my ($file_handle, $file_name) = @_;
630
631     # Try to determine the source language based on the file extension.
632
633     return get_function_line_ranges_for_cpp($file_handle, $file_name) if $file_name =~ /\.(c|cpp|m|mm|h)$/;
634     return get_function_line_ranges_for_java($file_handle, $file_name) if $file_name =~ /\.java$/;
635     return get_function_line_ranges_for_javascript($file_handle, $file_name) if $file_name =~ /\.js$/;
636     return get_selector_line_ranges_for_css($file_handle, $file_name) if $file_name =~ /\.css$/;
637     return get_function_line_ranges_for_perl($file_handle, $file_name) if $file_name =~ /\.p[lm]$/;
638     return get_function_line_ranges_for_python($file_handle, $file_name) if $file_name =~ /\.py$/ or $file_name =~ /master\.cfg$/;
639
640     # Try to determine the source language based on the script interpreter.
641
642     my $first_line = <$file_handle>;
643     seek($file_handle, 0, 0);
644
645     return () unless $first_line =~ m|^#!(?:/usr/bin/env\s+)?(\S+)|;
646     my $interpreter = $1;
647
648     return get_function_line_ranges_for_perl($file_handle, $file_name) if $interpreter =~ /perl$/;
649     return get_function_line_ranges_for_python($file_handle, $file_name) if $interpreter =~ /python$/;
650
651     return ();
652 }
653
654
655 sub method_decl_to_selector($)
656 {
657     (my $method_decl) = @_;
658
659     $_ = $method_decl;
660
661     if ((my $comment_stripped) = m-([^/]*)(//|/*).*-) {
662         $_ = $comment_stripped;
663     }
664
665     s/,\s*...//;
666
667     # Strip out the return type and parameter types. The extra )? takes care of most block parameter types.
668     s/\([^\)]*\)\)?//g;
669
670     if (/:/) {
671         my @components = split /:/;
672         pop @components if (scalar @components > 1);
673         $_ = (join ':', map {s/.*[^[:word:]]//; scalar $_;} @components) . ':';
674     } else {
675         s/\s*$//;
676         s/.*[^[:word:]]//;
677     }
678
679     return $_;
680 }
681
682
683
684 # Read a file and get all the line ranges of the things that look like C functions.
685 # A function name is the last word before an open parenthesis before the outer
686 # level open brace. A function starts at the first character after the last close
687 # brace or semicolon before the function name and ends at the close brace.
688 # Comment handling is simple-minded but will work for all but pathological cases.
689 #
690 # Result is a list of triples: [ start_line, end_line, function_name ].
691
692 sub get_function_line_ranges_for_cpp($$)
693 {
694     my ($file_handle, $file_name) = @_;
695
696     my @ranges;
697
698     my $in_comment = 0;
699     my $in_macro = 0;
700     my $in_method_declaration = 0;
701     my $in_parentheses = 0;
702     my $quotation_mark;
703     my $in_braces = 0;
704     my $in_toplevel_array_brace = 0;
705     my $brace_start = 0;
706     my $brace_end = 0;
707     my $namespace_start = -1;
708     my $skip_til_brace_or_semicolon = 0;
709     my $equal_observed = 0;
710
711     my $word = "";
712     my $interface_name = "";
713
714     my $potential_method_char = "";
715     my $potential_method_spec = "";
716
717     my $potential_start = 0;
718     my $potential_name = "";
719
720     my $start = 0;
721     my $name = "";
722
723     my $next_word_could_be_namespace = 0;
724     my $potential_namespace = "";
725     my @namespaces;
726     my @all_namespaces;
727
728     while (<$file_handle>) {
729         # Handle continued quoted string.
730         if ($quotation_mark) {
731             if (!s-([^\\]|\\.)*$quotation_mark--) {
732                 if (!m-\\$-) {
733                     warn "mismatched quotes at line $. in $file_name\n";
734                     undef $quotation_mark;
735                 }
736                 next;
737             }
738             undef $quotation_mark;
739         }
740
741         # Handle continued multi-line comment.
742         if ($in_comment) {
743             next unless s-.*\*/--;
744             $in_comment = 0;
745         }
746
747         # Handle continued macro.
748         if ($in_macro) {
749             $in_macro = 0 unless /\\$/;
750             next;
751         }
752
753         # Handle start of macro (or any preprocessor directive).
754         if (/^\s*\#/) {
755             $in_macro = 1 if /^([^\\]|\\.)*\\$/;
756             next;
757         }
758
759         # Handle comments and quoted text.
760         while (m-(/\*|//|\'|\")-) { # \' and \" keep emacs perl mode happy
761             my $match = $1;
762             if ($match eq "/*") {
763                 if (!s-/\*.*?\*/--) {
764                     s-/\*.*--;
765                     $in_comment = 1;
766                 }
767             } elsif ($match eq "//") {
768                 s-//.*--;
769             } else { # ' or "
770                 if (!s-$match([^\\]|\\.)*?$match--) {
771                     if (!s-$match.*\\$--) {
772                         warn "mismatched quotes at line $. in $file_name\n";
773                         s-$match.*--;
774                     } else {
775                         $quotation_mark = $match;
776                     }
777                 }
778             }
779         }
780
781
782         # continued method declaration
783         if ($in_method_declaration) {
784               my $original = $_;
785               my $method_cont = $_;
786
787               chomp $method_cont;
788               $method_cont =~ s/[;\{].*//;
789               $potential_method_spec = "${potential_method_spec} ${method_cont}";
790
791               $_ = $original;
792               if (/;/) {
793                   $potential_start = 0;
794                   $potential_method_spec = "";
795                   $potential_method_char = "";
796                   $in_method_declaration = 0;
797                   s/^[^;\{]*//;
798               } elsif (/{/) {
799                   my $selector = method_decl_to_selector ($potential_method_spec);
800                   $potential_name = "${potential_method_char}\[${interface_name} ${selector}\]";
801
802                   $potential_method_spec = "";
803                   $potential_method_char = "";
804                   $in_method_declaration = 0;
805
806                   $_ = $original;
807                   s/^[^;{]*//;
808               } elsif (/\@end/) {
809                   $in_method_declaration = 0;
810                   $interface_name = "";
811                   $_ = $original;
812               } else {
813                   next;
814               }
815         }
816
817
818         # start of method declaration
819         if ((my $method_char, my $method_spec) = m&^([-+])([^0-9;][^;]*);?$&) {
820             my $original = $_;
821
822             if ($interface_name) {
823                 chomp $method_spec;
824                 $method_spec =~ s/\{.*//;
825
826                 $potential_method_char = $method_char;
827                 $potential_method_spec = $method_spec;
828                 $potential_start = $.;
829                 $in_method_declaration = 1;
830             } else { 
831                 warn "declaring a method but don't have interface on line $. in $file_name\n";
832             }
833             $_ = $original;
834             if (/\{/) {
835               my $selector = method_decl_to_selector ($potential_method_spec);
836               $potential_name = "${potential_method_char}\[${interface_name} ${selector}\]";
837
838               $potential_method_spec = "";
839               $potential_method_char = "";
840               $in_method_declaration = 0;
841               $_ = $original;
842               s/^[^{]*//;
843             } elsif (/\@end/) {
844               $in_method_declaration = 0;
845               $interface_name = "";
846               $_ = $original;
847             } else {
848               next;
849             }
850         }
851
852
853         # Find function, interface and method names.
854         while (m&((?:[[:word:]]+::)*operator(?:[ \t]*\(\)|[^()]*)|[[:word:]<>:~]+|[(){}:;=])|\@(?:implementation|interface|protocol)\s+(\w+)[^{]*&g) {
855             # Skip an array definition at the top level.
856             # e.g. static int arr[] = { 1, 2, 3 };
857             if ($1) {
858                 if ($1 eq "=" and !$in_parentheses and !$in_braces) {
859                     $equal_observed = 1;
860                 } elsif ($1 eq "{" and $equal_observed) {
861                     # This '{' is the beginning of an array definition, not the beginning of a method.
862                     $in_toplevel_array_brace = 1;
863                     $in_braces++;
864                     $equal_observed = 0;
865                     next;
866                 } elsif ($1 !~ /[ \t]/) {
867                     $equal_observed = 0;
868                 }
869             }
870
871             # interface name
872             if ($2) {
873                 $interface_name = $2;
874                 next;
875             }
876
877             # Open parenthesis.
878             if ($1 eq "(") {
879                 $potential_name = $word unless $in_parentheses || $skip_til_brace_or_semicolon || grep { $word eq $_ } ("CF_ENUM", "CF_OPTIONS", "NS_ENUM", "NS_OPTIONS");
880                 $in_parentheses++;
881                 next;
882             }
883
884             # Close parenthesis.
885             if ($1 eq ")") {
886                 $in_parentheses--;
887                 next;
888             }
889
890             # C++ constructor initializers
891             if ($1 eq ":") {
892                   $skip_til_brace_or_semicolon = 1 unless ($in_parentheses || $in_braces);
893             }
894
895             # Open brace.
896             if ($1 eq "{") {
897                 $skip_til_brace_or_semicolon = 0;
898
899                 if (!$in_braces) {
900                     if ($namespace_start >= 0 and $namespace_start < $potential_start) {
901                         push @ranges, [ $namespace_start . "", $potential_start - 1, $name ];
902                     }
903
904                     if ($potential_namespace) {
905                         push @namespaces, $potential_namespace;
906                         push @all_namespaces, $potential_namespace;
907                         $potential_namespace = "";
908                         $name = $namespaces[-1];
909                         $namespace_start = $. + 1;
910                         next;
911                     }
912
913                     # Promote potential name to real function name at the
914                     # start of the outer level set of braces (function body?).
915                     if ($potential_start) {
916                         $start = $potential_start;
917                         $name = $potential_name;
918                         if (@namespaces && $name && (length($name) < 2 || substr($name,1,1) ne "[")) {
919                             $name = join ('::', @namespaces, $name);
920                         }
921                     }
922                 }
923
924                 $in_method_declaration = 0;
925
926                 $brace_start = $. if (!$in_braces);
927                 $in_braces++;
928                 next;
929             }
930
931             # Close brace.
932             if ($1 eq "}") {
933                 if (!$in_braces && @namespaces) {
934                     if ($namespace_start >= 0 and $namespace_start < $.) {
935                         push @ranges, [ $namespace_start . "", $. - 1, $name ];
936                     }
937
938                     pop @namespaces;
939                     if (@namespaces) {
940                         $name = $namespaces[-1];
941                         $namespace_start = $. + 1;
942                     } else {
943                         $name = "";
944                         $namespace_start = -1;
945                     }
946                     next;
947                 }
948
949                 $in_braces--;
950                 $brace_end = $. if (!$in_braces);
951
952                 # End of an outer level set of braces.
953                 # This could be a function body.
954                 if (!$in_braces and $name) {
955                     # This is the end of an array definition at the top level, not the end of a method.
956                     if ($in_toplevel_array_brace) {
957                         $in_toplevel_array_brace = 0;
958                         next;
959                     }
960
961                     push @ranges, [ $start, $., $name ];
962                     if (@namespaces) {
963                         $name = $namespaces[-1];
964                         $namespace_start = $. + 1;
965                     } else {
966                         $name = "";
967                         $namespace_start = -1;
968                     }
969                 }
970
971                 $potential_start = 0;
972                 $potential_name = "";
973                 next;
974             }
975
976             # Semicolon.
977             if ($1 eq ";") {
978                 $skip_til_brace_or_semicolon = 0;
979                 $potential_start = 0;
980                 $potential_name = "";
981                 $in_method_declaration = 0;
982                 next;
983             }
984
985             # Ignore "const" method qualifier.
986             if ($1 eq "const") {
987                 next;
988             }
989
990             if ($1 eq "namespace" || $1 eq "class" || $1 eq "struct") {
991                 $next_word_could_be_namespace = 1;
992                 next;
993             }
994
995             # Word.
996             $word = $1;
997             if (!$skip_til_brace_or_semicolon) {
998                 if ($next_word_could_be_namespace) {
999                     $potential_namespace = $word;
1000                     $next_word_could_be_namespace = 0;
1001                 } elsif ($potential_namespace) {
1002                     $potential_namespace = "";
1003                 }
1004
1005                 if (!$in_parentheses) {
1006                     $potential_start = 0;
1007                     $potential_name = "";
1008                 }
1009                 if (!$potential_start) {
1010                     $potential_start = $.;
1011                     $potential_name = "";
1012                 }
1013             }
1014         }
1015     }
1016
1017     warn "missing close braces in $file_name (probable start at $brace_start)\n" if ($in_braces > 0);
1018     warn "too many close braces in $file_name (probable start at $brace_end)\n" if ($in_braces < 0);
1019
1020     warn "mismatched parentheses in $file_name\n" if $in_parentheses;
1021
1022     return delete_namespaces_from_ranges_for_cpp(@ranges, @all_namespaces);
1023 }
1024
1025
1026 # Take in references to an array of line ranges for C functions in a given file 
1027 # and an array of namespaces declared in that file and return an updated
1028 # list of line ranges with the namespaces removed.
1029
1030 sub delete_namespaces_from_ranges_for_cpp(\@\@)
1031 {
1032     my ($ranges, $namespaces) = @_;
1033     return grep {!is_function_in_namespace($namespaces, $$_[2])} @$ranges;
1034 }
1035
1036
1037 sub is_function_in_namespace($$)
1038 {
1039     my ($namespaces, $function_name) = @_;
1040     return grep {$_ eq $function_name} @$namespaces;
1041 }
1042
1043
1044 # Read a file and get all the line ranges of the things that look like Java
1045 # classes, interfaces and methods.
1046 #
1047 # A class or interface name is the word that immediately follows
1048 # `class' or `interface' when followed by an open curly brace and not
1049 # a semicolon. It can appear at the top level, or inside another class
1050 # or interface block, but not inside a function block
1051 #
1052 # A class or interface starts at the first character after the first close
1053 # brace or after the function name and ends at the close brace.
1054 #
1055 # A function name is the last word before an open parenthesis before
1056 # an open brace rather than a semicolon. It can appear at top level or
1057 # inside a class or interface block, but not inside a function block.
1058 #
1059 # A function starts at the first character after the first close
1060 # brace or after the function name and ends at the close brace.
1061 #
1062 # Comment handling is simple-minded but will work for all but pathological cases.
1063 #
1064 # Result is a list of triples: [ start_line, end_line, function_name ].
1065
1066 sub get_function_line_ranges_for_java($$)
1067 {
1068     my ($file_handle, $file_name) = @_;
1069
1070     my @current_scopes;
1071
1072     my @ranges;
1073
1074     my $in_comment = 0;
1075     my $in_macro = 0;
1076     my $in_parentheses = 0;
1077     my $in_braces = 0;
1078     my $in_non_block_braces = 0;
1079     my $class_or_interface_just_seen = 0;
1080     my $in_class_declaration = 0;
1081
1082     my $word = "";
1083
1084     my $potential_start = 0;
1085     my $potential_name = "";
1086     my $potential_name_is_class_or_interface = 0;
1087
1088     my $start = 0;
1089     my $name = "";
1090     my $current_name_is_class_or_interface = 0;
1091
1092     while (<$file_handle>) {
1093         # Handle continued multi-line comment.
1094         if ($in_comment) {
1095             next unless s-.*\*/--;
1096             $in_comment = 0;
1097         }
1098
1099         # Handle continued macro.
1100         if ($in_macro) {
1101             $in_macro = 0 unless /\\$/;
1102             next;
1103         }
1104
1105         # Handle start of macro (or any preprocessor directive).
1106         if (/^\s*\#/) {
1107             $in_macro = 1 if /^([^\\]|\\.)*\\$/;
1108             next;
1109         }
1110
1111         # Handle comments and quoted text.
1112         while (m-(/\*|//|\'|\")-) { # \' and \" keep emacs perl mode happy
1113             my $match = $1;
1114             if ($match eq "/*") {
1115                 if (!s-/\*.*?\*/--) {
1116                     s-/\*.*--;
1117                     $in_comment = 1;
1118                 }
1119             } elsif ($match eq "//") {
1120                 s-//.*--;
1121             } else { # ' or "
1122                 if (!s-$match([^\\]|\\.)*?$match--) {
1123                     warn "mismatched quotes at line $. in $file_name\n";
1124                     s-$match.*--;
1125                 }
1126             }
1127         }
1128
1129         # Find function names.
1130         while (m-(\w+|[(){};])-g) {
1131             # Open parenthesis.
1132             if ($1 eq "(") {
1133                 if (!$in_parentheses) {
1134                     $potential_name = $word;
1135                     $potential_name_is_class_or_interface = 0;
1136                 }
1137                 $in_parentheses++;
1138                 next;
1139             }
1140
1141             # Close parenthesis.
1142             if ($1 eq ")") {
1143                 $in_parentheses--;
1144                 next;
1145             }
1146
1147             # Open brace.
1148             if ($1 eq "{") {
1149                 $in_class_declaration = 0;
1150
1151                 # Promote potential name to real function name at the
1152                 # start of the outer level set of braces (function/class/interface body?).
1153                 if (!$in_non_block_braces
1154                     and (!$in_braces or $current_name_is_class_or_interface)
1155                     and $potential_start) {
1156                     if ($name) {
1157                           push @ranges, [ $start, ($. - 1),
1158                                           join ('.', @current_scopes) ];
1159                     }
1160
1161
1162                     $current_name_is_class_or_interface = $potential_name_is_class_or_interface;
1163
1164                     $start = $potential_start;
1165                     $name = $potential_name;
1166
1167                     push (@current_scopes, $name);
1168                 } else {
1169                     $in_non_block_braces++;
1170                 }
1171
1172                 $potential_name = "";
1173                 $potential_start = 0;
1174
1175                 $in_braces++;
1176                 next;
1177             }
1178
1179             # Close brace.
1180             if ($1 eq "}") {
1181                 $in_braces--;
1182
1183                 # End of an outer level set of braces.
1184                 # This could be a function body.
1185                 if (!$in_non_block_braces) {
1186                     if ($name) {
1187                         push @ranges, [ $start, $.,
1188                                         join ('.', @current_scopes) ];
1189
1190                         pop (@current_scopes);
1191
1192                         if (@current_scopes) {
1193                             $current_name_is_class_or_interface = 1;
1194
1195                             $start = $. + 1;
1196                             $name =  $current_scopes[$#current_scopes-1];
1197                         } else {
1198                             $current_name_is_class_or_interface = 0;
1199                             $start = 0;
1200                             $name =  "";
1201                         }
1202                     }
1203                 } else {
1204                     $in_non_block_braces-- if $in_non_block_braces;
1205                 }
1206
1207                 $potential_start = 0;
1208                 $potential_name = "";
1209                 next;
1210             }
1211
1212             # Semicolon.
1213             if ($1 eq ";") {
1214                 $potential_start = 0;
1215                 $potential_name = "";
1216                 next;
1217             }
1218
1219             if ($1 eq "class") {
1220                 $in_class_declaration = 1;
1221             }
1222             if ($1 eq "class" or (!$in_class_declaration and $1 eq "interface")) {
1223                 $class_or_interface_just_seen = 1;
1224                 next;
1225             }
1226
1227             # Word.
1228             $word = $1;
1229             if (!$in_parentheses) {
1230                 if ($class_or_interface_just_seen) {
1231                     $potential_name = $word;
1232                     $potential_start = $.;
1233                     $class_or_interface_just_seen = 0;
1234                     $potential_name_is_class_or_interface = 1;
1235                     next;
1236                 }
1237             }
1238             if (!$potential_start) {
1239                 $potential_start = $.;
1240                 $potential_name = "";
1241             }
1242             $class_or_interface_just_seen = 0;
1243         }
1244     }
1245
1246     warn "mismatched braces in $file_name\n" if $in_braces;
1247     warn "mismatched parentheses in $file_name\n" if $in_parentheses;
1248
1249     return @ranges;
1250 }
1251
1252
1253
1254 # Read a file and get all the line ranges of the things that look like
1255 # JavaScript functions or methods.
1256 #
1257 # A function name is the word that immediately follows `function' when
1258 # followed by an open curly brace. It can appear at the top level,
1259 # or inside other functions. For example:
1260 #
1261 #    function name() { // (name)
1262 #        function inner() { } // (name.inner)
1263 #    }
1264 #
1265 # An anonymous function name is the identifier on the left hand side of
1266 # an assignment with the equals operator or object notation that has a
1267 # value starting with `function' followed an open curly brace.
1268 # For example:
1269 #
1270 #    namespace = {
1271 #        name: function() {} // (namespace.name)
1272 #    }
1273 #    namespace.Foo = function() {} // (namespace.Foo)
1274 #
1275 # A getter or setter name is the word that immediately follows `get' or
1276 # `set' when followed by params and an open curly brace. For example:
1277 #
1278 #    namespace = {
1279 #      get foo() {} // (namespace.get foo)
1280 #    }
1281 #
1282 # A method name is the word immediately before parenthesis, with an open
1283 # curly brace immediately following closing parenthesis. For simplification
1284 # we only parse for methods inside of a class. And for a class expression
1285 # we take the assignment identifier instead of the class name for namespacing.
1286 #
1287 #    namespace.Foo = class DoesNotMatter extends Bar {
1288 #        constructor() {} // (namespace.Foo)
1289 #        static staticMethod() {} // (namespace.Foo.staticMethod)
1290 #        instanceMethod() {} // (namespace.Foo.prototype.instanceMethod)
1291 #        get getter() {} // (namespace.Foo.prototype.get getter)
1292 #    }
1293 #    class ClassName {
1294 #        constructor() {} // (ClassName)
1295 #        method() {} // (ClassName.prototype.method)
1296 #    }
1297 #
1298 # Comment handling is simple-minded but will work for all but pathological cases.
1299 #
1300 # Result is a list of triples: [ start_line, end_line, function_name ].
1301
1302 sub get_function_line_ranges_for_javascript($$)
1303 {
1304     my ($fileHandle, $fileName) = @_;
1305
1306     my @currentScopes;
1307     my @currentIdentifiers;
1308     my @currentParsingMode = ("global");
1309     my @currentFunctionNames;
1310     my @currentFunctionDepths;
1311     my @currentFunctionStartLines;
1312
1313     my @ranges;
1314
1315     my $inComment = 0;
1316     my $inQuotedText = "";
1317     my $inExtends = 0;
1318     my $inMethod = 0;
1319     my $parenthesesDepth = 0;
1320     my $bracesDepth = 0;
1321
1322     my $classJustSeen = 0;
1323     my $parenthesisJustSeen = 0;
1324     my $functionJustSeen = 0;
1325     my $getterJustSeen = 0;
1326     my $setterJustSeen = 0;
1327     my $assignmentJustSeen = 0;
1328     my $staticOrContructorSeen = 0;
1329
1330     my $possibleMethodName = "";
1331     my $word = "";
1332
1333     while (<$fileHandle>) {
1334         # Handle continued multi-line comment.
1335         if ($inComment) {
1336             next unless s-.*\*/--;
1337             $inComment = 0;
1338         }
1339
1340         # Handle continued quoted text.
1341         if ($inQuotedText ne "") {
1342             next if /\\$/;
1343             s-([^\\]|\\.)*?$inQuotedText--;
1344             $inQuotedText = "";
1345         }
1346
1347         # Handle comments and quoted text.
1348         while (m-(/\*|//|\'|\")-) { # \' and \" keep emacs perl mode happy
1349             my $match = $1;
1350             if ($match eq '/*') {
1351                 if (!s-/\*.*?\*/--) {
1352                     s-/\*.*--;
1353                     $inComment = 1;
1354                 }
1355             } elsif ($match eq '//') {
1356                 s-//.*--;
1357             } else { # ' or "
1358                 if (!s-$match([^\\]|\\.)*?$match-string_appeared_here-) {
1359                     $inQuotedText = $match if /\\$/;
1360                     warn "mismatched quotes at line $. in $fileName\n" if $inQuotedText eq "";
1361                     s-$match.*--;
1362                 }
1363             }
1364         }
1365
1366         # Find function names.
1367         while (m-(\w+|[(){}=:;,])-g) {
1368             # Skip everything until "{" after extends.
1369             if ($inExtends) {
1370                 next if $1 ne '{';
1371                 $inExtends = 0;
1372             }
1373
1374             # Open parenthesis.
1375             if ($1 eq '(') {
1376                 $parenthesesDepth++;
1377                 $possibleMethodName = join('.', @currentIdentifiers);
1378                 next;
1379             }
1380
1381             # Close parenthesis.
1382             if ($1 eq ')') {
1383                 $parenthesesDepth--;
1384                 $parenthesisJustSeen = 1;
1385                 next;
1386             }
1387
1388             # Open brace.
1389             if ($1 eq '{') {
1390                 my $methodName = "";
1391
1392                 # Method.
1393                 if ($currentParsingMode[$#currentParsingMode] eq 'class' and $parenthesisJustSeen and ($staticOrContructorSeen or $possibleMethodName)) {
1394                     $methodName = join('.', $staticOrContructorSeen ? "" : "prototype", $possibleMethodName);
1395                     $methodName =~ s/\.{2,}/\./g; # Removes consecutive periods.
1396                     $methodName =~ s/\.$//; # Remove trailing period.
1397
1398                     my $currentMethod = join('.', @currentScopes, $methodName);
1399                     $currentMethod =~ s/\.{2,}/\./g; # Removes consecutive periods.
1400                     $currentMethod =~ s/\.$//; # Remove trailing period.
1401
1402                     push(@currentParsingMode, "method");
1403                     push(@currentFunctionNames, $currentMethod);
1404                     push(@currentFunctionDepths, $bracesDepth);
1405                     push(@currentFunctionStartLines, $.);
1406                 }
1407
1408                 $bracesDepth++;
1409                 $functionJustSeen = 0;
1410
1411                 push(@currentScopes, join('.', $methodName ? $methodName : @currentIdentifiers));
1412                 @currentIdentifiers = ();
1413
1414                 $staticOrContructorSeen = 0;
1415                 next;
1416             }
1417
1418             # Close brace.
1419             if ($1 eq '}') {
1420                 $bracesDepth--;
1421                 $functionJustSeen = 0;
1422
1423                 if (@currentFunctionDepths and $bracesDepth == $currentFunctionDepths[$#currentFunctionDepths]) {
1424                     pop(@currentFunctionDepths);
1425                     pop(@currentParsingMode);
1426
1427                     my $currentName = pop(@currentFunctionNames);
1428                     my $start = pop(@currentFunctionStartLines);
1429
1430                     push(@ranges, [$start, $., $currentName]);
1431                 }
1432
1433                 pop(@currentScopes);
1434                 @currentIdentifiers = ();
1435
1436                 next;
1437             }
1438
1439             # Semicolon or comma.
1440             if ($1 eq ';' or $1 eq ',') {
1441                 @currentIdentifiers = ();
1442                 next;
1443             }
1444
1445             # Class.
1446             if ($1 eq 'class') {
1447                 $classJustSeen = 1;
1448                 next;
1449             }
1450
1451             # Extends.
1452             if ($1 eq 'extends') {
1453                 $inExtends = 1;
1454                 next;
1455             }
1456
1457             # Function.
1458             if ($1 eq 'function') {
1459                 $functionJustSeen = 1;
1460
1461                 if ($assignmentJustSeen) {
1462                     my $currentFunction = join('.', (@currentScopes, @currentIdentifiers));
1463                     $currentFunction =~ s/\.{2,}/\./g; # Removes consecutive periods.
1464
1465                     push(@currentParsingMode, "function");
1466                     push(@currentFunctionNames, $currentFunction);
1467                     push(@currentFunctionDepths, $bracesDepth);
1468                     push(@currentFunctionStartLines, $.);
1469                 }
1470
1471                 next;
1472             }
1473
1474             # Getter prefix.
1475             if ($1 eq 'get') {
1476                 $getterJustSeen = 1;
1477                 next;
1478             }
1479
1480             # Setter prefix.
1481             if ($1 eq 'set') {
1482                 $setterJustSeen = 1;
1483                 next;
1484             }
1485
1486             # Static.
1487             if ($1 eq 'static' or $1 eq 'constructor') {
1488                 $staticOrContructorSeen = 1;
1489                 next;
1490             }
1491
1492             # Assignment operator.
1493             if ($1 eq '=' or $1 eq ':') {
1494                 $assignmentJustSeen = 1;
1495                 next;
1496             }
1497
1498             next if $parenthesesDepth;
1499
1500             # Word.
1501             $word = $1;
1502
1503             if ($classJustSeen) {
1504                 push(@currentIdentifiers, $word) if !$assignmentJustSeen;
1505
1506                 my $currentClass = join('.', (@currentScopes, @currentIdentifiers));
1507                 $currentClass =~ s/\.{2,}/\./g; # Removes consecutive periods.
1508
1509                 push(@currentParsingMode, "class");
1510                 push(@currentFunctionNames, $currentClass);
1511                 push(@currentFunctionDepths, $bracesDepth);
1512                 push(@currentFunctionStartLines, $.);
1513             } elsif ($getterJustSeen or $setterJustSeen) {
1514                 $word = "get $word" if $getterJustSeen;
1515                 $word = "set $word" if $setterJustSeen;
1516
1517                 push(@currentIdentifiers, $word);
1518
1519                 my $mode = $currentParsingMode[$#currentParsingMode];
1520                 my $currentFunction = join('.', (@currentScopes, ($mode eq 'class') ? "prototype" : "", @currentIdentifiers));
1521                 $currentFunction =~ s/\.{2,}/\./g; # Removes consecutive periods.
1522
1523                 push(@currentParsingMode, "function");
1524                 push(@currentFunctionNames, $currentFunction);
1525                 push(@currentFunctionDepths, $bracesDepth);
1526                 push(@currentFunctionStartLines, $.);
1527             } elsif ($functionJustSeen and !$assignmentJustSeen) {
1528                 push(@currentIdentifiers, $word);
1529
1530                 my $currentFunction = join('.', (@currentScopes, @currentIdentifiers));
1531                 $currentFunction =~ s/\.{2,}/\./g; # Removes consecutive periods.
1532
1533                 push(@currentParsingMode, "function");
1534                 push(@currentFunctionNames, $currentFunction);
1535                 push(@currentFunctionDepths, $bracesDepth);
1536                 push(@currentFunctionStartLines, $.);
1537             } elsif ($word ne 'if' and $word ne 'for' and $word ne 'do' and $word ne 'while' and $word ne 'which' and $word ne 'var') {
1538                 push(@currentIdentifiers, $word);
1539             }
1540
1541             $classJustSeen = 0;
1542             $parenthesisJustSeen = 0;
1543             $functionJustSeen = 0;
1544             $getterJustSeen = 0;
1545             $setterJustSeen = 0;
1546             $assignmentJustSeen = 0;
1547         }
1548     }
1549
1550     warn "mismatched braces in $fileName\n" if $bracesDepth;
1551     warn "mismatched parentheses in $fileName\n" if $parenthesesDepth;
1552
1553     return @ranges;
1554 }
1555
1556 # Read a file and get all the line ranges of the things that look like Perl functions. Functions
1557 # start on a line that starts with "sub ", and end on the first line starting with "}" thereafter.
1558 #
1559 # Result is a list of triples: [ start_line, end_line, function ].
1560
1561 sub get_function_line_ranges_for_perl($$)
1562 {
1563     my ($fileHandle, $fileName) = @_;
1564
1565     my @ranges;
1566
1567     my $currentFunction = "";
1568     my $start = 0;
1569     my $hereDocumentIdentifier = "";
1570
1571     while (<$fileHandle>) {
1572         chomp;
1573         if (!$hereDocumentIdentifier) {
1574             if (/^sub\s+([\w_][\w\d_]*)/) {
1575                 # Skip over forward declarations, which don't contain a brace and end with a semicolon.
1576                 next if /;\s*$/;
1577
1578                 if ($currentFunction) {
1579                     warn "nested functions found at top-level at $fileName:$.\n";
1580                     next;
1581                 }
1582                 $currentFunction = $1;
1583                 $start = $.;
1584             }
1585             if (/<<\s*[\"\']?([\w_][\w_\d]*)/) {
1586                 # Enter here-document.
1587                 $hereDocumentIdentifier = $1;
1588             }
1589             if (index($_, "}") == 0) {
1590                 next unless $start;
1591                 push(@ranges, [$start, $., $currentFunction]);
1592                 $currentFunction = "";
1593                 $start = 0;
1594             }
1595         } elsif ($_ eq $hereDocumentIdentifier) {
1596             # Escape from here-document.
1597             $hereDocumentIdentifier = "";
1598         }
1599     }
1600
1601     return @ranges;
1602 }
1603
1604 # Read a file and get all the line ranges of the things that look like Python classes, methods, or functions.
1605 #
1606 # FIXME: Maybe we should use Python's ast module to do the parsing for us?
1607 #
1608 # Result is a list of triples: [ start_line, end_line, function ].
1609
1610 sub get_function_line_ranges_for_python($$)
1611 {
1612     my ($fileHandle, $fileName) = @_;
1613
1614     my @ranges;
1615
1616     my @scopeStack = ({ line => 0, indent => -1, name => undef });
1617     my $lastLine = 0;
1618     until ($lastLine) {
1619         $_ = <$fileHandle>;
1620         unless ($_) {
1621             # To pop out all popped scopes, run the loop once more after
1622             # we encountered the end of the file.
1623             $_ = "pass\n";
1624             $.++;
1625             $lastLine = 1;
1626         }
1627         chomp;
1628         next unless /^(\s*)([^#].*)$/;
1629
1630         my $indent = length $1;
1631         my $rest = $2;
1632         my $scope = $scopeStack[-1];
1633
1634         if ($indent <= $scope->{indent}) {
1635             # Find all the scopes that we have just exited.
1636             my $i = 0;
1637             for (; $i < @scopeStack; ++$i) {
1638                 last if $indent <= $scopeStack[$i]->{indent};
1639             }
1640             my @poppedScopes = splice @scopeStack, $i;
1641
1642             # For each scope that was just exited, add a range that goes from the start of that
1643             # scope to the start of the next nested scope, or to the line just before this one for
1644             # the innermost scope.
1645             for ($i = 0; $i < @poppedScopes; ++$i) {
1646                 my $lineAfterEnd = $i + 1 == @poppedScopes ? $. : $poppedScopes[$i + 1]->{line};
1647                 push @ranges, [$poppedScopes[$i]->{line}, $lineAfterEnd - 1, $poppedScopes[$i]->{name}];
1648             }
1649             @scopeStack or warn "Popped off last scope at $fileName:$.\n";
1650
1651             # Set the now-current scope to start at the current line. Any lines within this scope
1652             # before this point should already have been added to @ranges.
1653             $scope = $scopeStack[-1];
1654             $scope->{line} = $.;
1655         }
1656
1657         next unless $rest =~ /(?:class|def)\s+(\w+)/;
1658         my $name = $1;
1659         my $fullName = $scope->{name} ? join('.', $scope->{name}, $name) : $name;
1660         push @scopeStack, { line => $., indent => $indent, name => $fullName };
1661
1662         if ($scope->{indent} >= 0) {
1663             push @ranges, [$scope->{line}, $. - 1, $scope->{name}];
1664         }
1665     }
1666
1667     return @ranges;
1668 }
1669
1670 # Read a file and get all the line ranges of the things that look like CSS selectors.  A selector is
1671 # anything before an opening brace on a line. A selector starts at the line containing the opening
1672 # brace and ends at the closing brace.
1673 #
1674 # Result is a list of triples: [ start_line, end_line, selector ].
1675
1676 sub get_selector_line_ranges_for_css($$)
1677 {
1678     my ($fileHandle, $fileName) = @_;
1679
1680     my @ranges;
1681
1682     my $currentSelector = "";
1683     my $start = 0;
1684     my $inComment = 0;
1685     my $inBrace = 0;
1686
1687     while (<$fileHandle>) {
1688         foreach my $token (split m-(\{|\}|/\*|\*/)-, $_) {
1689             if ($token eq "{") {
1690                 if (!$inComment) {
1691                     warn "mismatched brace found in $fileName\n" if $inBrace;
1692                     $inBrace = 1;
1693                 }
1694             } elsif ($token eq "}") {
1695                 if (!$inComment) {
1696                     warn "mismatched brace found in $fileName\n" if !$inBrace;
1697                     $inBrace = 0;
1698                     push(@ranges, [$start, $., $currentSelector]);
1699                     $currentSelector = "";
1700                     $start = 0;
1701                 }
1702             } elsif ($token eq "/*") {
1703                 $inComment = 1;
1704             } elsif ($token eq "*/") {
1705                 warn "mismatched comment found in $fileName\n" if !$inComment;
1706                 $inComment = 0;
1707             } else {
1708                 if (!$inComment and !$inBrace and $token !~ /^[\s\t]*$/) {
1709                     $token =~ s/^[\s\t]*|[\s\t]*$//g;
1710                     $currentSelector = $token;
1711                     $start = $.;
1712                 }
1713             }
1714         }
1715     }
1716
1717     return @ranges;
1718 }
1719
1720 sub processPaths(\@)
1721 {
1722     my ($paths) = @_;
1723     return ("." => 1) if (!@{$paths});
1724
1725     my %result = ();
1726
1727     for my $file (@{$paths}) {
1728         die "can't handle absolute paths like \"$file\"\n" if File::Spec->file_name_is_absolute($file);
1729         die "can't handle empty string path\n" if $file eq "";
1730         die "can't handle path with single quote in the name like \"$file\"\n" if $file =~ /'/; # ' (keep Xcode syntax highlighting happy)
1731
1732         my $untouchedFile = $file;
1733
1734         $file = canonicalizePath($file);
1735
1736         die "can't handle paths with .. like \"$untouchedFile\"\n" if $file =~ m|/\.\./|;
1737
1738         $result{$file} = 1;
1739     }
1740
1741     return ("." => 1) if ($result{"."});
1742
1743     # Remove any paths that also have a parent listed.
1744     for my $path (keys %result) {
1745         for (my $parent = dirname($path); $parent ne '.'; $parent = dirname($parent)) {
1746             if ($result{$parent}) {
1747                 delete $result{$path};
1748                 last;
1749             }
1750         }
1751     }
1752
1753     return %result;
1754 }
1755
1756 sub diffFromToString($$$)
1757 {
1758     my ($gitCommit, $gitIndex, $mergeBase) = @_;
1759
1760     return "" if isSVN();
1761     return $gitCommit if $gitCommit =~ m/.+\.\..+/;
1762     return "\"$gitCommit^\" \"$gitCommit\"" if $gitCommit;
1763     return "--cached" if $gitIndex;
1764     return $mergeBase if $mergeBase;
1765     return "HEAD" if isGit();
1766 }
1767
1768 sub diffCommand($$$$)
1769 {
1770     my ($paths, $gitCommit, $gitIndex, $mergeBase) = @_;
1771
1772     my $command;
1773     if (isSVN()) {
1774         my @escapedPaths = map(escapeSubversionPath($_), @$paths);
1775         my $escapedPathsString = "'" . join("' '", @escapedPaths) . "'";
1776         $command = SVN . " diff --diff-cmd diff -x -u $escapedPathsString";
1777     } elsif (isGit()) {
1778         my $pathsString = "'" . join("' '", @$paths) . "'"; 
1779         $command = GIT . " diff --no-ext-diff -U0 " . diffFromToString($gitCommit, $gitIndex, $mergeBase);
1780         $command .= " -- $pathsString" unless $gitCommit or $mergeBase;
1781     }
1782
1783     return $command;
1784 }
1785
1786 sub statusCommand($$$$)
1787 {
1788     my ($paths, $gitCommit, $gitIndex, $mergeBase) = @_;
1789
1790     my $command;
1791     if (isSVN()) {
1792         my @escapedFiles = map(escapeSubversionPath($_), keys %$paths);
1793         my $escapedFilesString = "'" . join("' '", @escapedFiles) . "'";
1794         $command = SVN . " stat $escapedFilesString";
1795     } elsif (isGit()) {
1796         my $filesString = '"' . join('" "', keys %$paths) . '"';
1797         $command = GIT . " diff -r --name-status -M -C " . diffFromToString($gitCommit, $gitIndex, $mergeBase);
1798         $command .= " -- $filesString" unless $gitCommit;
1799     }
1800
1801     return "$command 2>&1";
1802 }
1803
1804 sub createPatchCommand($$$$)
1805 {
1806     my ($changedFilesString, $gitCommit, $gitIndex, $mergeBase) = @_;
1807
1808     my $command;
1809     if (isSVN()) {
1810         $command = "'$FindBin::Bin/svn-create-patch --no-style' $changedFilesString";
1811     } elsif (isGit()) {
1812         $command = GIT . " diff -M -C " . diffFromToString($gitCommit, $gitIndex, $mergeBase);
1813         $command .= " -- $changedFilesString" unless $gitCommit;
1814     }
1815
1816     return $command;
1817 }
1818
1819 sub diffHeaderFormat()
1820 {
1821     return qr/^Index: (\S+)[\r\n]*$/ if isSVN();
1822     return qr/^diff --git a\/.+ b\/(.+)$/ if isGit();
1823 }
1824
1825 sub findOriginalFileFromSvn($)
1826 {
1827     my ($file) = @_;
1828     my $baseUrl;
1829     open INFO, SVN . " info . |" or die;
1830     while (<INFO>) {
1831         if (/^URL: (.+?)[\r\n]*$/) {
1832             $baseUrl = $1;
1833         }
1834     }
1835     close INFO;
1836     my $sourceFile;
1837     my $escapedFile = escapeSubversionPath($file);
1838     open INFO, SVN . " info '$escapedFile' |" or die;
1839     while (<INFO>) {
1840         if (/^Copied From URL: (.+?)[\r\n]*$/) {
1841             $sourceFile = File::Spec->abs2rel($1, $baseUrl);
1842         }
1843     }
1844     close INFO;
1845     return $sourceFile;
1846 }
1847
1848 sub determinePropertyChanges($$$)
1849 {
1850     my ($file, $isAdd, $original) = @_;
1851
1852     my $escapedFile = escapeSubversionPath($file);
1853     my %changes;
1854     if ($isAdd) {
1855         my %addedProperties;
1856         my %removedProperties;
1857         open PROPLIST, SVN . " proplist '$escapedFile' |" or die;
1858         while (<PROPLIST>) {
1859             $addedProperties{$1} = 1 if /^  (.+?)[\r\n]*$/ && $1 ne 'svn:mergeinfo';
1860         }
1861         close PROPLIST;
1862         if ($original) {
1863             my $escapedOriginal = escapeSubversionPath($original);
1864             open PROPLIST, SVN . " proplist '$escapedOriginal' |" or die;
1865             while (<PROPLIST>) {
1866                 next unless /^  (.+?)[\r\n]*$/;
1867                 my $property = $1;
1868                 if (exists $addedProperties{$property}) {
1869                     delete $addedProperties{$1};
1870                 } else {
1871                     $removedProperties{$1} = 1;
1872                 }
1873             }
1874         }
1875         $changes{"A"} = [sort keys %addedProperties] if %addedProperties;
1876         $changes{"D"} = [sort keys %removedProperties] if %removedProperties;
1877     } else {
1878         open DIFF, SVN . " diff '$escapedFile' |" or die;
1879         while (<DIFF>) {
1880             if (/^Property changes on:/) {
1881                 while (<DIFF>) {
1882                     my $operation;
1883                     my $property;
1884                     if (/^Added: (\S*)/) {
1885                         $operation = "A";
1886                         $property = $1;
1887                     } elsif (/^Modified: (\S*)/) {
1888                         $operation = "M";
1889                         $property = $1;
1890                     } elsif (/^Deleted: (\S*)/) {
1891                         $operation = "D";
1892                         $property = $1;
1893                     } elsif (/^Name: (\S*)/) {
1894                         # Older versions of svn just say "Name" instead of the type
1895                         # of property change.
1896                         $operation = "C";
1897                         $property = $1;
1898                     }
1899                     if ($operation) {
1900                         $changes{$operation} = [] unless exists $changes{$operation};
1901                         push @{$changes{$operation}}, $property;
1902                     }
1903                 }
1904             }
1905         }
1906         close DIFF;
1907     }
1908     return \%changes;
1909 }
1910
1911 sub pluralizeAndList($$@)
1912 {
1913     my ($singular, $plural, @items) = @_;
1914
1915     return if @items == 0;
1916     return "$singular $items[0]" if @items == 1;
1917     return "$plural " . join(", ", @items[0 .. $#items - 1]) . " and " . $items[-1];
1918 }
1919
1920 sub generateFileList(\%$$$)
1921 {
1922     my ($paths, $gitCommit, $gitIndex, $mergeBase) = @_;
1923
1924     my @changedFiles;
1925     my @conflictFiles;
1926     my %functionLists;
1927     my @addedRegressionTests;
1928     print STDERR "  Running status to find changed, added, or removed files.\n";
1929     open STAT, "-|", statusCommand($paths, $gitCommit, $gitIndex, $mergeBase) or die "The status failed: $!.\n";
1930     while (<STAT>) {
1931         my $status;
1932         my $propertyStatus;
1933         my $propertyChanges;
1934         my $original;
1935         my $file;
1936
1937         if (isSVN()) {
1938             my $matches;
1939             if (isSVNVersion16OrNewer()) {
1940                 $matches = /^([ ACDMR])([ CM]).{5} (.+?)[\r\n]*$/;
1941                 $status = $1;
1942                 $propertyStatus = $2;
1943                 $file = $3;
1944             } else {
1945                 $matches = /^([ ACDMR])([ CM]).{4} (.+?)[\r\n]*$/;
1946                 $status = $1;
1947                 $propertyStatus = $2;
1948                 $file = $3;
1949             }
1950             if ($matches) {
1951                 $file = normalizePath($file);
1952                 $original = findOriginalFileFromSvn($file) if substr($_, 3, 1) eq "+";
1953                 my $isAdd = isAddedStatus($status);
1954                 $propertyChanges = determinePropertyChanges($file, $isAdd, $original) if isModifiedStatus($propertyStatus) || $isAdd;
1955             } else {
1956                 print;  # error output from svn stat
1957             }
1958         } elsif (isGit()) {
1959             if (/^([ADM])\t(.+)$/) {
1960                 $status = $1;
1961                 $propertyStatus = " ";  # git doesn't have properties
1962                 $file = normalizePath($2);
1963             } elsif (/^([CR])[0-9]{1,3}\t([^\t]+)\t([^\t\n]+)$/) { # for example: R90%    newfile    oldfile
1964                 $status = $1;
1965                 $propertyStatus = " ";
1966                 $original = normalizePath($2);
1967                 $file = normalizePath($3);
1968             } else {
1969                 print;  # error output from git diff
1970             }
1971         }
1972
1973         next if !$status || isUnmodifiedStatus($status) && isUnmodifiedStatus($propertyStatus);
1974
1975         $file = makeFilePathRelative($file);
1976
1977         if (isModifiedStatus($status) || isAddedStatus($status) || isModifiedStatus($propertyStatus)) {
1978             my @components = File::Spec->splitdir($file);
1979             if ($components[0] eq "LayoutTests") {
1980                 push @addedRegressionTests, $file
1981                     if isAddedStatus($status)
1982                        && $file =~ /\.([a-zA-Z]+)$/
1983                        && SupportedTestExtensions->{lc($1)}
1984                        && $file !~ /-expected(-mismatch)?\.html$/
1985                        && !scalar(grep(/^resources$/i, @components))
1986                        && !scalar(grep(/^script-tests$/i, @components));
1987             }
1988             push @changedFiles, $file if $components[$#components] ne "ChangeLog";
1989         } elsif (isConflictStatus($status, $gitCommit, $gitIndex) || isConflictStatus($propertyStatus, $gitCommit, $gitIndex)) {
1990             push @conflictFiles, $file;
1991         }
1992         if (basename($file) ne "ChangeLog") {
1993             my $description = statusDescription($status, $propertyStatus, $original, $propertyChanges);
1994             $functionLists{$file} = $description if defined $description;
1995         }
1996     }
1997     close STAT;
1998     return (\@changedFiles, \@conflictFiles, \%functionLists, \@addedRegressionTests);
1999 }
2000
2001 sub isUnmodifiedStatus($)
2002 {
2003     my ($status) = @_;
2004
2005     my %statusCodes = (
2006         " " => 1,
2007     );
2008
2009     return $statusCodes{$status};
2010 }
2011
2012 sub isModifiedStatus($)
2013 {
2014     my ($status) = @_;
2015
2016     my %statusCodes = (
2017         "M" => 1,
2018     );
2019
2020     return $statusCodes{$status};
2021 }
2022
2023 sub isAddedStatus($)
2024 {
2025     my ($status) = @_;
2026
2027     my %statusCodes = (
2028         "A" => 1,
2029         "C" => isGit(),
2030         "R" => 1,
2031     );
2032
2033     return $statusCodes{$status};
2034 }
2035
2036 sub isConflictStatus($$$)
2037 {
2038     my ($status, $gitCommit, $gitIndex) = @_;
2039
2040     my %svn = (
2041         "C" => 1,
2042     );
2043
2044     my %git = (
2045         "U" => 1,
2046     );
2047
2048     return 0 if ($gitCommit || $gitIndex); # an existing commit or staged change cannot have conflicts
2049     return $svn{$status} if isSVN();
2050     return $git{$status} if isGit();
2051 }
2052
2053 sub statusDescription($$$$)
2054 {
2055     my ($status, $propertyStatus, $original, $propertyChanges) = @_;
2056
2057     my $propertyDescription = defined $propertyChanges ? propertyChangeDescription($propertyChanges) : "";
2058
2059     my %svn = (
2060         "A" => defined $original ? " Copied from \%s." : " Added.",
2061         "D" => " Removed.",
2062         "M" => "",
2063         "R" => defined $original ? " Replaced with \%s." : " Replaced.",
2064         " " => "",
2065     );
2066
2067     my %git = %svn;
2068     $git{"A"} = " Added.";
2069     $git{"C"} = " Copied from \%s.";
2070     $git{"R"} = " Renamed from \%s.";
2071
2072     my $description;
2073     $description = sprintf($svn{$status}, $original) if isSVN() && exists $svn{$status};
2074     $description = sprintf($git{$status}, $original) if isGit() && exists $git{$status};
2075     return unless defined $description;
2076
2077     $description .= $propertyDescription unless isAddedStatus($status);
2078     return $description;
2079 }
2080
2081 sub propertyChangeDescription($)
2082 {
2083     my ($propertyChanges) = @_;
2084
2085     my %operations = (
2086         "A" => "Added",
2087         "M" => "Modified",
2088         "D" => "Removed",
2089         "C" => "Changed",
2090     );
2091
2092     my $description = "";
2093     while (my ($operation, $properties) = each %$propertyChanges) {
2094         my $word = $operations{$operation};
2095         my $list = pluralizeAndList("property", "properties", @$properties);
2096         $description .= " $word $list.";
2097     }
2098     return $description;
2099 }
2100
2101 sub extractLineRangeAfterChange($)
2102 {
2103     my ($string) = @_;
2104     my $chunkRange = parseChunkRange($string);
2105     if (!$chunkRange || !$chunkRange->{newStartingLine} || !$chunkRange->{newLineCount}) {
2106          # Deletion; no lines exist after change.
2107         return (-1, -1);
2108     }
2109     return ($chunkRange->{newStartingLine}, $chunkRange->{newStartingLine} + $chunkRange->{newLineCount} - 1);
2110 }
2111
2112 sub extractLineRangeBeforeChange($)
2113 {
2114     my ($string) = @_;
2115     my $chunkRange = parseChunkRange($string);
2116     if (!$chunkRange || !$chunkRange->{startingLine} || !$chunkRange->{lineCount}) {
2117         # Addition; no lines existed before change.
2118         return (-1, -1);
2119     }
2120     return ($chunkRange->{startingLine}, $chunkRange->{startingLine} + $chunkRange->{lineCount} - 1);
2121 }
2122
2123 sub testListForChangeLog(@)
2124 {
2125     my (@tests) = @_;
2126
2127     return "" unless @tests;
2128
2129     my $leadString = "        Test" . (@tests == 1 ? "" : "s") . ": ";
2130     my $list = $leadString;
2131     foreach my $i (0..$#tests) {
2132         $list .= " " x length($leadString) if $i;
2133         my $test = $tests[$i];
2134         $test =~ s/^LayoutTests\///;
2135         $list .= "$test\n";
2136     }
2137     $list .= "\n";
2138
2139     return $list;
2140 }
2141
2142 sub reviewerAndDescriptionForGitCommit($$)
2143 {
2144     my ($commit, $gitReviewer) = @_;
2145
2146     my $description = '';
2147     my $reviewer;
2148
2149     my @args = qw(rev-list --pretty);
2150     push @args, '-1' if $commit !~ m/.+\.\..+/;
2151     my $gitLog;
2152     {
2153         local $/ = undef;
2154         open(GITLOG, "-|", GIT, @args, $commit) || die;
2155         $gitLog = <GITLOG>;
2156         close(GITLOG);
2157     }
2158
2159     my @commitLogs = split(/^[Cc]ommit [a-f0-9]{40}/m, $gitLog);
2160     shift @commitLogs; # Remove initial blank commit log
2161     my $commitLogCount = 0;
2162     foreach my $commitLog (@commitLogs) {
2163         $description .= "\n" if $commitLogCount;
2164         $commitLogCount++;
2165         my $inHeader = 1;
2166         my $commitLogIndent; 
2167         my @lines = split(/\n/, $commitLog);
2168         shift @lines; # Remove initial blank line
2169         foreach my $line (@lines) {
2170             if ($inHeader) {
2171                 if (!$line) {
2172                     $inHeader = 0;
2173                 }
2174                 next;
2175             } elsif ($line =~ /[Ss]igned-[Oo]ff-[Bb]y: (.+)/) {
2176                 if (!$reviewer) {
2177                     $reviewer = $1;
2178                 } else {
2179                     $reviewer .= ", " . $1;
2180                 }
2181             } elsif ($line =~ /^\s*$/) {
2182                 $description = $description . "\n";
2183             } else {
2184                 if (!defined($commitLogIndent)) {
2185                     # Let the first line with non-white space determine
2186                     # the global indent.
2187                     $line =~ /^(\s*)\S/;
2188                     $commitLogIndent = length($1);
2189                 }
2190                 # Strip at most the indent to preserve relative indents.
2191                 $line =~ s/^\s{0,$commitLogIndent}//;
2192                 $description = $description . (" " x 8) . $line . "\n";
2193             }
2194         }
2195     }
2196     if (!$reviewer) {
2197       $reviewer = $gitReviewer;
2198     }
2199
2200     return ($reviewer, $description);
2201 }
2202
2203 sub normalizeLineEndings($$)
2204 {
2205     my ($string, $endl) = @_;
2206     $string =~ s/\r?\n/$endl/g;
2207     return $string;
2208 }
2209
2210 sub decodeEntities($)
2211 {
2212     my ($text) = @_;
2213     $text =~ s/\&lt;/</g;
2214     $text =~ s/\&gt;/>/g;
2215     $text =~ s/\&quot;/\"/g;
2216     $text =~ s/\&apos;/\'/g;
2217     $text =~ s/\&amp;/\&/g;
2218     return $text;
2219 }