Tools/Scripts/prepare-ChangeLog

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