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