1#!/usr/bin/perl -w 2# -*- Mode: perl; indent-tabs-mode: nil; c-basic-offset: 2 -*- 3 4# 5# Copyright (C) 2000, 2001 Eazel, Inc. 6# Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007 Apple Inc. All rights reserved. 7# Copyright (C) 2009 Torch Mobile, Inc. 8# Copyright (C) 2009 Cameron McCormack <cam@mcc.id.au> 9# 10# prepare-ChangeLog is free software; you can redistribute it and/or 11# modify it under the terms of the GNU General Public 12# License as published by the Free Software Foundation; either 13# version 2 of the License, or (at your option) any later version. 14# 15# prepare-ChangeLog is distributed in the hope that it will be useful, 16# but WITHOUT ANY WARRANTY; without even the implied warranty of 17# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 18# General Public License for more details. 19# 20# You should have received a copy of the GNU General Public 21# License along with this program; if not, write to the Free 22# Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. 23# 24 25 26# Perl script to create a ChangeLog entry with names of files 27# and functions from a diff. 28# 29# Darin Adler <darin@bentspoon.com>, started 20 April 2000 30# Java support added by Maciej Stachowiak <mjs@eazel.com> 31# Objective-C, C++ and Objective-C++ support added by Maciej Stachowiak <mjs@apple.com> 32# Git support added by Adam Roben <aroben@apple.com> 33# --git-index flag added by Joe Mason <joe.mason@torchmobile.com> 34 35 36# 37# TODO: 38# List functions that have been removed too. 39# Decide what a good logical order is for the changed files 40# other than a normal text "sort" (top level first?) 41# (group directories?) (.h before .c?) 42# Handle yacc source files too (other languages?). 43# Help merge when there are ChangeLog conflicts or if there's 44# already a partly written ChangeLog entry. 45# Add command line option to put the ChangeLog into a separate file. 46# Add SVN version numbers for commit (can't do that until 47# the changes are checked in, though). 48# Work around diff stupidity where deleting a function that starts 49# with a comment makes diff think that the following function 50# has been changed (if the following function starts with a comment 51# with the same first line, such as /**) 52# Work around diff stupidity where deleting an entire function and 53# the blank lines before it makes diff think you've changed the 54# previous function. 55 56use strict; 57use warnings; 58 59use File::Basename; 60use File::Spec; 61use FindBin; 62use Getopt::Long; 63use lib $FindBin::Bin; 64use POSIX qw(strftime); 65use VCSUtils; 66 67sub changeLogDate($); 68sub changeLogEmailAddressFromArgs($); 69sub changeLogNameFromArgs($); 70sub firstDirectoryOrCwd(); 71sub diffFromToString(); 72sub diffCommand(@); 73sub statusCommand(@); 74sub createPatchCommand($); 75sub diffHeaderFormat(); 76sub findOriginalFileFromSvn($); 77sub determinePropertyChanges($$$); 78sub pluralizeAndList($$@); 79sub generateFileList(\@\@\%); 80sub isUnmodifiedStatus($); 81sub isModifiedStatus($); 82sub isAddedStatus($); 83sub isConflictStatus($); 84sub statusDescription($$$$); 85sub propertyChangeDescription($); 86sub extractLineRange($); 87sub testListForChangeLog(@); 88sub get_function_line_ranges($$); 89sub get_function_line_ranges_for_c($$); 90sub get_function_line_ranges_for_java($$); 91sub get_function_line_ranges_for_javascript($$); 92sub method_decl_to_selector($); 93sub processPaths(\@); 94sub reviewerAndDescriptionForGitCommit($); 95sub normalizeLineEndings($$); 96sub decodeEntities($); 97 98# Project time zone for Cupertino, CA, US 99my $changeLogTimeZone = "PST8PDT"; 100 101my $bugNumber; 102my $name; 103my $emailAddress; 104my $gitCommit = 0; 105my $gitIndex = ""; 106my $gitReviewer = ""; 107my $openChangeLogs = 0; 108my $writeChangeLogs = 1; 109my $showHelp = 0; 110my $spewDiff = $ENV{"PREPARE_CHANGELOG_DIFF"}; 111my $updateChangeLogs = 1; 112my $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); 124if (!$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 139die "--git-commit and --git-index are incompatible." if ($gitIndex && $gitCommit); 140 141my %paths = processPaths(@ARGV); 142 143my $isGit = isGitDirectory(firstDirectoryOrCwd()); 144my $isSVN = isSVNDirectory(firstDirectoryOrCwd()); 145 146$isSVN || $isGit || die "Couldn't determine your version control system."; 147 148my $SVN = "svn"; 149my $GIT = "git"; 150 151# Find the list of modified files 152my @changed_files; 153my $changed_files_string; 154my %changed_line_ranges; 155my %function_lists; 156my @conflict_files; 157 158 159my %supportedTestExtensions = map { $_ => 1 } qw(html shtml svg xml xhtml pl php); 160my @addedRegressionTests = (); 161my $didChangeRegressionTests = 0; 162 163generateFileList(@changed_files, @conflict_files, %function_lists); 164 165if (!@changed_files && !@conflict_files && !keys %function_lists) { 166 print STDERR " No changes found.\n"; 167 exit 1; 168} 169 170if (@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 176if (@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. 199if (%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. 247my $date = changeLogDate($changeLogTimeZone); 248$name = changeLogNameFromArgs($name); 249$emailAddress = changeLogEmailAddressFromArgs($emailAddress); 250 251print STDERR " Change author: $name <$emailAddress>.\n"; 252 253my $bugDescription; 254my $bugURL; 255if ($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. 273my %has_log; 274my %files; 275foreach 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 295my @prefixes; 296my %prefixesSort; 297foreach 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} 316foreach my $prefixSort (sort keys %prefixesSort) { 317 push @prefixes, $prefixesSort{$prefixSort}; 318} 319 320# Get the latest ChangeLog files from svn. 321my @logs = (); 322foreach my $prefix (@prefixes) { 323 push @logs, File::Spec->catfile($prefix || ".", "ChangeLog"); 324} 325 326if (@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. 348foreach 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 406if ($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. 411if ($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. 420if ($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. 431exit; 432 433 434sub 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 449sub 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 458sub 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 467sub 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 482sub 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 516sub 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 804sub 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 1004sub 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 1177sub 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 1213sub 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 1222sub 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 1239sub 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 1255sub 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 1270sub diffHeaderFormat() 1271{ 1272 return qr/^Index: (\S+)[\r\n]*$/ if $isSVN; 1273 return qr/^diff --git a\/.+ b\/(.+)$/ if $isGit; 1274} 1275 1276sub 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 1298sub 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 1359sub 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 1368sub 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 1443sub isUnmodifiedStatus($) 1444{ 1445 my ($status) = @_; 1446 1447 my %statusCodes = ( 1448 " " => 1, 1449 ); 1450 1451 return $statusCodes{$status}; 1452} 1453 1454sub isModifiedStatus($) 1455{ 1456 my ($status) = @_; 1457 1458 my %statusCodes = ( 1459 "M" => 1, 1460 ); 1461 1462 return $statusCodes{$status}; 1463} 1464 1465sub 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 1478sub 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 1495sub 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 1523sub 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 1543sub 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 1560sub 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 1570sub 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 1589sub 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 1650sub normalizeLineEndings($$) 1651{ 1652 my ($string, $endl) = @_; 1653 $string =~ s/\r?\n/$endl/g; 1654 return $string; 1655} 1656 1657sub 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