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