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