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