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