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