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