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