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