2 # -*- Mode: perl; indent-tabs-mode: nil; c-basic-offset: 2 -*-
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>
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.
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.
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.
26 # Perl script to create a ChangeLog entry with names of files
27 # and functions from a diff.
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>
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
63 use lib $FindBin::Bin;
64 use POSIX qw(strftime);
68 sub changeLogEmailAddressFromArgs($$);
69 sub changeLogNameFromArgs($$);
70 sub createPatchCommand($$$$);
71 sub decodeEntities($);
72 sub determinePropertyChanges($$$);
73 sub diffCommand($$$$);
74 sub diffFromToString($$$);
75 sub diffHeaderFormat();
76 sub extractLineRange($);
77 sub fetchBugDescriptionFromURL($$);
78 sub findChangeLogs($);
79 sub findOriginalFileFromSvn($);
80 sub generateFileList(\%$$$);
81 sub generateFunctionLists($$$$$);
82 sub generateNewChangeLogs($$$$$$$$$$$);
83 sub getLatestChangeLogs($);
84 sub get_function_line_ranges($$);
85 sub get_function_line_ranges_for_cpp($$);
86 sub get_function_line_ranges_for_java($$);
87 sub get_function_line_ranges_for_javascript($$);
88 sub get_function_line_ranges_for_perl($$);
89 sub get_selector_line_ranges_for_css($$);
91 sub isConflictStatus($$$);
92 sub isModifiedStatus($);
93 sub isUnmodifiedStatus($);
95 sub method_decl_to_selector($);
96 sub normalizeLineEndings($$);
97 sub openChangeLogs($);
98 sub pluralizeAndList($$@);
100 sub processPaths(\@);
101 sub propertyChangeDescription($);
102 sub resolveConflictedChangeLogs($);
103 sub reviewerAndDescriptionForGitCommit($$);
104 sub statusCommand($$$$);
105 sub statusDescription($$$$);
106 sub testListForChangeLog(@);
108 ### Constant variables.
109 # Project time zone for Cupertino, CA, US
110 use constant ChangeLogTimeZone => "PST8PDT";
111 use constant SVN => "svn";
112 use constant GIT => "git";
113 use constant SupportedTestExtensions => {map { $_ => 1 } qw(html shtml svg xml xhtml pl php)};
126 my $gitReviewer = "";
127 my $openChangeLogs = 0;
128 my $writeChangeLogs = 1;
130 my $spewDiff = $ENV{"PREPARE_CHANGELOG_DIFF"};
131 my $updateChangeLogs = 1;
132 my $parseOptionsResult =
133 GetOptions("diff|d!" => \$spewDiff,
134 "bug|b:i" => \$bugNumber,
135 "description:s" => \$bugDescription,
137 "email:s" => \$emailAddress,
138 "merge-base:s" => \$mergeBase,
139 "git-commit|g:s" => \$gitCommit,
140 "git-index" => \$gitIndex,
141 "git-reviewer:s" => \$gitReviewer,
142 "help|h!" => \$showHelp,
143 "open|o!" => \$openChangeLogs,
144 "write!" => \$writeChangeLogs,
145 "update!" => \$updateChangeLogs);
146 if (!$parseOptionsResult || $showHelp) {
147 print STDERR basename($0) . " [-b|--bug=<bugid>] [-d|--diff] [-h|--help] [-o|--open] [-g|--git-commit=<committish>] [--git-reviewer=<name>] [svndir1 [svndir2 ...]]\n";
148 print STDERR " -b|--bug Fill in the ChangeLog bug information from the given bug.\n";
149 print STDERR " --description One-line description that matches the bug title.\n";
150 print STDERR " -d|--diff Spew diff to stdout when running\n";
151 print STDERR " --merge-base Populate the ChangeLogs with the diff to this branch\n";
152 print STDERR " -g|--git-commit Populate the ChangeLogs from the specified git commit\n";
153 print STDERR " --git-index Populate the ChangeLogs from the git index only\n";
154 print STDERR " --git-reviewer When populating the ChangeLogs from a git commit claim that the spcified name reviewed the change.\n";
155 print STDERR " This option is useful when the git commit lacks a Signed-Off-By: line\n";
156 print STDERR " -h|--help Show this help message\n";
157 print STDERR " -o|--open Open ChangeLogs in an editor when done\n";
158 print STDERR " --[no-]update Update ChangeLogs from svn before adding entry (default: update)\n";
159 print STDERR " --[no-]write Write ChangeLogs to disk (otherwise send new entries to stdout) (default: write)\n";
160 print STDERR " --email= Specify the email address to be used in the patch\n";
164 die "--git-commit and --git-index are incompatible." if ($gitIndex && $gitCommit);
166 isSVN() || isGit() || die "Couldn't determine your version control system.";
168 my %paths = processPaths(@ARGV);
170 # Find the list of modified files
171 my ($changedFiles, $conflictFiles, $functionLists, $addedRegressionTests) = generateFileList(%paths, $gitCommit, $gitIndex, $mergeBase);
173 if (!@$changedFiles && !@$conflictFiles && !keys %$functionLists) {
174 print STDERR " No changes found.\n";
178 if (@$conflictFiles) {
179 print STDERR " The following files have conflicts. Run prepare-ChangeLog again after fixing the conflicts:\n";
180 print STDERR join("\n", @$conflictFiles), "\n";
184 generateFunctionLists($changedFiles, $functionLists, $gitCommit, $gitIndex, $mergeBase);
186 # Get some parameters for the ChangeLog we are about to write.
187 $name = changeLogNameFromArgs($name, $gitCommit);
188 $emailAddress = changeLogEmailAddressFromArgs($emailAddress, $gitCommit);
190 print STDERR " Change author: $name <$emailAddress>.\n";
192 # Remove trailing parenthesized notes from user name (bit of hack).
193 $name =~ s/\(.*?\)\s*$//g;
197 $bugURL = "https://bugs.webkit.org/show_bug.cgi?id=$bugNumber";
200 if ($bugNumber && !$bugDescription) {
201 $bugDescription = fetchBugDescriptionFromURL($bugURL, $bugNumber);
204 my ($filesInChangeLog, $prefixes) = findChangeLogs($functionLists);
206 # Get the latest ChangeLog files from svn.
207 my $changeLogs = getLatestChangeLogs($prefixes);
209 if (@$changeLogs && $updateChangeLogs && isSVN()) {
210 resolveConflictedChangeLogs($changeLogs);
213 generateNewChangeLogs($prefixes, $filesInChangeLog, $addedRegressionTests, $functionLists, $bugURL, $bugDescription, $name, $emailAddress, $gitReviewer, $gitCommit, $writeChangeLogs);
215 if ($writeChangeLogs) {
216 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";
219 # Write out another diff.
220 if ($spewDiff && @$changedFiles) {
221 printDiff($changedFiles, $gitCommit, $gitIndex, $mergeBase);
225 if ($openChangeLogs && @$changeLogs) {
226 openChangeLogs($changeLogs);
231 sub generateFunctionLists($$$$$)
233 my ($changedFiles, $functionLists, $gitCommit, $gitIndex, $mergeBase) = @_;
235 my %changed_line_ranges;
236 if (@$changedFiles) {
237 # For each file, build a list of modified lines.
238 # Use line numbers from the "after" side of each diff.
239 print STDERR " Reviewing diff to determine which lines changed.\n";
241 open DIFF, "-|", diffCommand($changedFiles, $gitCommit, $gitIndex, $mergeBase) or die "The diff failed: $!.\n";
243 $file = makeFilePathRelative($1) if $_ =~ diffHeaderFormat();
245 my ($start, $end) = extractLineRange($_);
246 if ($start >= 0 && $end >= 0) {
247 push @{$changed_line_ranges{$file}}, [ $start, $end ];
248 } elsif (/DO_NOT_COMMIT/) {
249 print STDERR "WARNING: file $file contains the string DO_NOT_COMMIT, line $.\n";
256 # For each source file, convert line range to function list.
257 if (%changed_line_ranges) {
258 print STDERR " Extracting affected function names from source files.\n";
259 foreach my $file (keys %changed_line_ranges) {
260 # Find all the functions in the file.
261 open SOURCE, $file or next;
262 my @function_ranges = get_function_line_ranges(\*SOURCE, $file);
265 # Find all the modified functions.
268 my @change_ranges = (@{$changed_line_ranges{$file}}, []);
269 my @change_range = (0, 0);
270 FUNCTION: foreach my $function_range_ref (@function_ranges) {
271 my @function_range = @$function_range_ref;
273 # FIXME: This is a hack. If the function name is empty, skip it.
274 # The cpp, python, javascript, perl, css and java parsers
275 # are not perfectly implemented and sometimes function names cannot be retrieved
276 # correctly. As you can see in get_function_line_ranges_XXXX(), those parsers
277 # are not intended to implement real parsers but intended to just retrieve function names
278 # for most practical syntaxes.
279 next unless $function_range[2];
281 # Advance to successive change ranges.
282 for (;; @change_range = @{shift @change_ranges}) {
283 last FUNCTION unless @change_range;
285 # If past this function, move on to the next one.
286 next FUNCTION if $change_range[0] > $function_range[1];
288 # If an overlap with this function range, record the function name.
289 if ($change_range[1] >= $function_range[0]
290 and $change_range[0] <= $function_range[1]) {
291 if (!$saw_function{$function_range[2]}) {
292 $saw_function{$function_range[2]} = 1;
293 push @functions, $function_range[2];
300 # Format the list of functions now.
302 $functionLists->{$file} = "" if !defined $functionLists->{$file};
303 $functionLists->{$file} .= "\n (" . join("):\n (", @functions) . "):";
312 my $savedTimeZone = $ENV{'TZ'};
313 # Set TZ temporarily so that localtime() is in that time zone
314 $ENV{'TZ'} = $timeZone;
315 my $date = strftime("%Y-%m-%d", localtime());
316 if (defined $savedTimeZone) {
317 $ENV{'TZ'} = $savedTimeZone;
324 sub changeLogNameFromArgs($$)
326 my ($nameFromArgs, $gitCommit) = @_;
327 # Silently allow --git-commit to win, we could warn if $nameFromArgs is defined.
328 my $command = GIT . ' log --max-count=1 --pretty="format:%an" "' . $gitCommit . '"';
329 return `$command` if $gitCommit;
331 return $nameFromArgs || changeLogName();
334 sub changeLogEmailAddressFromArgs($$)
336 my ($emailAddressFromArgs, $gitCommit) = @_;
337 # Silently allow --git-commit to win, we could warn if $emailAddressFromArgs is defined.
338 my $command = GIT . ' log --max-count=1 --pretty="format:%ae" "' . $gitCommit . '"';
339 return `$command` if $gitCommit;
341 return $emailAddressFromArgs || changeLogEmailAddress();
344 sub fetchBugDescriptionFromURL($$)
346 my ($bugURL, $bugNumber) = @_;
348 my $bugXMLURL = "$bugURL&ctype=xml&excludefield=attachmentdata";
349 # Perl has no built in XML processing, so we'll fetch and parse with curl and grep
350 # Pass --insecure because some cygwin installs have no certs we don't
351 # care about validating that bugs.webkit.org is who it says it is here.
352 my $descriptionLine = `curl --insecure --silent "$bugXMLURL" | grep short_desc`;
353 if ($descriptionLine !~ /<short_desc>(.*)<\/short_desc>/) {
354 # Maybe the reason the above did not work is because the curl that is installed doesn't
355 # support ssl at all.
356 if (`curl --version | grep ^Protocols` !~ /\bhttps\b/) {
357 print STDERR " Could not get description for bug $bugNumber.\n";
358 print STDERR " It looks like your version of curl does not support ssl.\n";
359 print STDERR " If you are using macports, this can be fixed with sudo port install curl +ssl.\n";
361 print STDERR " Bug $bugNumber has no bug description. Maybe you set wrong bug ID?\n";
362 print STDERR " The bug URL: $bugXMLURL\n";
366 my $bugDescription = decodeEntities($1);
367 print STDERR " Description from bug $bugNumber:\n \"$bugDescription\".\n";
368 return $bugDescription;
371 sub findChangeLogs($)
373 my ($functionLists) = @_;
375 # Find the change logs.
377 my %filesInChangeLog;
378 foreach my $file (sort keys %$functionLists) {
382 $prefix =~ s-/[^/]+/?$-/- or $prefix = "";
383 $has_log = $has_log{$prefix};
384 if (!defined $has_log) {
385 $has_log = -f "${prefix}ChangeLog";
386 $has_log{$prefix} = $has_log;
391 print STDERR "No ChangeLog found for $file.\n";
393 push @{$filesInChangeLog{$prefix}}, $file;
397 # Build the list of ChangeLog prefixes in the correct project order
400 foreach my $prefix (keys %filesInChangeLog) {
401 my $prefixDir = substr($prefix, 0, length($prefix) - 1); # strip trailing /
402 my $sortKey = lc $prefix;
403 $sortKey = "top level" unless length $sortKey;
405 if ($prefixDir eq "top level") {
407 } elsif ($prefixDir eq "Tools") {
408 $sortKey = "-, just after top level";
409 } elsif ($prefixDir eq "WebBrowser") {
410 $sortKey = lc "WebKit, WebBrowser after";
411 } elsif ($prefixDir eq "Source/WebCore") {
412 $sortKey = lc "WebFoundation, WebCore after";
413 } elsif ($prefixDir eq "LayoutTests") {
414 $sortKey = lc "~, LayoutTests last";
417 $prefixesSort{$sortKey} = $prefix;
419 foreach my $prefixSort (sort keys %prefixesSort) {
420 push @prefixes, $prefixesSort{$prefixSort};
422 return (\%filesInChangeLog, \@prefixes);
425 sub getLatestChangeLogs($)
430 foreach my $prefix (@$prefixes) {
431 push @changeLogs, File::Spec->catfile($prefix || ".", changeLogFileName());
436 sub resolveConflictedChangeLogs($)
438 my ($changeLogs) = @_;
440 print STDERR " Running 'svn update' to update ChangeLog files.\n";
441 open ERRORS, "-|", SVN, "update", @$changeLogs
442 or die "The svn update of ChangeLog files failed: $!.\n";
443 my @conflictedChangeLogs;
444 while (my $line = <ERRORS>) {
445 print STDERR " ", $line;
446 push @conflictedChangeLogs, $1 if $line =~ m/^C\s+(.+?)[\r\n]*$/;
450 return if !@conflictedChangeLogs;
452 print STDERR " Attempting to merge conflicted ChangeLogs.\n";
453 my $resolveChangeLogsPath = File::Spec->catfile(dirname($0), "resolve-ChangeLogs");
454 open RESOLVE, "-|", $resolveChangeLogsPath, "--no-warnings", @conflictedChangeLogs
455 or die "Could not open resolve-ChangeLogs script: $!.\n";
456 print STDERR " $_" while <RESOLVE>;
460 sub generateNewChangeLogs($$$$$$$$$$$)
462 my ($prefixes, $filesInChangeLog, $addedRegressionTests, $functionLists, $bugURL, $bugDescription, $name, $emailAddress, $gitReviewer, $gitCommit, $writeChangeLogs) = @_;
464 # Generate new ChangeLog entries and (optionally) write out new ChangeLog files.
465 foreach my $prefix (@$prefixes) {
469 if ($writeChangeLogs) {
470 my $changeLogPath = File::Spec->catfile($prefix || ".", changeLogFileName());
471 print STDERR " Editing the ${changeLogPath} file.\n";
472 open OLD_CHANGE_LOG, ${changeLogPath} or die "Could not open ${changeLogPath} file: $!.\n";
473 # It's less efficient to read the whole thing into memory than it would be
474 # to read it while we prepend to it later, but I like doing this part first.
475 @old_change_log = <OLD_CHANGE_LOG>;
476 close OLD_CHANGE_LOG;
477 # We want to match the ChangeLog's line endings in case it doesn't match
478 # the native line endings for this version of perl.
479 if ($old_change_log[0] =~ /(\r?\n)$/g) {
482 open CHANGE_LOG, "> ${changeLogPath}" or die "Could not write ${changeLogPath}\n.";
484 open CHANGE_LOG, ">-" or die "Could not write to STDOUT\n.";
485 print substr($prefix, 0, length($prefix) - 1) . ":\n\n" unless (scalar @$prefixes) == 1;
488 my $date = changeLogDate(ChangeLogTimeZone);
489 print CHANGE_LOG normalizeLineEndings("$date $name <$emailAddress>\n\n", $endl);
491 my ($reviewer, $description) = reviewerAndDescriptionForGitCommit($gitCommit, $gitReviewer) if $gitCommit;
492 $reviewer = "NOBODY (OO" . "PS!)" if !$reviewer;
494 print CHANGE_LOG normalizeLineEndings($description . "\n", $endl) if $description;
496 $bugDescription = "Need a short description (OOPS!).\n Need the bug URL (OOPS!)." unless $bugDescription;
497 print CHANGE_LOG normalizeLineEndings(" $bugDescription\n", $endl) if $bugDescription;
498 print CHANGE_LOG normalizeLineEndings(" $bugURL\n", $endl) if $bugURL;
499 print CHANGE_LOG normalizeLineEndings("\n", $endl);
501 print CHANGE_LOG normalizeLineEndings(" Reviewed by $reviewer.\n\n", $endl);
502 print CHANGE_LOG normalizeLineEndings(" Additional information of the change such as approach, rationale. Please add per-function descriptions below (OOPS!).\n\n", $endl);
504 if ($prefix =~ m/WebCore/ || `pwd` =~ m/WebCore/) {
505 if (@$addedRegressionTests) {
506 print CHANGE_LOG normalizeLineEndings(testListForChangeLog(sort @$addedRegressionTests), $endl);
508 print CHANGE_LOG normalizeLineEndings(" No new tests (OOPS!).\n\n", $endl);
512 foreach my $file (sort @{$filesInChangeLog->{$prefix}}) {
513 my $file_stem = substr $file, length $prefix;
514 print CHANGE_LOG normalizeLineEndings(" * $file_stem:$functionLists->{$file}\n", $endl);
517 if ($writeChangeLogs) {
518 print CHANGE_LOG normalizeLineEndings("\n", $endl), @old_change_log;
520 print CHANGE_LOG "\n";
529 my ($changedFiles, $gitCommit, $gitIndex, $mergeBase) = @_;
531 print STDERR " Running diff to help you write the ChangeLog entries.\n";
532 local $/ = undef; # local slurp mode
533 my $changedFilesString = "'" . join("' '", @$changedFiles) . "'";
534 open DIFF, "-|", createPatchCommand($changedFilesString, $gitCommit, $gitIndex, $mergeBase) or die "The diff failed: $!.\n";
539 sub openChangeLogs($)
541 my ($changeLogs) = @_;
543 print STDERR " Opening the edited ChangeLog files.\n";
544 my $editor = $ENV{CHANGE_LOG_EDITOR} || $ENV{VISUAL} || $ENV{EDITOR};
546 system ((split ' ', $editor), @$changeLogs);
548 $editor = $ENV{CHANGE_LOG_EDIT_APPLICATION};
550 system "open", "-a", $editor, @$changeLogs;
552 system "open", "-e", @$changeLogs;
557 sub get_function_line_ranges($$)
559 my ($file_handle, $file_name) = @_;
561 # Try to determine the source language based on the file extension.
563 return get_function_line_ranges_for_cpp($file_handle, $file_name) if $file_name =~ /\.(c|cpp|m|mm|h)$/;
564 return get_function_line_ranges_for_java($file_handle, $file_name) if $file_name =~ /\.java$/;
565 return get_function_line_ranges_for_javascript($file_handle, $file_name) if $file_name =~ /\.js$/;
566 return get_selector_line_ranges_for_css($file_handle, $file_name) if $file_name =~ /\.css$/;
567 return get_function_line_ranges_for_perl($file_handle, $file_name) if $file_name =~ /\.p[lm]$/;
568 return get_function_line_ranges_for_python($file_handle, $file_name) if $file_name =~ /\.py$/ or $file_name =~ /master\.cfg$/;
570 # Try to determine the source language based on the script interpreter.
572 my $first_line = <$file_handle>;
573 seek($file_handle, 0, 0);
575 return () unless $first_line =~ m|^#!(?:/usr/bin/env\s+)?(\S+)|;
576 my $interpreter = $1;
578 return get_function_line_ranges_for_perl($file_handle, $file_name) if $interpreter =~ /perl$/;
579 return get_function_line_ranges_for_python($file_handle, $file_name) if $interpreter =~ /python$/;
585 sub method_decl_to_selector($)
587 (my $method_decl) = @_;
591 if ((my $comment_stripped) = m-([^/]*)(//|/*).*-) {
592 $_ = $comment_stripped;
598 my @components = split /:/;
599 pop @components if (scalar @components > 1);
600 $_ = (join ':', map {s/.*[^[:word:]]//; scalar $_;} @components) . ':';
611 # Read a file and get all the line ranges of the things that look like C functions.
612 # A function name is the last word before an open parenthesis before the outer
613 # level open brace. A function starts at the first character after the last close
614 # brace or semicolon before the function name and ends at the close brace.
615 # Comment handling is simple-minded but will work for all but pathological cases.
617 # Result is a list of triples: [ start_line, end_line, function_name ].
619 sub get_function_line_ranges_for_cpp($$)
621 my ($file_handle, $file_name) = @_;
627 my $in_method_declaration = 0;
628 my $in_parentheses = 0;
630 my $in_toplevel_array_brace = 0;
633 my $namespace_start = -1;
634 my $skip_til_brace_or_semicolon = 0;
635 my $equal_observed = 0;
638 my $interface_name = "";
640 my $potential_method_char = "";
641 my $potential_method_spec = "";
643 my $potential_start = 0;
644 my $potential_name = "";
649 my $next_word_could_be_namespace = 0;
650 my $potential_namespace = "";
653 while (<$file_handle>) {
654 # Handle continued multi-line comment.
656 next unless s-.*\*/--;
660 # Handle continued macro.
662 $in_macro = 0 unless /\\$/;
666 # Handle start of macro (or any preprocessor directive).
668 $in_macro = 1 if /^([^\\]|\\.)*\\$/;
672 # Handle comments and quoted text.
673 while (m-(/\*|//|\'|\")-) { # \' and \" keep emacs perl mode happy
675 if ($match eq "/*") {
676 if (!s-/\*.*?\*/--) {
680 } elsif ($match eq "//") {
683 if (!s-$match([^\\]|\\.)*?$match--) {
684 warn "mismatched quotes at line $. in $file_name\n";
691 # continued method declaration
692 if ($in_method_declaration) {
694 my $method_cont = $_;
697 $method_cont =~ s/[;\{].*//;
698 $potential_method_spec = "${potential_method_spec} ${method_cont}";
702 $potential_start = 0;
703 $potential_method_spec = "";
704 $potential_method_char = "";
705 $in_method_declaration = 0;
708 my $selector = method_decl_to_selector ($potential_method_spec);
709 $potential_name = "${potential_method_char}\[${interface_name} ${selector}\]";
711 $potential_method_spec = "";
712 $potential_method_char = "";
713 $in_method_declaration = 0;
718 $in_method_declaration = 0;
719 $interface_name = "";
727 # start of method declaration
728 if ((my $method_char, my $method_spec) = m&^([-+])([^0-9;][^;]*);?$&) {
731 if ($interface_name) {
733 $method_spec =~ s/\{.*//;
735 $potential_method_char = $method_char;
736 $potential_method_spec = $method_spec;
737 $potential_start = $.;
738 $in_method_declaration = 1;
740 warn "declaring a method but don't have interface on line $. in $file_name\n";
744 my $selector = method_decl_to_selector ($potential_method_spec);
745 $potential_name = "${potential_method_char}\[${interface_name} ${selector}\]";
747 $potential_method_spec = "";
748 $potential_method_char = "";
749 $in_method_declaration = 0;
753 $in_method_declaration = 0;
754 $interface_name = "";
762 # Find function, interface and method names.
763 while (m&((?:[[:word:]]+::)*operator(?:[ \t]*\(\)|[^()]*)|[[:word:]:~]+|[(){}:;=])|\@(?:implementation|interface|protocol)\s+(\w+)[^{]*&g) {
764 # Skip an array definition at the top level.
765 # e.g. static int arr[] = { 1, 2, 3 };
767 if ($1 eq "=" and !$in_parentheses and !$in_braces) {
769 } elsif ($1 eq "{" and $equal_observed) {
770 # This '{' is the beginning of an array definition, not the beginning of a method.
771 $in_toplevel_array_brace = 1;
775 } elsif ($1 !~ /[ \t]/) {
782 $interface_name = $2;
788 $potential_name = $word unless $in_parentheses || $skip_til_brace_or_semicolon;
799 # C++ constructor initializers
801 $skip_til_brace_or_semicolon = 1 unless ($in_parentheses || $in_braces);
806 $skip_til_brace_or_semicolon = 0;
809 if ($namespace_start >= 0 and $namespace_start < $potential_start) {
810 push @ranges, [ $namespace_start . "", $potential_start - 1, $name ];
813 if ($potential_namespace) {
814 push @namespaces, $potential_namespace;
815 $potential_namespace = "";
816 $name = $namespaces[-1];
817 $namespace_start = $. + 1;
821 # Promote potential name to real function name at the
822 # start of the outer level set of braces (function body?).
823 if ($potential_start) {
824 $start = $potential_start;
825 $name = $potential_name;
826 if (@namespaces && $name && (length($name) < 2 || substr($name,1,1) ne "[")) {
827 $name = join ('::', @namespaces, $name);
832 $in_method_declaration = 0;
834 $brace_start = $. if (!$in_braces);
841 if (!$in_braces && @namespaces) {
842 if ($namespace_start >= 0 and $namespace_start < $.) {
843 push @ranges, [ $namespace_start . "", $. - 1, $name ];
848 $name = $namespaces[-1];
849 $namespace_start = $. + 1;
852 $namespace_start = -1;
858 $brace_end = $. if (!$in_braces);
860 # End of an outer level set of braces.
861 # This could be a function body.
862 if (!$in_braces and $name) {
863 # This is the end of an array definition at the top level, not the end of a method.
864 if ($in_toplevel_array_brace) {
865 $in_toplevel_array_brace = 0;
869 push @ranges, [ $start, $., $name ];
871 $name = $namespaces[-1];
872 $namespace_start = $. + 1;
875 $namespace_start = -1;
879 $potential_start = 0;
880 $potential_name = "";
886 $skip_til_brace_or_semicolon = 0;
887 $potential_start = 0;
888 $potential_name = "";
889 $in_method_declaration = 0;
893 # Ignore "const" method qualifier.
898 if ($1 eq "namespace" || $1 eq "class" || $1 eq "struct") {
899 $next_word_could_be_namespace = 1;
905 if (!$skip_til_brace_or_semicolon) {
906 if ($next_word_could_be_namespace) {
907 $potential_namespace = $word;
908 $next_word_could_be_namespace = 0;
909 } elsif ($potential_namespace) {
910 $potential_namespace = "";
913 if (!$in_parentheses) {
914 $potential_start = 0;
915 $potential_name = "";
917 if (!$potential_start) {
918 $potential_start = $.;
919 $potential_name = "";
925 warn "missing close braces in $file_name (probable start at $brace_start)\n" if ($in_braces > 0);
926 warn "too many close braces in $file_name (probable start at $brace_end)\n" if ($in_braces < 0);
928 warn "mismatched parentheses in $file_name\n" if $in_parentheses;
935 # Read a file and get all the line ranges of the things that look like Java
936 # classes, interfaces and methods.
938 # A class or interface name is the word that immediately follows
939 # `class' or `interface' when followed by an open curly brace and not
940 # a semicolon. It can appear at the top level, or inside another class
941 # or interface block, but not inside a function block
943 # A class or interface starts at the first character after the first close
944 # brace or after the function name and ends at the close brace.
946 # A function name is the last word before an open parenthesis before
947 # an open brace rather than a semicolon. It can appear at top level or
948 # inside a class or interface block, but not inside a function block.
950 # A function starts at the first character after the first close
951 # brace or after the function name and ends at the close brace.
953 # Comment handling is simple-minded but will work for all but pathological cases.
955 # Result is a list of triples: [ start_line, end_line, function_name ].
957 sub get_function_line_ranges_for_java($$)
959 my ($file_handle, $file_name) = @_;
967 my $in_parentheses = 0;
969 my $in_non_block_braces = 0;
970 my $class_or_interface_just_seen = 0;
971 my $in_class_declaration = 0;
975 my $potential_start = 0;
976 my $potential_name = "";
977 my $potential_name_is_class_or_interface = 0;
981 my $current_name_is_class_or_interface = 0;
983 while (<$file_handle>) {
984 # Handle continued multi-line comment.
986 next unless s-.*\*/--;
990 # Handle continued macro.
992 $in_macro = 0 unless /\\$/;
996 # Handle start of macro (or any preprocessor directive).
998 $in_macro = 1 if /^([^\\]|\\.)*\\$/;
1002 # Handle comments and quoted text.
1003 while (m-(/\*|//|\'|\")-) { # \' and \" keep emacs perl mode happy
1005 if ($match eq "/*") {
1006 if (!s-/\*.*?\*/--) {
1010 } elsif ($match eq "//") {
1013 if (!s-$match([^\\]|\\.)*?$match--) {
1014 warn "mismatched quotes at line $. in $file_name\n";
1020 # Find function names.
1021 while (m-(\w+|[(){};])-g) {
1024 if (!$in_parentheses) {
1025 $potential_name = $word;
1026 $potential_name_is_class_or_interface = 0;
1032 # Close parenthesis.
1040 $in_class_declaration = 0;
1042 # Promote potential name to real function name at the
1043 # start of the outer level set of braces (function/class/interface body?).
1044 if (!$in_non_block_braces
1045 and (!$in_braces or $current_name_is_class_or_interface)
1046 and $potential_start) {
1048 push @ranges, [ $start, ($. - 1),
1049 join ('.', @current_scopes) ];
1053 $current_name_is_class_or_interface = $potential_name_is_class_or_interface;
1055 $start = $potential_start;
1056 $name = $potential_name;
1058 push (@current_scopes, $name);
1060 $in_non_block_braces++;
1063 $potential_name = "";
1064 $potential_start = 0;
1074 # End of an outer level set of braces.
1075 # This could be a function body.
1076 if (!$in_non_block_braces) {
1078 push @ranges, [ $start, $.,
1079 join ('.', @current_scopes) ];
1081 pop (@current_scopes);
1083 if (@current_scopes) {
1084 $current_name_is_class_or_interface = 1;
1087 $name = $current_scopes[$#current_scopes-1];
1089 $current_name_is_class_or_interface = 0;
1095 $in_non_block_braces-- if $in_non_block_braces;
1098 $potential_start = 0;
1099 $potential_name = "";
1105 $potential_start = 0;
1106 $potential_name = "";
1110 if ($1 eq "class") {
1111 $in_class_declaration = 1;
1113 if ($1 eq "class" or (!$in_class_declaration and $1 eq "interface")) {
1114 $class_or_interface_just_seen = 1;
1120 if (!$in_parentheses) {
1121 if ($class_or_interface_just_seen) {
1122 $potential_name = $word;
1123 $potential_start = $.;
1124 $class_or_interface_just_seen = 0;
1125 $potential_name_is_class_or_interface = 1;
1129 if (!$potential_start) {
1130 $potential_start = $.;
1131 $potential_name = "";
1133 $class_or_interface_just_seen = 0;
1137 warn "mismatched braces in $file_name\n" if $in_braces;
1138 warn "mismatched parentheses in $file_name\n" if $in_parentheses;
1145 # Read a file and get all the line ranges of the things that look like
1146 # JavaScript functions.
1148 # A function name is the word that immediately follows `function' when
1149 # followed by an open curly brace. It can appear at the top level, or
1150 # inside other functions.
1152 # An anonymous function name is the identifier chain immediately before
1153 # an assignment with the equals operator or object notation that has a
1154 # value starting with `function' followed by an open curly brace.
1156 # A getter or setter name is the word that immediately follows `get' or
1157 # `set' when followed by an open curly brace .
1159 # Comment handling is simple-minded but will work for all but pathological cases.
1161 # Result is a list of triples: [ start_line, end_line, function_name ].
1163 sub get_function_line_ranges_for_javascript($$)
1165 my ($fileHandle, $fileName) = @_;
1168 my @currentIdentifiers;
1169 my @currentFunctionNames;
1170 my @currentFunctionDepths;
1171 my @currentFunctionStartLines;
1176 my $inQuotedText = "";
1177 my $parenthesesDepth = 0;
1178 my $bracesDepth = 0;
1180 my $functionJustSeen = 0;
1181 my $getterJustSeen = 0;
1182 my $setterJustSeen = 0;
1183 my $assignmentJustSeen = 0;
1187 while (<$fileHandle>) {
1188 # Handle continued multi-line comment.
1190 next unless s-.*\*/--;
1194 # Handle continued quoted text.
1195 if ($inQuotedText ne "") {
1197 s-([^\\]|\\.)*?$inQuotedText--;
1201 # Handle comments and quoted text.
1202 while (m-(/\*|//|\'|\")-) { # \' and \" keep emacs perl mode happy
1204 if ($match eq '/*') {
1205 if (!s-/\*.*?\*/--) {
1209 } elsif ($match eq '//') {
1212 if (!s-$match([^\\]|\\.)*?$match-string_appeared_here-) {
1213 $inQuotedText = $match if /\\$/;
1214 warn "mismatched quotes at line $. in $fileName\n" if $inQuotedText eq "";
1220 # Find function names.
1221 while (m-(\w+|[(){}=:;])-g) {
1224 $parenthesesDepth++;
1228 # Close parenthesis.
1230 $parenthesesDepth--;
1236 push(@currentScopes, join(".", @currentIdentifiers));
1237 @currentIdentifiers = ();
1247 if (@currentFunctionDepths and $bracesDepth == $currentFunctionDepths[$#currentFunctionDepths]) {
1248 pop(@currentFunctionDepths);
1250 my $currentFunction = pop(@currentFunctionNames);
1251 my $start = pop(@currentFunctionStartLines);
1253 push(@ranges, [$start, $., $currentFunction]);
1256 pop(@currentScopes);
1257 @currentIdentifiers = ();
1264 @currentIdentifiers = ();
1269 if ($1 eq 'function') {
1270 $functionJustSeen = 1;
1272 if ($assignmentJustSeen) {
1273 my $currentFunction = join('.', (@currentScopes, @currentIdentifiers));
1274 $currentFunction =~ s/\.{2,}/\./g; # Removes consecutive periods.
1276 push(@currentFunctionNames, $currentFunction);
1277 push(@currentFunctionDepths, $bracesDepth);
1278 push(@currentFunctionStartLines, $.);
1286 $getterJustSeen = 1;
1292 $setterJustSeen = 1;
1296 # Assignment operator.
1297 if ($1 eq '=' or $1 eq ':') {
1298 $assignmentJustSeen = 1;
1302 next if $parenthesesDepth;
1306 $word = "get $word" if $getterJustSeen;
1307 $word = "set $word" if $setterJustSeen;
1309 if (($functionJustSeen and !$assignmentJustSeen) or $getterJustSeen or $setterJustSeen) {
1310 push(@currentIdentifiers, $word);
1312 my $currentFunction = join('.', (@currentScopes, @currentIdentifiers));
1313 $currentFunction =~ s/\.{2,}/\./g; # Removes consecutive periods.
1315 push(@currentFunctionNames, $currentFunction);
1316 push(@currentFunctionDepths, $bracesDepth);
1317 push(@currentFunctionStartLines, $.);
1318 } elsif ($word ne 'if' and $word ne 'for' and $word ne 'do' and $word ne 'while' and $word ne 'which' and $word ne 'var') {
1319 push(@currentIdentifiers, $word);
1322 $functionJustSeen = 0;
1323 $getterJustSeen = 0;
1324 $setterJustSeen = 0;
1325 $assignmentJustSeen = 0;
1329 warn "mismatched braces in $fileName\n" if $bracesDepth;
1330 warn "mismatched parentheses in $fileName\n" if $parenthesesDepth;
1335 # Read a file and get all the line ranges of the things that look like Perl functions. Functions
1336 # start on a line that starts with "sub ", and end on the first line starting with "}" thereafter.
1338 # Result is a list of triples: [ start_line, end_line, function ].
1340 sub get_function_line_ranges_for_perl($$)
1342 my ($fileHandle, $fileName) = @_;
1346 my $currentFunction = "";
1348 my $hereDocumentIdentifier = "";
1350 while (<$fileHandle>) {
1352 if (!$hereDocumentIdentifier) {
1353 if (/^sub\s+([\w_][\w\d_]*)/) {
1354 # Skip over forward declarations, which don't contain a brace and end with a semicolon.
1357 if ($currentFunction) {
1358 warn "nested functions found at top-level at $fileName:$.\n";
1361 $currentFunction = $1;
1364 if (/<<\s*[\"\']?([\w_][\w_\d]*)/) {
1365 # Enter here-document.
1366 $hereDocumentIdentifier = $1;
1368 if (index($_, "}") == 0) {
1370 push(@ranges, [$start, $., $currentFunction]);
1371 $currentFunction = "";
1374 } elsif ($_ eq $hereDocumentIdentifier) {
1375 # Escape from here-document.
1376 $hereDocumentIdentifier = "";
1383 # Read a file and get all the line ranges of the things that look like Python classes, methods, or functions.
1385 # FIXME: Maybe we should use Python's ast module to do the parsing for us?
1387 # Result is a list of triples: [ start_line, end_line, function ].
1389 sub get_function_line_ranges_for_python($$)
1391 my ($fileHandle, $fileName) = @_;
1395 my @scopeStack = ({ line => 0, indent => -1, name => undef });
1400 # To pop out all popped scopes, run the loop once more after
1401 # we encountered the end of the file.
1407 next unless /^(\s*)([^#].*)$/;
1409 my $indent = length $1;
1411 my $scope = $scopeStack[-1];
1413 if ($indent <= $scope->{indent}) {
1414 # Find all the scopes that we have just exited.
1416 for (; $i < @scopeStack; ++$i) {
1417 last if $indent <= $scopeStack[$i]->{indent};
1419 my @poppedScopes = splice @scopeStack, $i;
1421 # For each scope that was just exited, add a range that goes from the start of that
1422 # scope to the start of the next nested scope, or to the line just before this one for
1423 # the innermost scope.
1424 for ($i = 0; $i < @poppedScopes; ++$i) {
1425 my $lineAfterEnd = $i + 1 == @poppedScopes ? $. : $poppedScopes[$i + 1]->{line};
1426 push @ranges, [$poppedScopes[$i]->{line}, $lineAfterEnd - 1, $poppedScopes[$i]->{name}];
1428 @scopeStack or warn "Popped off last scope at $fileName:$.\n";
1430 # Set the now-current scope to start at the current line. Any lines within this scope
1431 # before this point should already have been added to @ranges.
1432 $scope = $scopeStack[-1];
1433 $scope->{line} = $.;
1436 next unless $rest =~ /(?:class|def)\s+(\w+)/;
1438 my $fullName = $scope->{name} ? join('.', $scope->{name}, $name) : $name;
1439 push @scopeStack, { line => $., indent => $indent, name => $fullName };
1441 if ($scope->{indent} >= 0) {
1442 push @ranges, [$scope->{line}, $. - 1, $scope->{name}];
1449 # Read a file and get all the line ranges of the things that look like CSS selectors. A selector is
1450 # anything before an opening brace on a line. A selector starts at the line containing the opening
1451 # brace and ends at the closing brace.
1453 # Result is a list of triples: [ start_line, end_line, selector ].
1455 sub get_selector_line_ranges_for_css($$)
1457 my ($fileHandle, $fileName) = @_;
1461 my $currentSelector = "";
1466 while (<$fileHandle>) {
1467 foreach my $token (split m-(\{|\}|/\*|\*/)-, $_) {
1468 if ($token eq "{") {
1470 warn "mismatched brace found in $fileName\n" if $inBrace;
1473 } elsif ($token eq "}") {
1475 warn "mismatched brace found in $fileName\n" if !$inBrace;
1477 push(@ranges, [$start, $., $currentSelector]);
1478 $currentSelector = "";
1481 } elsif ($token eq "/*") {
1483 } elsif ($token eq "*/") {
1484 warn "mismatched comment found in $fileName\n" if !$inComment;
1487 if (!$inComment and !$inBrace and $token !~ /^[\s\t]*$/) {
1488 $token =~ s/^[\s\t]*|[\s\t]*$//g;
1489 $currentSelector = $token;
1499 sub processPaths(\@)
1502 return ("." => 1) if (!@{$paths});
1506 for my $file (@{$paths}) {
1507 die "can't handle absolute paths like \"$file\"\n" if File::Spec->file_name_is_absolute($file);
1508 die "can't handle empty string path\n" if $file eq "";
1509 die "can't handle path with single quote in the name like \"$file\"\n" if $file =~ /'/; # ' (keep Xcode syntax highlighting happy)
1511 my $untouchedFile = $file;
1513 $file = canonicalizePath($file);
1515 die "can't handle paths with .. like \"$untouchedFile\"\n" if $file =~ m|/\.\./|;
1520 return ("." => 1) if ($result{"."});
1522 # Remove any paths that also have a parent listed.
1523 for my $path (keys %result) {
1524 for (my $parent = dirname($path); $parent ne '.'; $parent = dirname($parent)) {
1525 if ($result{$parent}) {
1526 delete $result{$path};
1535 sub diffFromToString($$$)
1537 my ($gitCommit, $gitIndex, $mergeBase) = @_;
1539 return "" if isSVN();
1540 return $gitCommit if $gitCommit =~ m/.+\.\..+/;
1541 return "\"$gitCommit^\" \"$gitCommit\"" if $gitCommit;
1542 return "--cached" if $gitIndex;
1543 return $mergeBase if $mergeBase;
1544 return "HEAD" if isGit();
1547 sub diffCommand($$$$)
1549 my ($paths, $gitCommit, $gitIndex, $mergeBase) = @_;
1553 my @escapedPaths = map(escapeSubversionPath($_), @$paths);
1554 my $escapedPathsString = "'" . join("' '", @escapedPaths) . "'";
1555 $command = SVN . " diff --diff-cmd diff -x -N $escapedPathsString";
1557 my $pathsString = "'" . join("' '", @$paths) . "'";
1558 $command = GIT . " diff --no-ext-diff -U0 " . diffFromToString($gitCommit, $gitIndex, $mergeBase);
1559 $command .= " -- $pathsString" unless $gitCommit or $mergeBase;
1565 sub statusCommand($$$$)
1567 my ($paths, $gitCommit, $gitIndex, $mergeBase) = @_;
1571 my @escapedFiles = map(escapeSubversionPath($_), keys %$paths);
1572 my $escapedFilesString = "'" . join("' '", @escapedFiles) . "'";
1573 $command = SVN . " stat $escapedFilesString";
1575 my $filesString = '"' . join('" "', keys %$paths) . '"';
1576 $command = GIT . " diff -r --name-status -M -C " . diffFromToString($gitCommit, $gitIndex, $mergeBase);
1577 $command .= " -- $filesString" unless $gitCommit;
1580 return "$command 2>&1";
1583 sub createPatchCommand($$$$)
1585 my ($changedFilesString, $gitCommit, $gitIndex, $mergeBase) = @_;
1589 $command = "'$FindBin::Bin/svn-create-patch' $changedFilesString";
1591 $command = GIT . " diff -M -C " . diffFromToString($gitCommit, $gitIndex, $mergeBase);
1592 $command .= " -- $changedFilesString" unless $gitCommit;
1598 sub diffHeaderFormat()
1600 return qr/^Index: (\S+)[\r\n]*$/ if isSVN();
1601 return qr/^diff --git a\/.+ b\/(.+)$/ if isGit();
1604 sub findOriginalFileFromSvn($)
1608 open INFO, SVN . " info . |" or die;
1610 if (/^URL: (.+?)[\r\n]*$/) {
1616 my $escapedFile = escapeSubversionPath($file);
1617 open INFO, SVN . " info '$escapedFile' |" or die;
1619 if (/^Copied From URL: (.+?)[\r\n]*$/) {
1620 $sourceFile = File::Spec->abs2rel($1, $baseUrl);
1627 sub determinePropertyChanges($$$)
1629 my ($file, $isAdd, $original) = @_;
1631 my $escapedFile = escapeSubversionPath($file);
1634 my %addedProperties;
1635 my %removedProperties;
1636 open PROPLIST, SVN . " proplist '$escapedFile' |" or die;
1637 while (<PROPLIST>) {
1638 $addedProperties{$1} = 1 if /^ (.+?)[\r\n]*$/ && $1 ne 'svn:mergeinfo';
1642 my $escapedOriginal = escapeSubversionPath($original);
1643 open PROPLIST, SVN . " proplist '$escapedOriginal' |" or die;
1644 while (<PROPLIST>) {
1645 next unless /^ (.+?)[\r\n]*$/;
1647 if (exists $addedProperties{$property}) {
1648 delete $addedProperties{$1};
1650 $removedProperties{$1} = 1;
1654 $changes{"A"} = [sort keys %addedProperties] if %addedProperties;
1655 $changes{"D"} = [sort keys %removedProperties] if %removedProperties;
1657 open DIFF, SVN . " diff '$escapedFile' |" or die;
1659 if (/^Property changes on:/) {
1663 if (/^Added: (\S*)/) {
1666 } elsif (/^Modified: (\S*)/) {
1669 } elsif (/^Deleted: (\S*)/) {
1672 } elsif (/^Name: (\S*)/) {
1673 # Older versions of svn just say "Name" instead of the type
1674 # of property change.
1679 $changes{$operation} = [] unless exists $changes{$operation};
1680 push @{$changes{$operation}}, $property;
1690 sub pluralizeAndList($$@)
1692 my ($singular, $plural, @items) = @_;
1694 return if @items == 0;
1695 return "$singular $items[0]" if @items == 1;
1696 return "$plural " . join(", ", @items[0 .. $#items - 1]) . " and " . $items[-1];
1699 sub generateFileList(\%$$$)
1701 my ($paths, $gitCommit, $gitIndex, $mergeBase) = @_;
1706 my @addedRegressionTests;
1707 print STDERR " Running status to find changed, added, or removed files.\n";
1708 open STAT, "-|", statusCommand($paths, $gitCommit, $gitIndex, $mergeBase) or die "The status failed: $!.\n";
1712 my $propertyChanges;
1718 if (isSVNVersion16OrNewer()) {
1719 $matches = /^([ ACDMR])([ CM]).{5} (.+?)[\r\n]*$/;
1721 $propertyStatus = $2;
1724 $matches = /^([ ACDMR])([ CM]).{4} (.+?)[\r\n]*$/;
1726 $propertyStatus = $2;
1730 $file = normalizePath($file);
1731 $original = findOriginalFileFromSvn($file) if substr($_, 3, 1) eq "+";
1732 my $isAdd = isAddedStatus($status);
1733 $propertyChanges = determinePropertyChanges($file, $isAdd, $original) if isModifiedStatus($propertyStatus) || $isAdd;
1735 print; # error output from svn stat
1738 if (/^([ADM])\t(.+)$/) {
1740 $propertyStatus = " "; # git doesn't have properties
1741 $file = normalizePath($2);
1742 } elsif (/^([CR])[0-9]{1,3}\t([^\t]+)\t([^\t\n]+)$/) { # for example: R90% newfile oldfile
1744 $propertyStatus = " ";
1745 $original = normalizePath($2);
1746 $file = normalizePath($3);
1748 print; # error output from git diff
1752 next if !$status || isUnmodifiedStatus($status) && isUnmodifiedStatus($propertyStatus);
1754 $file = makeFilePathRelative($file);
1756 if (isModifiedStatus($status) || isAddedStatus($status) || isModifiedStatus($propertyStatus)) {
1757 my @components = File::Spec->splitdir($file);
1758 if ($components[0] eq "LayoutTests") {
1759 push @addedRegressionTests, $file
1760 if isAddedStatus($status)
1761 && $file =~ /\.([a-zA-Z]+)$/
1762 && SupportedTestExtensions->{lc($1)}
1763 && $file !~ /-expected(-mismatch)?\.html$/
1764 && !scalar(grep(/^resources$/i, @components))
1765 && !scalar(grep(/^script-tests$/i, @components));
1767 push @changedFiles, $file if $components[$#components] ne changeLogFileName();
1768 } elsif (isConflictStatus($status, $gitCommit, $gitIndex) || isConflictStatus($propertyStatus, $gitCommit, $gitIndex)) {
1769 push @conflictFiles, $file;
1771 if (basename($file) ne changeLogFileName()) {
1772 my $description = statusDescription($status, $propertyStatus, $original, $propertyChanges);
1773 $functionLists{$file} = $description if defined $description;
1777 return (\@changedFiles, \@conflictFiles, \%functionLists, \@addedRegressionTests);
1780 sub isUnmodifiedStatus($)
1788 return $statusCodes{$status};
1791 sub isModifiedStatus($)
1799 return $statusCodes{$status};
1802 sub isAddedStatus($)
1812 return $statusCodes{$status};
1815 sub isConflictStatus($$$)
1817 my ($status, $gitCommit, $gitIndex) = @_;
1827 return 0 if ($gitCommit || $gitIndex); # an existing commit or staged change cannot have conflicts
1828 return $svn{$status} if isSVN();
1829 return $git{$status} if isGit();
1832 sub statusDescription($$$$)
1834 my ($status, $propertyStatus, $original, $propertyChanges) = @_;
1836 my $propertyDescription = defined $propertyChanges ? propertyChangeDescription($propertyChanges) : "";
1839 "A" => defined $original ? " Copied from \%s." : " Added.",
1842 "R" => defined $original ? " Replaced with \%s." : " Replaced.",
1847 $git{"A"} = " Added.";
1848 $git{"C"} = " Copied from \%s.";
1849 $git{"R"} = " Renamed from \%s.";
1852 $description = sprintf($svn{$status}, $original) if isSVN() && exists $svn{$status};
1853 $description = sprintf($git{$status}, $original) if isGit() && exists $git{$status};
1854 return unless defined $description;
1856 $description .= $propertyDescription unless isAddedStatus($status);
1857 return $description;
1860 sub propertyChangeDescription($)
1862 my ($propertyChanges) = @_;
1871 my $description = "";
1872 while (my ($operation, $properties) = each %$propertyChanges) {
1873 my $word = $operations{$operation};
1874 my $list = pluralizeAndList("property", "properties", @$properties);
1875 $description .= " $word $list.";
1877 return $description;
1880 sub extractLineRange($)
1884 my ($start, $end) = (-1, -1);
1886 if (isSVN() && $string =~ /^\d+(,\d+)?[acd](\d+)(,(\d+))?/) {
1889 } elsif (isGit() && $string =~ /^@@ -\d+(,\d+)? \+(\d+)(,(\d+))? @@/) {
1891 $end = defined($4) ? $4 + $2 - 1 : $2;
1894 return ($start, $end);
1897 sub testListForChangeLog(@)
1901 return "" unless @tests;
1903 my $leadString = " Test" . (@tests == 1 ? "" : "s") . ": ";
1904 my $list = $leadString;
1905 foreach my $i (0..$#tests) {
1906 $list .= " " x length($leadString) if $i;
1907 my $test = $tests[$i];
1908 $test =~ s/^LayoutTests\///;
1916 sub reviewerAndDescriptionForGitCommit($$)
1918 my ($commit, $gitReviewer) = @_;
1920 my $description = '';
1923 my @args = qw(rev-list --pretty);
1924 push @args, '-1' if $commit !~ m/.+\.\..+/;
1928 open(GITLOG, "-|", GIT, @args, $commit) || die;
1933 my @commitLogs = split(/^[Cc]ommit [a-f0-9]{40}/m, $gitLog);
1934 shift @commitLogs; # Remove initial blank commit log
1935 my $commitLogCount = 0;
1936 foreach my $commitLog (@commitLogs) {
1937 $description .= "\n" if $commitLogCount;
1940 my $commitLogIndent;
1941 my @lines = split(/\n/, $commitLog);
1942 shift @lines; # Remove initial blank line
1943 foreach my $line (@lines) {
1949 } elsif ($line =~ /[Ss]igned-[Oo]ff-[Bb]y: (.+)/) {
1953 $reviewer .= ", " . $1;
1955 } elsif ($line =~ /^\s*$/) {
1956 $description = $description . "\n";
1958 if (!defined($commitLogIndent)) {
1959 # Let the first line with non-white space determine
1960 # the global indent.
1961 $line =~ /^(\s*)\S/;
1962 $commitLogIndent = length($1);
1964 # Strip at most the indent to preserve relative indents.
1965 $line =~ s/^\s{0,$commitLogIndent}//;
1966 $description = $description . (" " x 8) . $line . "\n";
1971 $reviewer = $gitReviewer;
1974 return ($reviewer, $description);
1977 sub normalizeLineEndings($$)
1979 my ($string, $endl) = @_;
1980 $string =~ s/\r?\n/$endl/g;
1984 sub decodeEntities($)
1987 $text =~ s/\</</g;
1988 $text =~ s/\>/>/g;
1989 $text =~ s/\"/\"/g;
1990 $text =~ s/\'/\'/g;
1991 $text =~ s/\&/\&/g;