Bug 16052: prepare-ChangeLog doesn't report deleted files
[WebKit-https.git] / WebKitTools / 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 #
8 #  prepare-ChangeLog is free software; you can redistribute it and/or
9 #  modify it under the terms of the GNU General Public
10 #  License as published by the Free Software Foundation; either
11 #  version 2 of the License, or (at your option) any later version.
12 #
13 #  prepare-ChangeLog is distributed in the hope that it will be useful,
14 #  but WITHOUT ANY WARRANTY; without even the implied warranty of
15 #  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
16 #  General Public License for more details.
17 #
18 #  You should have received a copy of the GNU General Public
19 #  License along with this program; if not, write to the Free
20 #  Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
21 #
22
23
24 # Perl script to create a ChangeLog entry with names of files
25 # and functions from a diff.
26 #
27 # Darin Adler <darin@bentspoon.com>, started 20 April 2000
28 # Java support added by Maciej Stachowiak <mjs@eazel.com>
29 # Objective-C, C++ and Objective-C++ support added by Maciej Stachowiak <mjs@apple.com>
30 # Git support added by Adam Roben <aroben@apple.com>
31
32
33 #
34 # TODO:
35 #   List functions that have been removed too.
36 #   Decide what a good logical order is for the changed files
37 #     other than a normal text "sort" (top level first?)
38 #     (group directories?) (.h before .c?)
39 #   Handle yacc source files too (other languages?).
40 #   Help merge when there are ChangeLog conflicts or if there's
41 #     already a partly written ChangeLog entry.
42 #   Add command line option to put the ChangeLog into a separate
43 #     file or just spew it out stdout.
44 #   Add SVN version numbers for commit (can't do that until
45 #     the changes are checked in, though).
46 #   Work around diff stupidity where deleting a function that starts
47 #     with a comment makes diff think that the following function
48 #     has been changed (if the following function starts with a comment
49 #     with the same first line, such as /**)
50 #   Work around diff stupidity where deleting an entire function and
51 #     the blank lines before it makes diff think you've changed the
52 #     previous function.
53
54 use strict;
55 use warnings;
56
57 use File::Basename;
58 use File::Spec;
59 use FindBin;
60 use Getopt::Long;
61 use lib $FindBin::Bin;
62 use POSIX qw(strftime);
63 use VCSUtils;
64
65 sub changeLogDate($);
66 sub firstDirectoryOrCwd();
67 sub diffFromToString();
68 sub diffCommand(@);
69 sub statusCommand(@);
70 sub createPatchCommand($);
71 sub diffHeaderFormat();
72 sub findOriginalFileFromSvn($);
73 sub generateFileList(\@\@\%);
74 sub gitConfig($);
75 sub isModifiedStatus($);
76 sub isAddedStatus($);
77 sub isConflictStatus($);
78 sub statusDescription($$);
79 sub extractLineRange($);
80 sub canonicalizePath($);
81 sub testListForChangeLog(@);
82 sub get_function_line_ranges($$);
83 sub get_function_line_ranges_for_c($$);
84 sub get_function_line_ranges_for_java($$);
85 sub method_decl_to_selector($);
86 sub processPaths(\@);
87 sub reviewerAndDescriptionForGitCommit($);
88
89 # Project time zone for Cupertino, CA, US
90 my $changeLogTimeZone = "PST8PDT";
91
92 my $gitCommit = 0;
93 my $gitReviewer = "";
94 my $openChangeLogs = 0;
95 my $showHelp = 0;
96 my $spewDiff = $ENV{"PREPARE_CHANGELOG_DIFF"};
97 my $updateChangeLogs = 1;
98 my $parseOptionsResult =
99     GetOptions("diff|d!" => \$spewDiff,
100                "git-commit:s" => \$gitCommit,
101                "git-reviewer:s" => \$gitReviewer,
102                "help|h!" => \$showHelp,
103                "open|o!" => \$openChangeLogs,
104                "update!" => \$updateChangeLogs);
105 if (!$parseOptionsResult || $showHelp) {
106     print STDERR basename($0) . " [-d|--diff] [-h|--help] [-o|--open] [--git-commit=<committish>] [--git-reviewer=<name>] [svndir1 [svndir2 ...]]\n";
107     print STDERR "  -d|--diff      Spew diff to stdout when running\n";
108     print STDERR "  --git-commit   Populate the ChangeLogs from the specified git commit\n";
109     print STDERR "  --git-reviewer When populating the ChangeLogs from a git commit claim that the spcified name reviewed the change.\n";
110     print STDERR "                 This option is useful when the git commit lacks a Signed-Off-By: line\n";
111     print STDERR "  -h|--help      Show this help message\n";
112     print STDERR "  -o|--open      Open ChangeLogs in an editor when done\n";
113     print STDERR "  --[no-]update  Update ChangeLogs from svn before adding entry (default: update)\n";
114     exit 1;
115 }
116
117 my %paths = processPaths(@ARGV);
118
119 my $isGit = isGitDirectory(firstDirectoryOrCwd());
120 my $isSVN = isSVNDirectory(firstDirectoryOrCwd());
121
122 $isSVN || $isGit || die "Couldn't determine your version control system.";
123
124 # Find the list of modified files
125 my @changed_files;
126 my $changed_files_string;
127 my %changed_line_ranges;
128 my %function_lists;
129 my @conflict_files;
130
131 my $SVN = "svn";
132 my $GIT = "git";
133
134 my %supportedTestExtensions = map { $_ => 1 } qw(html shtml svg xml xhtml pl php);
135 my @addedRegressionTests = ();
136 my $didChangeRegressionTests = 0;
137
138 generateFileList(@changed_files, @conflict_files, %function_lists);
139
140 if (!@changed_files && !@conflict_files && !keys %function_lists) {
141     print STDERR "  No changes found.\n";
142     exit 1;
143 }
144
145 if (@conflict_files) {
146     print STDERR "  The following files have conflicts. Run prepare-ChangeLog again after fixing the conflicts:\n";
147     print STDERR join("\n", @conflict_files), "\n";
148     exit 1;
149 }
150
151 if (@changed_files) {
152     $changed_files_string = "'" . join ("' '", @changed_files) . "'";
153
154     # For each file, build a list of modified lines.
155     # Use line numbers from the "after" side of each diff.
156     print STDERR "  Reviewing diff to determine which lines changed.\n";
157     my $file;
158     open DIFF, "-|", diffCommand(@changed_files) or die "The diff failed: $!.\n";
159     while (<DIFF>) {
160         $file = makeFilePathRelative($1) if $_ =~ diffHeaderFormat();
161         if (defined $file) {
162             my ($start, $end) = extractLineRange($_);
163             if ($start >= 0 && $end >= 0) {
164                 push @{$changed_line_ranges{$file}}, [ $start, $end ];
165             } elsif (/DO_NOT_COMMIT/) {
166                 print STDERR "WARNING: file $file contains the string DO_NOT_COMMIT, line $.\n";
167             }
168         }
169     }
170     close DIFF;
171 }
172
173 # For each source file, convert line range to function list.
174 if (%changed_line_ranges) {
175     print STDERR "  Extracting affected function names from source files.\n";
176     foreach my $file (keys %changed_line_ranges) {
177         # Only look for function names in .c files.
178         next unless $file =~ /\.(c|cpp|m|mm|h|java)/;
179     
180         # Find all the functions in the file.
181         open SOURCE, $file or next;
182         my @function_ranges = get_function_line_ranges(\*SOURCE, $file);
183         close SOURCE;
184     
185         # Find all the modified functions.
186         my @functions;
187         my %saw_function;
188         my @change_ranges = (@{$changed_line_ranges{$file}}, []);
189         my @change_range = (0, 0);
190         FUNCTION: foreach my $function_range_ref (@function_ranges) {
191             my @function_range = @$function_range_ref;
192     
193             # Advance to successive change ranges.
194             for (;; @change_range = @{shift @change_ranges}) {
195                 last FUNCTION unless @change_range;
196     
197                 # If past this function, move on to the next one.
198                 next FUNCTION if $change_range[0] > $function_range[1];
199     
200                 # If an overlap with this function range, record the function name.
201                 if ($change_range[1] >= $function_range[0]
202                     and $change_range[0] <= $function_range[1]) {
203                     if (!$saw_function{$function_range[2]}) {
204                         $saw_function{$function_range[2]} = 1;
205                         push @functions, $function_range[2];
206                     }
207                     next FUNCTION;
208                 }
209             }
210         }
211     
212         # Format the list of functions now.
213
214         if (@functions) {
215             $function_lists{$file} = "" if !defined $function_lists{$file};
216             $function_lists{$file} .= "\n        (" . join("):\n        (", @functions) . "):";
217         }
218     }
219 }
220
221 # Get some parameters for the ChangeLog we are about to write.
222 my $date = changeLogDate($changeLogTimeZone);
223 my $name = $ENV{CHANGE_LOG_NAME}
224   || $ENV{REAL_NAME}
225   || gitConfig("user.name")
226   || (split /\s*,\s*/, (getpwuid $<)[6])[0]
227   || "set REAL_NAME environment variable";
228 my $email_address = $ENV{CHANGE_LOG_EMAIL_ADDRESS}
229   || $ENV{EMAIL_ADDRESS}
230   || gitConfig("user.email")
231   || "set EMAIL_ADDRESS environment variable";
232
233 if ($gitCommit) {
234     $name = `$GIT log --max-count=1 --pretty=\"format:%an\" \"$gitCommit\"`;
235     $email_address = `$GIT log --max-count=1 --pretty=\"format:%ae\" \"$gitCommit\"`;
236 }
237
238 # Remove trailing parenthesized notes from user name (bit of hack).
239 $name =~ s/\(.*?\)\s*$//g;
240
241 # Find the change logs.
242 my %has_log;
243 my %files;
244 foreach my $file (sort keys %function_lists) {
245     my $prefix = $file;
246     my $has_log = 0;
247     while ($prefix) {
248         $prefix =~ s-/[^/]+/?$-/- or $prefix = "";
249         $has_log = $has_log{$prefix};
250         if (!defined $has_log) {
251             $has_log = -f "${prefix}ChangeLog";
252             $has_log{$prefix} = $has_log;
253         }
254         last if $has_log;
255     }
256     if (!$has_log) {
257         print STDERR "No ChangeLog found for $file.\n";
258     } else {
259         push @{$files{$prefix}}, $file;
260     }
261 }
262
263 # Get the latest ChangeLog files from svn.
264 my @logs = ();
265 foreach my $prefix (sort keys %files) {
266     if ($prefix eq "") {
267         push @logs, "ChangeLog";
268     } else {
269         push @logs, File::Spec->catfile($prefix, "ChangeLog");
270     }
271 }
272
273 if (@logs && $updateChangeLogs && $isSVN) {
274     print STDERR "  Running 'svn update' to update ChangeLog files.\n";
275     open ERRORS, "-|", $SVN, "update", @logs
276         or die "The svn update of ChangeLog files failed: $!.\n";
277     my @conflictedChangeLogs;
278     while (my $line = <ERRORS>) {
279         print STDERR "    ", $line;
280         push @conflictedChangeLogs, $1 if $line =~ m/^C\s+(.+)\s*$/;
281     }
282     close ERRORS;
283
284     if (@conflictedChangeLogs) {
285         print STDERR "  Attempting to merge conflicted ChangeLogs.\n";
286         my $resolveChangeLogsPath = File::Spec->catfile(dirname($0), "resolve-ChangeLogs");
287         open RESOLVE, "-|", $resolveChangeLogsPath, "--no-warnings", @conflictedChangeLogs
288             or die "Could not open resolve-ChangeLogs script: $!.\n";
289         print STDERR "    $_" while <RESOLVE>;
290         close RESOLVE;
291     }
292 }
293
294 # Write out a new ChangeLog file.
295 foreach my $prefix (sort keys %files) {
296     print STDERR "  Editing the ${prefix}ChangeLog file.\n";
297     open OLD_CHANGE_LOG, "${prefix}ChangeLog" or die "Could not open ${prefix}ChangeLog file: $!.\n";
298     # It's less efficient to read the whole thing into memory than it would be
299     # to read it while we prepend to it later, but I like doing this part first.
300     my @old_change_log = <OLD_CHANGE_LOG>;
301     close OLD_CHANGE_LOG;
302     open CHANGE_LOG, "> ${prefix}ChangeLog" or die "Could not write ${prefix}ChangeLog\n.";
303     print CHANGE_LOG "$date  $name  <$email_address>\n\n";
304
305     my ($reviewer, $description) = reviewerAndDescriptionForGitCommit($gitCommit) if $gitCommit;
306     $reviewer = "NOBODY (OO" . "PS!)" if !$reviewer;
307
308     print CHANGE_LOG "        Reviewed by $reviewer.\n\n";
309     print CHANGE_LOG $description . "\n" if $description;
310
311     if ($prefix =~ m/WebCore/ || `pwd` =~ m/WebCore/) {
312         if ($didChangeRegressionTests) {
313             print CHANGE_LOG testListForChangeLog(sort @addedRegressionTests);
314         } else {
315             print CHANGE_LOG "        WARNING: NO TEST CASES ADDED OR CHANGED\n\n";
316         }
317     }
318
319     foreach my $file (sort @{$files{$prefix}}) {
320         my $file_stem = substr $file, length $prefix;
321         print CHANGE_LOG "        * $file_stem:$function_lists{$file}\n";
322     }
323     print CHANGE_LOG "\n", @old_change_log;
324     close CHANGE_LOG;
325 }
326
327 # Write out another diff.
328 if ($spewDiff && @changed_files) {
329     print STDERR "  Running diff to help you write the ChangeLog entries.\n";
330     local $/ = undef; # local slurp mode
331     open DIFF, "-|", createPatchCommand($changed_files_string) or die "The diff failed: $!.\n";
332     print <DIFF>;
333     close DIFF;
334 }
335
336 # Open ChangeLogs.
337 if ($openChangeLogs && @logs) {
338     print STDERR "  Opening the edited ChangeLog files.\n";
339     my $editor = $ENV{"CHANGE_LOG_EDIT_APPLICATION"};
340     if ($editor) {
341         system "open", "-a", $editor, @logs;
342     } else {
343         system "open", "-e", @logs;
344     }
345 }
346
347 # Done.
348 exit;
349
350 sub canonicalizePath($)
351 {
352     my ($file) = @_;
353
354     # Remove extra slashes and '.' directories in path
355     $file = File::Spec->canonpath($file);
356
357     # Remove '..' directories in path
358     my @dirs = ();
359     foreach my $dir (File::Spec->splitdir($file)) {
360         if ($dir eq '..' && $#dirs >= 0 && $dirs[$#dirs] ne '..') {
361             pop(@dirs);
362         } else {
363             push(@dirs, $dir);
364         }
365     }
366     return ($#dirs >= 0) ? File::Spec->catdir(@dirs) : ".";
367 }
368
369 sub changeLogDate($)
370 {
371     my ($timeZone) = @_;
372     my $savedTimeZone = $ENV{'TZ'};
373     # Set TZ temporarily so that localtime() is in that time zone
374     $ENV{'TZ'} = $timeZone;
375     my $date = strftime("%Y-%m-%d", localtime());
376     if (defined $savedTimeZone) {
377          $ENV{'TZ'} = $savedTimeZone;
378     } else {
379          delete $ENV{'TZ'};
380     }
381     return $date;
382 }
383
384 sub get_function_line_ranges($$)
385 {
386     my ($file_handle, $file_name) = @_;
387
388     if ($file_name =~ /\.(c|cpp|m|mm|h)$/) {
389         return get_function_line_ranges_for_c ($file_handle, $file_name);
390     } elsif ($file_name =~ /\.java$/) {
391         return get_function_line_ranges_for_java ($file_handle, $file_name);
392     }
393     return ();
394 }
395
396
397 sub method_decl_to_selector($)
398 {
399     (my $method_decl) = @_;
400
401     $_ = $method_decl;
402
403     if ((my $comment_stripped) = m-([^/]*)(//|/*).*-) {
404         $_ = $comment_stripped;
405     }
406
407     s/,\s*...//;
408
409     if (/:/) {
410         my @components = split /:/;
411         pop @components if (scalar @components > 1);
412         $_ = (join ':', map {s/.*[^[:word:]]//; scalar $_;} @components) . ':';
413     } else {
414         s/\s*$//;
415         s/.*[^[:word:]]//;
416     }
417
418     return $_;
419 }
420
421
422
423 # Read a file and get all the line ranges of the things that look like C functions.
424 # A function name is the last word before an open parenthesis before the outer
425 # level open brace. A function starts at the first character after the last close
426 # brace or semicolon before the function name and ends at the close brace.
427 # Comment handling is simple-minded but will work for all but pathological cases.
428 #
429 # Result is a list of triples: [ start_line, end_line, function_name ].
430
431 sub get_function_line_ranges_for_c($$)
432 {
433     my ($file_handle, $file_name) = @_;
434
435     my @ranges;
436
437     my $in_comment = 0;
438     my $in_macro = 0;
439     my $in_method_declaration = 0;
440     my $in_parentheses = 0;
441     my $in_braces = 0;
442     my $brace_start = 0;
443     my $brace_end = 0;
444     my $skip_til_brace_or_semicolon = 0;
445
446     my $word = "";
447     my $interface_name = "";
448
449     my $potential_method_char = "";
450     my $potential_method_spec = "";
451
452     my $potential_start = 0;
453     my $potential_name = "";
454
455     my $start = 0;
456     my $name = "";
457
458     my $next_word_could_be_namespace = 0;
459     my $potential_namespace = "";
460     my @namespaces;
461
462     while (<$file_handle>) {
463         # Handle continued multi-line comment.
464         if ($in_comment) {
465             next unless s-.*\*/--;
466             $in_comment = 0;
467         }
468
469         # Handle continued macro.
470         if ($in_macro) {
471             $in_macro = 0 unless /\\$/;
472             next;
473         }
474
475         # Handle start of macro (or any preprocessor directive).
476         if (/^\s*\#/) {
477             $in_macro = 1 if /^([^\\]|\\.)*\\$/;
478             next;
479         }
480
481         # Handle comments and quoted text.
482         while (m-(/\*|//|\'|\")-) { # \' and \" keep emacs perl mode happy
483             my $match = $1;
484             if ($match eq "/*") {
485                 if (!s-/\*.*?\*/--) {
486                     s-/\*.*--;
487                     $in_comment = 1;
488                 }
489             } elsif ($match eq "//") {
490                 s-//.*--;
491             } else { # ' or "
492                 if (!s-$match([^\\]|\\.)*?$match--) {
493                     warn "mismatched quotes at line $. in $file_name\n";
494                     s-$match.*--;
495                 }
496             }
497         }
498
499
500         # continued method declaration
501         if ($in_method_declaration) {
502               my $original = $_;
503               my $method_cont = $_;
504
505               chomp $method_cont;
506               $method_cont =~ s/[;\{].*//;
507               $potential_method_spec = "${potential_method_spec} ${method_cont}";
508
509               $_ = $original;
510               if (/;/) {
511                   $potential_start = 0;
512                   $potential_method_spec = "";
513                   $potential_method_char = "";
514                   $in_method_declaration = 0;
515                   s/^[^;\{]*//;
516               } elsif (/{/) {
517                   my $selector = method_decl_to_selector ($potential_method_spec);
518                   $potential_name = "${potential_method_char}\[${interface_name} ${selector}\]";
519                   
520                   $potential_method_spec = "";
521                   $potential_method_char = "";
522                   $in_method_declaration = 0;
523   
524                   $_ = $original;
525                   s/^[^;{]*//;
526               } elsif (/\@end/) {
527                   $in_method_declaration = 0;
528                   $interface_name = "";
529                   $_ = $original;
530               } else {
531                   next;
532               }
533         }
534
535         
536         # start of method declaration
537         if ((my $method_char, my $method_spec) = m&^([-+])([^0-9;][^;]*);?$&) {
538             my $original = $_;
539
540             if ($interface_name) {
541                 chomp $method_spec;
542                 $method_spec =~ s/\{.*//;
543
544                 $potential_method_char = $method_char;
545                 $potential_method_spec = $method_spec;
546                 $potential_start = $.;
547                 $in_method_declaration = 1;
548             } else { 
549                 warn "declaring a method but don't have interface on line $. in $file_name\n";
550             }
551             $_ = $original;
552             if (/\{/) {
553               my $selector = method_decl_to_selector ($potential_method_spec);
554               $potential_name = "${potential_method_char}\[${interface_name} ${selector}\]";
555               
556               $potential_method_spec = "";
557               $potential_method_char = "";
558               $in_method_declaration = 0;
559               $_ = $original;
560               s/^[^{]*//;
561             } elsif (/\@end/) {
562               $in_method_declaration = 0;
563               $interface_name = "";
564               $_ = $original;
565             } else {
566               next;
567             }
568         }
569
570
571         # Find function, interface and method names.
572         while (m&((?:[[:word:]]+::)*operator(?:[ \t]*\(\)|[^()]*)|[[:word:]:~]+|[(){}:;])|\@(?:implementation|interface|protocol)\s+(\w+)[^{]*&g) {
573             # interface name
574             if ($2) {
575                 $interface_name = $2;
576                 next;
577             }
578
579             # Open parenthesis.
580             if ($1 eq "(") {
581                 $potential_name = $word unless $in_parentheses || $skip_til_brace_or_semicolon;
582                 $in_parentheses++;
583                 next;
584             }
585
586             # Close parenthesis.
587             if ($1 eq ")") {
588                 $in_parentheses--;
589                 next;
590             }
591
592             # C++ constructor initializers
593             if ($1 eq ":") {
594                   $skip_til_brace_or_semicolon = 1 unless ($in_parentheses || $in_braces);
595             }
596
597             # Open brace.
598             if ($1 eq "{") {
599                 $skip_til_brace_or_semicolon = 0;
600
601                 if ($potential_namespace) {
602                     push @namespaces, $potential_namespace;
603                     $potential_namespace = "";
604                     next;
605                 }
606
607                 # Promote potential name to real function name at the
608                 # start of the outer level set of braces (function body?).
609                 if (!$in_braces and $potential_start) {
610                     $start = $potential_start;
611                     $name = $potential_name;
612                     if (@namespaces && (length($name) < 2 || substr($name,1,1) ne "[")) {
613                         $name = join ('::', @namespaces, $name);
614                     }
615                 }
616
617                 $in_method_declaration = 0;
618
619                 $brace_start = $. if (!$in_braces);
620                 $in_braces++;
621                 next;
622             }
623
624             # Close brace.
625             if ($1 eq "}") {
626                 if (!$in_braces && @namespaces) {
627                     pop @namespaces;
628                     next;
629                 }
630
631                 $in_braces--;
632                 $brace_end = $. if (!$in_braces);
633
634                 # End of an outer level set of braces.
635                 # This could be a function body.
636                 if (!$in_braces and $name) {
637                     push @ranges, [ $start, $., $name ];
638                     $name = "";
639                 }
640
641                 $potential_start = 0;
642                 $potential_name = "";
643                 next;
644             }
645
646             # Semicolon.
647             if ($1 eq ";") {
648                 $skip_til_brace_or_semicolon = 0;
649                 $potential_start = 0;
650                 $potential_name = "";
651                 $in_method_declaration = 0;
652                 next;
653             }
654
655             # Ignore "const" method qualifier.
656             if ($1 eq "const") {
657                 next;
658             }
659
660             if ($1 eq "namespace" || $1 eq "class" || $1 eq "struct") {
661                 $next_word_could_be_namespace = 1;
662                 next;
663             }
664
665             # Word.
666             $word = $1;
667             if (!$skip_til_brace_or_semicolon) {
668                 if ($next_word_could_be_namespace) {
669                     $potential_namespace = $word;
670                     $next_word_could_be_namespace = 0;
671                 } elsif ($potential_namespace) {
672                     $potential_namespace = "";
673                 }
674
675                 if (!$in_parentheses) {
676                     $potential_start = 0;
677                     $potential_name = "";
678                 }
679                 if (!$potential_start) {
680                     $potential_start = $.;
681                     $potential_name = "";
682                 }
683             }
684         }
685     }
686
687     warn "missing close braces in $file_name (probable start at $brace_start)\n" if ($in_braces > 0);
688     warn "too many close braces in $file_name (probable start at $brace_end)\n" if ($in_braces < 0);
689
690     warn "mismatched parentheses in $file_name\n" if $in_parentheses;
691
692     return @ranges;
693 }
694
695
696
697 # Read a file and get all the line ranges of the things that look like Java
698 # classes, interfaces and methods.
699 #
700 # A class or interface name is the word that immediately follows
701 # `class' or `interface' when followed by an open curly brace and not
702 # a semicolon. It can appear at the top level, or inside another class
703 # or interface block, but not inside a function block
704 #
705 # A class or interface starts at the first character after the first close
706 # brace or after the function name and ends at the close brace.
707 #
708 # A function name is the last word before an open parenthesis before
709 # an open brace rather than a semicolon. It can appear at top level or
710 # inside a class or interface block, but not inside a function block.
711 #
712 # A function starts at the first character after the first close
713 # brace or after the function name and ends at the close brace.
714 #
715 # Comment handling is simple-minded but will work for all but pathological cases.
716 #
717 # Result is a list of triples: [ start_line, end_line, function_name ].
718
719 sub get_function_line_ranges_for_java($$)
720 {
721     my ($file_handle, $file_name) = @_;
722
723     my @current_scopes;
724
725     my @ranges;
726
727     my $in_comment = 0;
728     my $in_macro = 0;
729     my $in_parentheses = 0;
730     my $in_braces = 0;
731     my $in_non_block_braces = 0;
732     my $class_or_interface_just_seen = 0;
733
734     my $word = "";
735
736     my $potential_start = 0;
737     my $potential_name = "";
738     my $potential_name_is_class_or_interface = 0;
739
740     my $start = 0;
741     my $name = "";
742     my $current_name_is_class_or_interface = 0;
743
744     while (<$file_handle>) {
745         # Handle continued multi-line comment.
746         if ($in_comment) {
747             next unless s-.*\*/--;
748             $in_comment = 0;
749         }
750
751         # Handle continued macro.
752         if ($in_macro) {
753             $in_macro = 0 unless /\\$/;
754             next;
755         }
756
757         # Handle start of macro (or any preprocessor directive).
758         if (/^\s*\#/) {
759             $in_macro = 1 if /^([^\\]|\\.)*\\$/;
760             next;
761         }
762
763         # Handle comments and quoted text.
764         while (m-(/\*|//|\'|\")-) { # \' and \" keep emacs perl mode happy
765             my $match = $1;
766             if ($match eq "/*") {
767                 if (!s-/\*.*?\*/--) {
768                     s-/\*.*--;
769                     $in_comment = 1;
770                 }
771             } elsif ($match eq "//") {
772                 s-//.*--;
773             } else { # ' or "
774                 if (!s-$match([^\\]|\\.)*?$match--) {
775                     warn "mismatched quotes at line $. in $file_name\n";
776                     s-$match.*--;
777                 }
778             }
779         }
780
781         # Find function names.
782         while (m-(\w+|[(){};])-g) {
783             # Open parenthesis.
784             if ($1 eq "(") {
785                 if (!$in_parentheses) {
786                     $potential_name = $word;
787                     $potential_name_is_class_or_interface = 0;
788                 }
789                 $in_parentheses++;
790                 next;
791             }
792
793             # Close parenthesis.
794             if ($1 eq ")") {
795                 $in_parentheses--;
796                 next;
797             }
798
799             # Open brace.
800             if ($1 eq "{") {
801                 # Promote potential name to real function name at the
802                 # start of the outer level set of braces (function/class/interface body?).
803                 if (!$in_non_block_braces
804                     and (!$in_braces or $current_name_is_class_or_interface)
805                     and $potential_start) {
806                     if ($name) {
807                           push @ranges, [ $start, ($. - 1),
808                                           join ('.', @current_scopes) ];
809                     }
810
811
812                     $current_name_is_class_or_interface = $potential_name_is_class_or_interface;
813
814                     $start = $potential_start;
815                     $name = $potential_name;
816
817                     push (@current_scopes, $name);
818                 } else {
819                     $in_non_block_braces++;
820                 }
821
822                 $potential_name = "";
823                 $potential_start = 0;
824
825                 $in_braces++;
826                 next;
827             }
828
829             # Close brace.
830             if ($1 eq "}") {
831                 $in_braces--;
832
833                 # End of an outer level set of braces.
834                 # This could be a function body.
835                 if (!$in_non_block_braces) {
836                     if ($name) {
837                         push @ranges, [ $start, $.,
838                                         join ('.', @current_scopes) ];
839
840                         pop (@current_scopes);
841
842                         if (@current_scopes) {
843                             $current_name_is_class_or_interface = 1;
844
845                             $start = $. + 1;
846                             $name =  $current_scopes[$#current_scopes-1];
847                         } else {
848                             $current_name_is_class_or_interface = 0;
849                             $start = 0;
850                             $name =  "";
851                         }
852                     }
853                 } else {
854                     $in_non_block_braces-- if $in_non_block_braces;
855                 }
856
857                 $potential_start = 0;
858                 $potential_name = "";
859                 next;
860             }
861
862             # Semicolon.
863             if ($1 eq ";") {
864                 $potential_start = 0;
865                 $potential_name = "";
866                 next;
867             }
868
869             if ($1 eq "class" or $1 eq "interface") {
870                 $class_or_interface_just_seen = 1;
871                 next;
872             }
873
874             # Word.
875             $word = $1;
876             if (!$in_parentheses) {
877                 if ($class_or_interface_just_seen) {
878                     $potential_name = $word;
879                     $potential_start = $.;
880                     $class_or_interface_just_seen = 0;
881                     $potential_name_is_class_or_interface = 1;
882                     next;
883                 }
884             }
885             if (!$potential_start) {
886                 $potential_start = $.;
887                 $potential_name = "";
888             }
889             $class_or_interface_just_seen = 0;
890         }
891     }
892
893     warn "mismatched braces in $file_name\n" if $in_braces;
894     warn "mismatched parentheses in $file_name\n" if $in_parentheses;
895
896     return @ranges;
897 }
898
899 sub processPaths(\@)
900 {
901     my ($paths) = @_;
902     return ("." => 1) if (!@{$paths});
903
904     my %result = ();
905
906     for my $file (@{$paths}) {
907         die "can't handle absolute paths like \"$file\"\n" if File::Spec->file_name_is_absolute($file);
908         die "can't handle empty string path\n" if $file eq "";
909         die "can't handle path with single quote in the name like \"$file\"\n" if $file =~ /'/; # ' (keep Xcode syntax highlighting happy)
910
911         my $untouchedFile = $file;
912
913         $file = canonicalizePath($file);
914
915         die "can't handle paths with .. like \"$untouchedFile\"\n" if $file =~ m|/\.\./|;
916
917         $result{$file} = 1;
918     }
919
920     return ("." => 1) if ($result{"."});
921
922     # Remove any paths that also have a parent listed.
923     for my $path (keys %result) {
924         for (my $parent = dirname($path); $parent ne '.'; $parent = dirname($parent)) {
925             if ($result{$parent}) {
926                 delete $result{$path};
927                 last;
928             }
929         }
930     }
931
932     return %result;
933 }
934
935 sub diffFromToString()
936 {
937     return "" if $isSVN;
938     return $gitCommit if $gitCommit =~ m/.+\.\..+/;
939     return "\"$gitCommit^\" \"$gitCommit\"" if $gitCommit;
940     return "HEAD" if $isGit;
941 }
942
943 sub diffCommand(@)
944 {
945     my @paths = @_;
946
947     my $pathsString = "'" . join("' '", @paths) . "'"; 
948
949     my $command;
950     if ($isSVN) {
951         $command = "$SVN diff --diff-cmd diff -x -N $pathsString";
952     } elsif ($isGit) {
953         $command = "$GIT diff " . diffFromToString();
954         $command .= " -- $pathsString" unless $gitCommit;
955     }
956
957     return $command;
958 }
959
960 sub statusCommand(@)
961 {
962     my @files = @_;
963
964     my $filesString = "'" . join ("' '", @files) . "'";
965     my $command;
966     if ($isSVN) {
967         $command = "$SVN stat $filesString";
968     } elsif ($isGit) {
969         $command = "$GIT diff -r --name-status -C -C -M " . diffFromToString();
970         $command .= " -- $filesString" unless $gitCommit;
971     }
972
973     return "$command 2>&1";
974 }
975
976 sub createPatchCommand($)
977 {
978     my ($changedFilesString) = @_;
979
980     my $command;
981     if ($isSVN) {
982         $command = "'$FindBin::Bin/svn-create-patch' $changedFilesString";
983     } elsif ($isGit) {
984         $command = "$GIT diff -C -C -M " . diffFromToString();
985         $command .= " -- $changedFilesString" unless $gitCommit;
986     }
987
988     return $command;
989 }
990
991 sub diffHeaderFormat()
992 {
993     return qr/^Index: (\S+)$/ if $isSVN;
994     return qr/^diff --git a\/.+ b\/(.+)$/ if $isGit;
995 }
996
997 sub findOriginalFileFromSvn($)
998 {
999     my ($file) = @_;
1000     my $baseUrl;
1001     open INFO, "$SVN info . |" or die;
1002     while (<INFO>) {
1003         if (/^URL: (.+)/) {
1004             $baseUrl = $1;
1005             last;
1006         }
1007     }
1008     close INFO;
1009     my $sourceFile;
1010     open INFO, "$SVN info '$file' |" or die;
1011     while (<INFO>) {
1012         if (/^Copied From URL: (.+)/) {
1013             $sourceFile = File::Spec->abs2rel($1, $baseUrl);
1014             last;
1015         }
1016     }
1017     close INFO;
1018     return $sourceFile;
1019 }
1020
1021 sub generateFileList(\@\@\%)
1022 {
1023     my ($changedFiles, $conflictFiles, $functionLists) = @_;
1024     print STDERR "  Running status to find changed, added, or removed files.\n";
1025     open STAT, "-|", statusCommand(keys %paths) or die "The status failed: $!.\n";
1026     my $inGitCommitSection = 0;
1027     while (<STAT>) {
1028         my $status;
1029         my $original;
1030         my $file;
1031
1032         if ($isSVN) {
1033             if (/^([ACDMR]).{5} (.+)$/) {
1034                 $status = $1;
1035                 $file = $2;
1036                 $original = findOriginalFileFromSvn($file) if substr($_, 3, 1) eq "+";
1037             } else {
1038                 print;  # error output from svn stat
1039             }
1040         } elsif ($isGit) {
1041             if (/^([ADM])\t(.+)$/) {
1042                 $status = $1;
1043                 $file = $2;
1044             } elsif (/^([CR])[0-9]{1,3}\t([^\t]+)\t([^\t\n]+)$/) { # for example: R90%    newfile    oldfile
1045                 $status = $1;
1046                 $original = $2;
1047                 $file = $3;
1048             } else {
1049                 print;  # error output from git diff
1050             }
1051         }
1052
1053         next unless $status;
1054
1055         $file = makeFilePathRelative($file);
1056
1057         if (isModifiedStatus($status) || isAddedStatus($status)) {
1058             my @components = File::Spec->splitdir($file);
1059             if ($components[0] eq "LayoutTests") {
1060                 $didChangeRegressionTests = 1;
1061                 push @addedRegressionTests, $file
1062                     if isAddedStatus($status)
1063                        && $file =~ /\.([a-zA-Z]+)$/
1064                        && $supportedTestExtensions{lc($1)}
1065                        && !scalar(grep(/^resources$/i, @components));
1066             }
1067             push @{$changedFiles}, $file if $components[$#components] ne "ChangeLog";
1068         } elsif (isConflictStatus($status)) {
1069             push @{$conflictFiles}, $file;
1070         }
1071         my $description = statusDescription($status, $original);
1072         $functionLists->{$file} = $description if defined $description;
1073     }
1074     close STAT;
1075 }
1076
1077 sub gitConfig($)
1078 {
1079     return unless $isGit;
1080
1081     my ($config) = @_;
1082
1083     my $result = `$GIT config $config`;
1084     if (($? >> 8) != 0) {
1085         $result = `$GIT repo-config $config`;
1086     }
1087     chomp $result;
1088     return $result;
1089 }
1090
1091 sub isModifiedStatus($)
1092 {
1093     my ($status) = @_;
1094
1095     my %statusCodes = (
1096         "M" => 1,
1097     );
1098
1099     return $statusCodes{$status};
1100 }
1101
1102 sub isAddedStatus($)
1103 {
1104     my ($status) = @_;
1105
1106     my %statusCodes = (
1107         "A" => 1,
1108         "C" => $isGit,
1109         "R" => 1,
1110     );
1111
1112     return $statusCodes{$status};
1113 }
1114
1115 sub isConflictStatus($)
1116 {
1117     my ($status) = @_;
1118
1119     my %svn = (
1120         "C" => 1,
1121     );
1122
1123     my %git = (
1124         "U" => 1,
1125     );
1126
1127     return 0 if $gitCommit; # an existing commit cannot have conflicts
1128     return $svn{$status} if $isSVN;
1129     return $git{$status} if $isGit;
1130 }
1131
1132 sub statusDescription($$)
1133 {
1134     my ($status, $original) = @_;
1135
1136     my %svn = (
1137         "A" => defined $original ? " Copied from \%s." : " Added.",
1138         "D" => " Removed.",
1139         "M" => "",
1140         "R" => defined $original ? " Replaced with \%s." : " Replaced.",
1141     );
1142
1143     my %git = %svn;
1144     $git{"A"} = " Added.";
1145     $git{"C"} = " Copied from \%s.";
1146     $git{"R"} = " Renamed from \%s.";
1147
1148     return sprintf($svn{$status}, $original) if $isSVN && exists $svn{$status};
1149     return sprintf($git{$status}, $original) if $isGit && exists $git{$status};
1150     return undef;
1151 }
1152
1153 sub extractLineRange($)
1154 {
1155     my ($string) = @_;
1156
1157     my ($start, $end) = (-1, -1);
1158
1159     if ($isSVN && $string =~ /^\d+(,\d+)?[acd](\d+)(,(\d+))?/) {
1160         $start = $2;
1161         $end = $4 || $2;
1162     } elsif ($isGit && $string =~ /^@@ -\d+,\d+ \+(\d+),(\d+) @@/) {
1163         $start = $1;
1164         $end = $1 + $2 - 1;
1165
1166         # git-diff shows 3 lines of context above and below the actual changes,
1167         # so we need to subtract that context to find the actual changed range.
1168
1169         # FIXME: This won't work if there's a change at the very beginning or
1170         # very end of a file.
1171
1172         $start += 3;
1173         $end -= 6;
1174     }
1175
1176     return ($start, $end);
1177 }
1178
1179 sub firstDirectoryOrCwd()
1180 {
1181     my $dir = ".";
1182     my @dirs = keys(%paths);
1183
1184     $dir = -d $dirs[0] ? $dirs[0] : dirname($dirs[0]) if @dirs;
1185
1186     return $dir;
1187 }
1188
1189 sub testListForChangeLog(@)
1190 {
1191     my (@tests) = @_;
1192
1193     return "" unless @tests;
1194
1195     my $leadString = "        Test" . (@tests == 1 ? "" : "s") . ": ";
1196     my $list = $leadString;
1197     foreach my $i (0..$#tests) {
1198         $list .= " " x length($leadString) if $i;
1199         my $test = $tests[$i];
1200         $test =~ s/^LayoutTests\///;
1201         $list .= "$test\n";
1202     }
1203     $list .= "\n";
1204
1205     return $list;
1206 }
1207
1208 sub reviewerAndDescriptionForGitCommit($)
1209 {
1210     my ($commit) = @_;
1211
1212     my $description = '';
1213     my $reviewer;
1214
1215     my @args = qw(rev-list --pretty);
1216     push @args, '-1' if $commit !~ m/.+\.\..+/;
1217     my $gitLog;
1218     {
1219         local $/ = undef;
1220         open(GIT, "-|", $GIT, @args, $commit) || die;
1221         $gitLog = <GIT>;
1222         close(GIT);
1223     }
1224
1225     my @commitLogs = split(/^[Cc]ommit [a-f0-9]{40}/m, $gitLog);
1226     shift @commitLogs; # Remove initial blank commit log
1227     my $commitLogCount = 0;
1228     foreach my $commitLog (@commitLogs) {
1229         $description .= "\n" if $commitLogCount;
1230         $commitLogCount++;
1231         my $inHeader = 1;
1232         my @lines = split(/\n/, $commitLog);
1233         shift @lines; # Remove initial blank line
1234         foreach my $line (@lines) {
1235             if ($inHeader) {
1236                 if (!$line) {
1237                     $inHeader = 0;
1238                 }
1239                 next;
1240             } elsif ($line =~ /[Ss]igned-[Oo]ff-[Bb]y: (.+)/) {
1241                 if (!$reviewer) {
1242                     $reviewer = $1;
1243                 } else {
1244                     $reviewer .= ", " . $1;
1245                 }
1246             } elsif (length $line == 0) {
1247                 $description = $description . "\n";
1248             } else {
1249                 $line =~ s/^\s*//;
1250                 $description = $description . "        " . $line . "\n";
1251             }
1252         }
1253     }
1254     if (!$reviewer) {
1255       $reviewer = $gitReviewer;
1256     }
1257
1258     return ($reviewer, $description);
1259 }