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.

     7 #

     8 #  prepare-ChangeLog is free software; you can redistribute it and/or

     9 #  modify it under the terms of the GNU General Public

    10 #  License as published by the Free Software Foundation; either

    11 #  version 2 of the License, or (at your option) any later version.

    12 #

    13 #  prepare-ChangeLog is distributed in the hope that it will be useful,

    14 #  but WITHOUT ANY WARRANTY; without even the implied warranty of

    15 #  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU

    16 #  General Public License for more details.

    17 #

    18 #  You should have received a copy of the GNU General Public

    19 #  License along with this program; if not, write to the Free

    20 #  Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.

    21 #

    22 

    23 

    24 # Perl script to create a ChangeLog entry with names of files

    25 # and functions from a diff.

    26 #

    27 # Darin Adler <darin@bentspoon.com>, started 20 April 2000

    28 # Java support added by Maciej Stachowiak <mjs@eazel.com>

    29 # Objective-C, C++ and Objective-C++ support added by Maciej Stachowiak <mjs@apple.com>

    30 # Git support added by Adam Roben <aroben@apple.com>

    31 

    32 

    33 #

    34 # TODO:

    35 #   List functions that have been removed too.

    36 #   Decide what a good logical order is for the changed files

    37 #     other than a normal text "sort" (top level first?)

    38 #     (group directories?) (.h before .c?)

    39 #   Handle yacc source files too (other languages?).

    40 #   Help merge when there are ChangeLog conflicts or if there's

    41 #     already a partly written ChangeLog entry.

    42 #   Add command line option to put the ChangeLog into a separate

    43 #     file or just spew it out stdout.

    44 #   Add SVN version numbers for commit (can't do that until

    45 #     the changes are checked in, though).

    46 #   Work around diff stupidity where deleting a function that starts

    47 #     with a comment makes diff think that the following function

    48 #     has been changed (if the following function starts with a comment

    49 #     with the same first line, such as /**)

    50 #   Work around diff stupidity where deleting an entire function and

    51 #     the blank lines before it makes diff think you've changed the

    52 #     previous function.

    53 

    54 use strict;

    55 use warnings;

    56 

    57 use File::Basename;

    58 use File::Spec;

    59 use FindBin;

    60 use Getopt::Long;

    61 use lib $FindBin::Bin;

    62 use POSIX qw(strftime);

    63 use VCSUtils;

    64 

    65 sub changeLogDate($);

    66 sub firstDirectoryOrCwd();

    67 sub diffFromToString();

    68 sub diffCommand(@);

    69 sub statusCommand(@);

    70 sub createPatchCommand($);

    71 sub diffHeaderFormat();

    72 sub findOriginalFileFromSvn($);

    73 sub generateFileList(\@\@\%);

    74 sub gitConfig($);

    75 sub isModifiedStatus($);

    76 sub isAddedStatus($);

    77 sub isConflictStatus($);

    78 sub statusDescription($$);

    79 sub extractLineRange($);

    80 sub canonicalizePath($);

    81 sub testListForChangeLog(@);

    82 sub get_function_line_ranges($$);

    83 sub get_function_line_ranges_for_c($$);

    84 sub get_function_line_ranges_for_java($$);

    85 sub method_decl_to_selector($);

    86 sub processPaths(\@);

    87 sub reviewerAndDescriptionForGitCommit($);

    88 

    89 # Project time zone for Cupertino, CA, US

    90 my $changeLogTimeZone = "PST8PDT";

    91 

    92 my $gitCommit = 0;

    93 my $gitReviewer = "";

    94 my $openChangeLogs = 0;

    95 my $showHelp = 0;

    96 my $spewDiff = $ENV{"PREPARE_CHANGELOG_DIFF"};

    97 my $updateChangeLogs = 1;

    98 my $parseOptionsResult =

    99     GetOptions("diff|d!" => \$spewDiff,

   100                "git-commit:s" => \$gitCommit,

   101                "git-reviewer:s" => \$gitReviewer,

   102                "help|h!" => \$showHelp,

   103                "open|o!" => \$openChangeLogs,

   104                "update!" => \$updateChangeLogs);

   105 if (!$parseOptionsResult || $showHelp) {

   106     print STDERR basename($0) . " [-d|--diff] [-h|--help] [-o|--open] [--git-commit=<committish>] [--git-reviewer=<name>] [svndir1 [svndir2 ...]]\n";

   107     print STDERR "  -d|--diff      Spew diff to stdout when running\n";

   108     print STDERR "  --git-commit   Populate the ChangeLogs from the specified git commit\n";

   109     print STDERR "  --git-reviewer When populating the ChangeLogs from a git commit claim that the spcified name reviewed the change.\n";

   110     print STDERR "                 This option is useful when the git commit lacks a Signed-Off-By: line\n";

   111     print STDERR "  -h|--help      Show this help message\n";

   112     print STDERR "  -o|--open      Open ChangeLogs in an editor when done\n";

   113     print STDERR "  --[no-]update  Update ChangeLogs from svn before adding entry (default: update)\n";

   114     exit 1;

   115 }

   116 

   117 my %paths = processPaths(@ARGV);

   118 

   119 my $isGit = isGitDirectory(firstDirectoryOrCwd());

   120 my $isSVN = isSVNDirectory(firstDirectoryOrCwd());

   121 

   122 $isSVN || $isGit || die "Couldn't determine your version control system.";

   123 

   124 # Find the list of modified files

   125 my @changed_files;

   126 my $changed_files_string;

   127 my %changed_line_ranges;

   128 my %function_lists;

   129 my @conflict_files;

   130 

   131 my $SVN = "svn";

   132 my $GIT = "git";

   133 

   134 my %supportedTestExtensions = map { $_ => 1 } qw(html shtml svg xml xhtml pl php);

   135 my @addedRegressionTests = ();

   136 my $didChangeRegressionTests = 0;

   137 

   138 generateFileList(@changed_files, @conflict_files, %function_lists);

   139 

   140 if (!@changed_files && !@conflict_files || !%function_lists) {

   141     print STDERR "  No changes found.\n";

   142     exit 1;

   143 }

   144 

   145 if (@conflict_files) {

   146     print STDERR "  The following files have conflicts. Run prepare-ChangeLog again after fixing the conflicts:\n";

   147     print STDERR join("\n", @conflict_files), "\n";

   148     exit 1;

   149 }

   150 

   151 if (@changed_files) {

   152     $changed_files_string = "'" . join ("' '", @changed_files) . "'";

   153 

   154     # For each file, build a list of modified lines.

   155     # Use line numbers from the "after" side of each diff.

   156     print STDERR "  Reviewing diff to determine which lines changed.\n";

   157     my $file;

   158     open DIFF, "-|", diffCommand(@changed_files) or die "The diff failed: $!.\n";

   159     while (<DIFF>) {

   160         $file = makeFilePathRelative($1) if $_ =~ diffHeaderFormat();

   161         if (defined $file) {

   162             my ($start, $end) = extractLineRange($_);

   163             if ($start >= 0 && $end >= 0) {

   164                 push @{$changed_line_ranges{$file}}, [ $start, $end ];

   165             } elsif (/DO_NOT_COMMIT/) {

   166                 print STDERR "WARNING: file $file contains the string DO_NOT_COMMIT, line $.\n";

   167             }

   168         }

   169     }

   170     close DIFF;

   171 }

   172 

   173 # For each source file, convert line range to function list.

   174 if (%changed_line_ranges) {

   175     print STDERR "  Extracting affected function names from source files.\n";

   176     foreach my $file (keys %changed_line_ranges) {

   177         # Only look for function names in .c files.

   178         next unless $file =~ /\.(c|cpp|m|mm|h|java)/;

   179     

   180         # Find all the functions in the file.

   181         open SOURCE, $file or next;

   182         my @function_ranges = get_function_line_ranges(\*SOURCE, $file);

   183         close SOURCE;

   184     

   185         # Find all the modified functions.

   186         my @functions;

   187         my %saw_function;

   188         my @change_ranges = (@{$changed_line_ranges{$file}}, []);

   189         my @change_range = (0, 0);

   190         FUNCTION: foreach my $function_range_ref (@function_ranges) {

   191             my @function_range = @$function_range_ref;

   192     

   193             # Advance to successive change ranges.

   194             for (;; @change_range = @{shift @change_ranges}) {

   195                 last FUNCTION unless @change_range;

   196     

   197                 # If past this function, move on to the next one.

   198                 next FUNCTION if $change_range[0] > $function_range[1];

   199     

   200                 # If an overlap with this function range, record the function name.

   201                 if ($change_range[1] >= $function_range[0]

   202                     and $change_range[0] <= $function_range[1]) {

   203                     if (!$saw_function{$function_range[2]}) {

   204                         $saw_function{$function_range[2]} = 1;

   205                         push @functions, $function_range[2];

   206                     }

   207                     next FUNCTION;

   208                 }

   209             }

   210         }

   211     

   212         # Format the list of functions now.

   213 

   214         if (@functions) {

   215             $function_lists{$file} = "" if !defined $function_lists{$file};

   216             $function_lists{$file} .= "\n        (" . join("):\n        (", @functions) . "):";

   217         }

   218     }

   219 }

   220 

   221 # Get some parameters for the ChangeLog we are about to write.

   222 my $date = changeLogDate($changeLogTimeZone);

   223 my $name = $ENV{CHANGE_LOG_NAME}

   224   || $ENV{REAL_NAME}

   225   || gitConfig("user.name")

   226   || (split /\s*,\s*/, (getpwuid $<)[6])[0]

   227   || "set REAL_NAME environment variable";

   228 my $email_address = $ENV{CHANGE_LOG_EMAIL_ADDRESS}

   229   || $ENV{EMAIL_ADDRESS}

   230   || gitConfig("user.email")

   231   || "set EMAIL_ADDRESS environment variable";

   232 

   233 if ($gitCommit) {

   234     $name = `$GIT log --max-count=1 --pretty=\"format:%an\" \"$gitCommit\"`;

   235     $email_address = `$GIT log --max-count=1 --pretty=\"format:%ae\" \"$gitCommit\"`;

   236 }

   237 

   238 # Remove trailing parenthesized notes from user name (bit of hack).

   239 $name =~ s/\(.*?\)\s*$//g;

   240 

   241 # Find the change logs.

   242 my %has_log;

   243 my %files;

   244 foreach my $file (sort keys %function_lists) {

   245     my $prefix = $file;

   246     my $has_log = 0;

   247     while ($prefix) {

   248         $prefix =~ s-/[^/]+/?$-/- or $prefix = "";

   249         $has_log = $has_log{$prefix};

   250         if (!defined $has_log) {

   251             $has_log = -f "${prefix}ChangeLog";

   252             $has_log{$prefix} = $has_log;

   253         }

   254         last if $has_log;

   255     }

   256     if (!$has_log) {

   257         print STDERR "No ChangeLog found for $file.\n";

   258     } else {

   259         push @{$files{$prefix}}, $file;

   260     }

   261 }

   262 

   263 # Get the latest ChangeLog files from svn.

   264 my $logs = "";

   265 foreach my $prefix (sort keys %files) {

   266     $logs .= " ${prefix}ChangeLog";

   267 }

   268 

   269 if ($logs && $updateChangeLogs && $isSVN) {

   270     print STDERR "  Running 'svn update' to update ChangeLog files.\n";

   271     open ERRORS, "$SVN update -q$logs |" or die "The svn update of ChangeLog files failed: $!.\n";

   272     print STDERR "    $_" while <ERRORS>;

   273     close ERRORS;

   274 }

   275 

   276 # Write out a new ChangeLog file.

   277 foreach my $prefix (sort keys %files) {

   278     print STDERR "  Editing the ${prefix}ChangeLog file.\n";

   279     open OLD_CHANGE_LOG, "${prefix}ChangeLog" or die "Could not open ${prefix}ChangeLog file: $!.\n";

   280     # It's less efficient to read the whole thing into memory than it would be

   281     # to read it while we prepend to it later, but I like doing this part first.

   282     my @old_change_log = <OLD_CHANGE_LOG>;

   283     close OLD_CHANGE_LOG;

   284     open CHANGE_LOG, "> ${prefix}ChangeLog" or die "Could not write ${prefix}ChangeLog\n.";

   285     print CHANGE_LOG "$date  $name  <$email_address>\n\n";

   286 

   287     my ($reviewer, $description) = reviewerAndDescriptionForGitCommit($gitCommit) if $gitCommit;

   288     $reviewer = "NOBODY (OO" . "PS!)" if !$reviewer;

   289 

   290     print CHANGE_LOG "        Reviewed by $reviewer.\n\n";

   291     print CHANGE_LOG $description . "\n" if $description;

   292 

   293     if ($prefix =~ m/WebCore/ || `pwd` =~ m/WebCore/) {

   294         if ($didChangeRegressionTests) {

   295             print CHANGE_LOG testListForChangeLog(sort @addedRegressionTests);

   296         } else {

   297             print CHANGE_LOG "        WARNING: NO TEST CASES ADDED OR CHANGED\n\n";

   298         }

   299     }

   300 

   301     foreach my $file (sort @{$files{$prefix}}) {

   302         my $file_stem = substr $file, length $prefix;

   303         print CHANGE_LOG "        * $file_stem:$function_lists{$file}\n";

   304     }

   305     print CHANGE_LOG "\n", @old_change_log;

   306     close CHANGE_LOG;

   307 }

   308 

   309 # Write out another diff.

   310 if ($spewDiff && @changed_files) {

   311     print STDERR "  Running diff to help you write the ChangeLog entries.\n";

   312     local $/ = undef; # local slurp mode

   313     open DIFF, "-|", createPatchCommand($changed_files_string) or die "The diff failed: $!.\n";

   314     print <DIFF>;

   315     close DIFF;

   316 }

   317 

   318 # Open ChangeLogs.

   319 if ($openChangeLogs && $logs) {

   320     print STDERR "  Opening the edited ChangeLog files.\n";

   321     my $editor = $ENV{"CHANGE_LOG_EDIT_APPLICATION"};

   322     if ($editor) {

   323         system "open -a '$editor'$logs";

   324     } else {

   325         system "open -e$logs";

   326     }

   327 }

   328 

   329 # Done.

   330 exit;

   331 

   332 sub canonicalizePath($)

   333 {

   334     my ($file) = @_;

   335 

   336     # Remove extra slashes and '.' directories in path

   337     $file = File::Spec->canonpath($file);

   338 

   339     # Remove '..' directories in path

   340     my @dirs = ();

   341     foreach my $dir (File::Spec->splitdir($file)) {

   342         if ($dir eq '..' && $#dirs >= 0 && $dirs[$#dirs] ne '..') {

   343             pop(@dirs);

   344         } else {

   345             push(@dirs, $dir);

   346         }

   347     }

   348     return ($#dirs >= 0) ? File::Spec->catdir(@dirs) : ".";

   349 }

   350 

   351 sub changeLogDate($)

   352 {

   353     my ($timeZone) = @_;

   354     my $savedTimeZone = $ENV{'TZ'};

   355     # Set TZ temporarily so that localtime() is in that time zone

   356     $ENV{'TZ'} = $timeZone;

   357     my $date = strftime("%Y-%m-%d", localtime());

   358     if (defined $savedTimeZone) {

   359          $ENV{'TZ'} = $savedTimeZone;

   360     } else {

   361          delete $ENV{'TZ'};

   362     }

   363     return $date;

   364 }

   365 

   366 sub get_function_line_ranges($$)

   367 {

   368     my ($file_handle, $file_name) = @_;

   369 

   370     if ($file_name =~ /\.(c|cpp|m|mm|h)$/) {

   371         return get_function_line_ranges_for_c ($file_handle, $file_name);

   372     } elsif ($file_name =~ /\.java$/) {

   373         return get_function_line_ranges_for_java ($file_handle, $file_name);

   374     }

   375     return ();

   376 }

   377 

   378 

   379 sub method_decl_to_selector($)

   380 {

   381     (my $method_decl) = @_;

   382 

   383     $_ = $method_decl;

   384 

   385     if ((my $comment_stripped) = m-([^/]*)(//|/*).*-) {

   386         $_ = $comment_stripped;

   387     }

   388 

   389     s/,\s*...//;

   390 

   391     if (/:/) {

   392         my @components = split /:/;

   393         pop @components if (scalar @components > 1);

   394         $_ = (join ':', map {s/.*[^[:word:]]//; scalar $_;} @components) . ':';

   395     } else {

   396         s/\s*$//;

   397         s/.*[^[:word:]]//;

   398     }

   399 

   400     return $_;

   401 }

   402 

   403 

   404 

   405 # Read a file and get all the line ranges of the things that look like C functions.

   406 # A function name is the last word before an open parenthesis before the outer

   407 # level open brace. A function starts at the first character after the last close

   408 # brace or semicolon before the function name and ends at the close brace.

   409 # Comment handling is simple-minded but will work for all but pathological cases.

   410 #

   411 # Result is a list of triples: [ start_line, end_line, function_name ].

   412 

   413 sub get_function_line_ranges_for_c($$)

   414 {

   415     my ($file_handle, $file_name) = @_;

   416 

   417     my @ranges;

   418 

   419     my $in_comment = 0;

   420     my $in_macro = 0;

   421     my $in_method_declaration = 0;

   422     my $in_parentheses = 0;

   423     my $in_braces = 0;

   424     my $brace_start = 0;

   425     my $brace_end = 0;

   426     my $skip_til_brace_or_semicolon = 0;

   427 

   428     my $word = "";

   429     my $interface_name = "";

   430 

   431     my $potential_method_char = "";

   432     my $potential_method_spec = "";

   433 

   434     my $potential_start = 0;

   435     my $potential_name = "";

   436 

   437     my $start = 0;

   438     my $name = "";

   439 

   440     my $next_word_could_be_namespace = 0;

   441     my $potential_namespace = "";

   442     my @namespaces;

   443 

   444     while (<$file_handle>) {

   445         # Handle continued multi-line comment.

   446         if ($in_comment) {

   447             next unless s-.*\*/--;

   448             $in_comment = 0;

   449         }

   450 

   451         # Handle continued macro.

   452         if ($in_macro) {

   453             $in_macro = 0 unless /\\$/;

   454             next;

   455         }

   456 

   457         # Handle start of macro (or any preprocessor directive).

   458         if (/^\s*\#/) {

   459             $in_macro = 1 if /^([^\\]|\\.)*\\$/;

   460             next;

   461         }

   462 

   463         # Handle comments and quoted text.

   464         while (m-(/\*|//|\'|\")-) { # \' and \" keep emacs perl mode happy

   465             my $match = $1;

   466             if ($match eq "/*") {

   467                 if (!s-/\*.*?\*/--) {

   468                     s-/\*.*--;

   469                     $in_comment = 1;

   470                 }

   471             } elsif ($match eq "//") {

   472                 s-//.*--;

   473             } else { # ' or "

   474                 if (!s-$match([^\\]|\\.)*?$match--) {

   475                     warn "mismatched quotes at line $. in $file_name\n";

   476                     s-$match.*--;

   477                 }

   478             }

   479         }

   480 

   481 

   482         # continued method declaration

   483         if ($in_method_declaration) {

   484               my $original = $_;

   485               my $method_cont = $_;

   486 

   487               chomp $method_cont;

   488               $method_cont =~ s/[;\{].*//;

   489               $potential_method_spec = "${potential_method_spec} ${method_cont}";

   490 

   491               $_ = $original;

   492               if (/;/) {

   493                   $potential_start = 0;

   494                   $potential_method_spec = "";

   495                   $potential_method_char = "";

   496                   $in_method_declaration = 0;

   497                   s/^[^;\{]*//;

   498               } elsif (/{/) {

   499                   my $selector = method_decl_to_selector ($potential_method_spec);

   500                   $potential_name = "${potential_method_char}\[${interface_name} ${selector}\]";

   501                   

   502                   $potential_method_spec = "";

   503                   $potential_method_char = "";

   504                   $in_method_declaration = 0;

   505   

   506                   $_ = $original;

   507                   s/^[^;{]*//;

   508               } elsif (/\@end/) {

   509                   $in_method_declaration = 0;

   510                   $interface_name = "";

   511                   $_ = $original;

   512               } else {

   513                   next;

   514               }

   515         }

   516 

   517         

   518         # start of method declaration

   519         if ((my $method_char, my $method_spec) = m&^([-+])([^0-9;][^;]*);?$&) {

   520             my $original = $_;

   521 

   522             if ($interface_name) {

   523                 chomp $method_spec;

   524                 $method_spec =~ s/\{.*//;

   525 

   526                 $potential_method_char = $method_char;

   527                 $potential_method_spec = $method_spec;

   528                 $potential_start = $.;

   529                 $in_method_declaration = 1;

   530             } else { 

   531                 warn "declaring a method but don't have interface on line $. in $file_name\n";

   532             }

   533             $_ = $original;

   534             if (/\{/) {

   535               my $selector = method_decl_to_selector ($potential_method_spec);

   536               $potential_name = "${potential_method_char}\[${interface_name} ${selector}\]";

   537               

   538               $potential_method_spec = "";

   539               $potential_method_char = "";

   540               $in_method_declaration = 0;

   541               $_ = $original;

   542               s/^[^{]*//;

   543             } elsif (/\@end/) {

   544               $in_method_declaration = 0;

   545               $interface_name = "";

   546               $_ = $original;

   547             } else {

   548               next;

   549             }

   550         }

   551 

   552 

   553         # Find function, interface and method names.

   554         while (m&((?:[[:word:]]+::)*operator(?:[ \t]*\(\)|[^()]*)|[[:word:]:~]+|[(){}:;])|\@(?:implementation|interface|protocol)\s+(\w+)[^{]*&g) {

   555             # interface name

   556             if ($2) {

   557                 $interface_name = $2;

   558                 next;

   559             }

   560 

   561             # Open parenthesis.

   562             if ($1 eq "(") {

   563                 $potential_name = $word unless $in_parentheses || $skip_til_brace_or_semicolon;

   564                 $in_parentheses++;

   565                 next;

   566             }

   567 

   568             # Close parenthesis.

   569             if ($1 eq ")") {

   570                 $in_parentheses--;

   571                 next;

   572             }

   573 

   574             # C++ constructor initializers

   575             if ($1 eq ":") {

   576                   $skip_til_brace_or_semicolon = 1 unless ($in_parentheses || $in_braces);

   577             }

   578 

   579             # Open brace.

   580             if ($1 eq "{") {

   581                 $skip_til_brace_or_semicolon = 0;

   582 

   583                 if ($potential_namespace) {

   584                     push @namespaces, $potential_namespace;

   585                     $potential_namespace = "";

   586                     next;

   587                 }

   588 

   589                 # Promote potential name to real function name at the

   590                 # start of the outer level set of braces (function body?).

   591                 if (!$in_braces and $potential_start) {

   592                     $start = $potential_start;

   593                     $name = $potential_name;

   594                     if (@namespaces && (length($name) < 2 || substr($name,1,1) ne "[")) {

   595                         $name = join ('::', @namespaces, $name);

   596                     }

   597                 }

   598 

   599                 $in_method_declaration = 0;

   600 

   601                 $brace_start = $. if (!$in_braces);

   602                 $in_braces++;

   603                 next;

   604             }

   605 

   606             # Close brace.

   607             if ($1 eq "}") {

   608                 if (!$in_braces && @namespaces) {

   609                     pop @namespaces;

   610                     next;

   611                 }

   612 

   613                 $in_braces--;

   614                 $brace_end = $. if (!$in_braces);

   615 

   616                 # End of an outer level set of braces.

   617                 # This could be a function body.

   618                 if (!$in_braces and $name) {

   619                     push @ranges, [ $start, $., $name ];

   620                     $name = "";

   621                 }

   622 

   623                 $potential_start = 0;

   624                 $potential_name = "";

   625                 next;

   626             }

   627 

   628             # Semicolon.

   629             if ($1 eq ";") {

   630                 $skip_til_brace_or_semicolon = 0;

   631                 $potential_start = 0;

   632                 $potential_name = "";

   633                 $in_method_declaration = 0;

   634                 next;

   635             }

   636 

   637             # Ignore "const" method qualifier.

   638             if ($1 eq "const") {

   639                 next;

   640             }

   641 

   642             if ($1 eq "namespace" || $1 eq "class" || $1 eq "struct") {

   643                 $next_word_could_be_namespace = 1;

   644                 next;

   645             }

   646 

   647             # Word.

   648             $word = $1;

   649             if (!$skip_til_brace_or_semicolon) {

   650                 if ($next_word_could_be_namespace) {

   651                     $potential_namespace = $word;

   652                     $next_word_could_be_namespace = 0;

   653                 } elsif ($potential_namespace) {

   654                     $potential_namespace = "";

   655                 }

   656 

   657                 if (!$in_parentheses) {

   658                     $potential_start = 0;

   659                     $potential_name = "";

   660                 }

   661                 if (!$potential_start) {

   662                     $potential_start = $.;

   663                     $potential_name = "";

   664                 }

   665             }

   666         }

   667     }

   668 

   669     warn "missing close braces in $file_name (probable start at $brace_start)\n" if ($in_braces > 0);

   670     warn "too many close braces in $file_name (probable start at $brace_end)\n" if ($in_braces < 0);

   671 

   672     warn "mismatched parentheses in $file_name\n" if $in_parentheses;

   673 

   674     return @ranges;

   675 }

   676 

   677 

   678 

   679 # Read a file and get all the line ranges of the things that look like Java

   680 # classes, interfaces and methods.

   681 #

   682 # A class or interface name is the word that immediately follows

   683 # `class' or `interface' when followed by an open curly brace and not

   684 # a semicolon. It can appear at the top level, or inside another class

   685 # or interface block, but not inside a function block

   686 #

   687 # A class or interface starts at the first character after the first close

   688 # brace or after the function name and ends at the close brace.

   689 #

   690 # A function name is the last word before an open parenthesis before

   691 # an open brace rather than a semicolon. It can appear at top level or

   692 # inside a class or interface block, but not inside a function block.

   693 #

   694 # A function starts at the first character after the first close

   695 # brace or after the function name and ends at the close brace.

   696 #

   697 # Comment handling is simple-minded but will work for all but pathological cases.

   698 #

   699 # Result is a list of triples: [ start_line, end_line, function_name ].

   700 

   701 sub get_function_line_ranges_for_java($$)

   702 {

   703     my ($file_handle, $file_name) = @_;

   704 

   705     my @current_scopes;

   706 

   707     my @ranges;

   708 

   709     my $in_comment = 0;

   710     my $in_macro = 0;

   711     my $in_parentheses = 0;

   712     my $in_braces = 0;

   713     my $in_non_block_braces = 0;

   714     my $class_or_interface_just_seen = 0;

   715 

   716     my $word = "";

   717 

   718     my $potential_start = 0;

   719     my $potential_name = "";

   720     my $potential_name_is_class_or_interface = 0;

   721 

   722     my $start = 0;

   723     my $name = "";

   724     my $current_name_is_class_or_interface = 0;

   725 

   726     while (<$file_handle>) {

   727         # Handle continued multi-line comment.

   728         if ($in_comment) {

   729             next unless s-.*\*/--;

   730             $in_comment = 0;

   731         }

   732 

   733         # Handle continued macro.

   734         if ($in_macro) {

   735             $in_macro = 0 unless /\\$/;

   736             next;

   737         }

   738 

   739         # Handle start of macro (or any preprocessor directive).

   740         if (/^\s*\#/) {

   741             $in_macro = 1 if /^([^\\]|\\.)*\\$/;

   742             next;

   743         }

   744 

   745         # Handle comments and quoted text.

   746         while (m-(/\*|//|\'|\")-) { # \' and \" keep emacs perl mode happy

   747             my $match = $1;

   748             if ($match eq "/*") {

   749                 if (!s-/\*.*?\*/--) {

   750                     s-/\*.*--;

   751                     $in_comment = 1;

   752                 }

   753             } elsif ($match eq "//") {

   754                 s-//.*--;

   755             } else { # ' or "

   756                 if (!s-$match([^\\]|\\.)*?$match--) {

   757                     warn "mismatched quotes at line $. in $file_name\n";

   758                     s-$match.*--;

   759                 }

   760             }

   761         }

   762 

   763         # Find function names.

   764         while (m-(\w+|[(){};])-g) {

   765             # Open parenthesis.

   766             if ($1 eq "(") {

   767                 if (!$in_parentheses) {

   768                     $potential_name = $word;

   769                     $potential_name_is_class_or_interface = 0;

   770                 }

   771                 $in_parentheses++;

   772                 next;

   773             }

   774 

   775             # Close parenthesis.

   776             if ($1 eq ")") {

   777                 $in_parentheses--;

   778                 next;

   779             }

   780 

   781             # Open brace.

   782             if ($1 eq "{") {

   783                 # Promote potential name to real function name at the

   784                 # start of the outer level set of braces (function/class/interface body?).

   785                 if (!$in_non_block_braces

   786                     and (!$in_braces or $current_name_is_class_or_interface)

   787                     and $potential_start) {

   788                     if ($name) {

   789                           push @ranges, [ $start, ($. - 1),

   790                                           join ('.', @current_scopes) ];

   791                     }

   792 

   793 

   794                     $current_name_is_class_or_interface = $potential_name_is_class_or_interface;

   795 

   796                     $start = $potential_start;

   797                     $name = $potential_name;

   798 

   799                     push (@current_scopes, $name);

   800                 } else {

   801                     $in_non_block_braces++;

   802                 }

   803 

   804                 $potential_name = "";

   805                 $potential_start = 0;

   806 

   807                 $in_braces++;

   808                 next;

   809             }

   810 

   811             # Close brace.

   812             if ($1 eq "}") {

   813                 $in_braces--;

   814 

   815                 # End of an outer level set of braces.

   816                 # This could be a function body.

   817                 if (!$in_non_block_braces) {

   818                     if ($name) {

   819                         push @ranges, [ $start, $.,

   820                                         join ('.', @current_scopes) ];

   821 

   822                         pop (@current_scopes);

   823 

   824                         if (@current_scopes) {

   825                             $current_name_is_class_or_interface = 1;

   826 

   827                             $start = $. + 1;

   828                             $name =  $current_scopes[$#current_scopes-1];

   829                         } else {

   830                             $current_name_is_class_or_interface = 0;

   831                             $start = 0;

   832                             $name =  "";

   833                         }

   834                     }

   835                 } else {

   836                     $in_non_block_braces-- if $in_non_block_braces;

   837                 }

   838 

   839                 $potential_start = 0;

   840                 $potential_name = "";

   841                 next;

   842             }

   843 

   844             # Semicolon.

   845             if ($1 eq ";") {

   846                 $potential_start = 0;

   847                 $potential_name = "";

   848                 next;

   849             }

   850 

   851             if ($1 eq "class" or $1 eq "interface") {

   852                 $class_or_interface_just_seen = 1;

   853                 next;

   854             }

   855 

   856             # Word.

   857             $word = $1;

   858             if (!$in_parentheses) {

   859                 if ($class_or_interface_just_seen) {

   860                     $potential_name = $word;

   861                     $potential_start = $.;

   862                     $class_or_interface_just_seen = 0;

   863                     $potential_name_is_class_or_interface = 1;

   864                     next;

   865                 }

   866             }

   867             if (!$potential_start) {

   868                 $potential_start = $.;

   869                 $potential_name = "";

   870             }

   871             $class_or_interface_just_seen = 0;

   872         }

   873     }

   874 

   875     warn "mismatched braces in $file_name\n" if $in_braces;

   876     warn "mismatched parentheses in $file_name\n" if $in_parentheses;

   877 

   878     return @ranges;

   879 }

   880 

   881 sub processPaths(\@)

   882 {

   883     my ($paths) = @_;

   884     return ("." => 1) if (!@{$paths});

   885 

   886     my %result = ();

   887 

   888     for my $file (@{$paths}) {

   889         die "can't handle absolute paths like \"$file\"\n" if File::Spec->file_name_is_absolute($file);

   890         die "can't handle empty string path\n" if $file eq "";

   891         die "can't handle path with single quote in the name like \"$file\"\n" if $file =~ /'/; # ' (keep Xcode syntax highlighting happy)

   892 

   893         my $untouchedFile = $file;

   894 

   895         $file = canonicalizePath($file);

   896 

   897         die "can't handle paths with .. like \"$untouchedFile\"\n" if $file =~ m|/\.\./|;

   898 

   899         $result{$file} = 1;

   900     }

   901 

   902     return ("." => 1) if ($result{"."});

   903 

   904     # Remove any paths that also have a parent listed.

   905     for my $path (keys %result) {

   906         for (my $parent = dirname($path); $parent ne '.'; $parent = dirname($parent)) {

   907             if ($result{$parent}) {

   908                 delete $result{$path};

   909                 last;

   910             }

   911         }

   912     }

   913 

   914     return %result;

   915 }

   916 

   917 sub diffFromToString()

   918 {

   919     return "" if $isSVN;

   920     return $gitCommit if $gitCommit =~ m/.+\.\..+/;

   921     return "\"$gitCommit^\" \"$gitCommit\"" if $gitCommit;

   922     return "HEAD" if $isGit;

   923 }

   924 

   925 sub diffCommand(@)

   926 {

   927     my @paths = @_;

   928 

   929     my $pathsString = "'" . join("' '", @paths) . "'"; 

   930 

   931     my $command;

   932     if ($isSVN) {

   933         $command = "$SVN diff --diff-cmd diff -x -N $pathsString";

   934     } elsif ($isGit) {

   935         $command = "$GIT diff " . diffFromToString();

   936         $command .= " -- $pathsString" unless $gitCommit;

   937     }

   938 

   939     return $command;

   940 }

   941 

   942 sub statusCommand(@)

   943 {

   944     my @files = @_;

   945 

   946     my $filesString = "'" . join ("' '", @files) . "'";

   947     my $command;

   948     if ($isSVN) {

   949         $command = "$SVN stat $filesString";

   950     } elsif ($isGit) {

   951         $command = "$GIT diff -r --name-status -C -C -M " . diffFromToString();

   952         $command .= " -- $filesString" unless $gitCommit;

   953     }

   954 

   955     return "$command 2> /dev/stdout";

   956 }

   957 

   958 sub createPatchCommand($)

   959 {

   960     my ($changedFilesString) = @_;

   961 

   962     my $command;

   963     if ($isSVN) {

   964         $command = "'$FindBin::Bin/svn-create-patch' $changedFilesString";

   965     } elsif ($isGit) {

   966         $command = "$GIT diff -C -C -M " . diffFromToString();

   967         $command .= " -- $changedFilesString" unless $gitCommit;

   968     }

   969 

   970     return $command;

   971 }

   972 

   973 sub diffHeaderFormat()

   974 {

   975     return qr/^Index: (\S+)$/ if $isSVN;

   976     return qr/^diff --git a\/.+ b\/(.+)$/ if $isGit;

   977 }

   978 

   979 sub findOriginalFileFromSvn($)

   980 {

   981     my ($file) = @_;

   982     my $baseUrl;

   983     open INFO, "$SVN info . |" or die;

   984     while (<INFO>) {

   985         if (/^URL: (.+)/) {

   986             $baseUrl = $1;

   987             last;

   988         }

   989     }

   990     close INFO;

   991     my $sourceFile;

   992     open INFO, "$SVN info '$file' |" or die;

   993     while (<INFO>) {

   994         if (/^Copied From URL: (.+)/) {

   995             $sourceFile = File::Spec->abs2rel($1, $baseUrl);

   996             last;

   997         }

   998     }

   999     close INFO;

  1000     return $sourceFile;

  1001 }

  1002 

  1003 sub generateFileList(\@\@\%)

  1004 {

  1005     my ($changedFiles, $conflictFiles, $functionLists) = @_;

  1006     print STDERR "  Running status to find changed, added, or removed files.\n";

  1007     open STAT, "-|", statusCommand(keys %paths) or die "The status failed: $!.\n";

  1008     my $inGitCommitSection = 0;

  1009     while (<STAT>) {

  1010         my $status;

  1011         my $original;

  1012         my $file;

  1013 

  1014         if ($isSVN) {

  1015             if (/^([ACDMR]).{5} (.+)$/) {

  1016                 $status = $1;

  1017                 $file = $2;

  1018                 $original = findOriginalFileFromSvn($file) if substr($_, 3, 1) eq "+";

  1019             } else {

  1020                 print;  # error output from svn stat

  1021             }

  1022         } elsif ($isGit) {

  1023             if (/^([ADM])\t(.+)$/) {

  1024                 $status = $1;

  1025                 $file = $2;

  1026             } elsif (/^([CR])[0-9]{1,3}\t([^\t]+)\t([^\t\n]+)$/) { # for example: R90%    newfile    oldfile

  1027                 $status = $1;

  1028                 $original = $2;

  1029                 $file = $3;

  1030             } else {

  1031                 print;  # error output from git diff

  1032             }

  1033         }

  1034 

  1035         next unless $status;

  1036 

  1037         $file = makeFilePathRelative($file);

  1038 

  1039         if (isModifiedStatus($status) || isAddedStatus($status)) {

  1040             my @components = File::Spec->splitdir($file);

  1041             if ($components[0] eq "LayoutTests") {

  1042                 $didChangeRegressionTests = 1;

  1043                 push @addedRegressionTests, $file

  1044                     if isAddedStatus($status)

  1045                        && $file =~ /\.([a-zA-Z]+)$/

  1046                        && $supportedTestExtensions{lc($1)}

  1047                        && !scalar(grep(/^resources$/i, @components));

  1048             }

  1049             push @{$changedFiles}, $file if $components[$#components] ne "ChangeLog";

  1050         } elsif (isConflictStatus($status)) {

  1051             push @{$conflictFiles}, $file;

  1052         }

  1053         my $description = statusDescription($status, $original);

  1054         $functionLists->{$file} = $description if defined $description;

  1055     }

  1056     close STAT;

  1057 }

  1058 

  1059 sub gitConfig($)

  1060 {

  1061     return unless $isGit;

  1062 

  1063     my ($config) = @_;

  1064 

  1065     my $result = `$GIT config $config`;

  1066     chomp $result;

  1067     return $result;

  1068 }

  1069 

  1070 sub isModifiedStatus($)

  1071 {

  1072     my ($status) = @_;

  1073 

  1074     my %statusCodes = (

  1075         "M" => 1,

  1076     );

  1077 

  1078     return $statusCodes{$status};

  1079 }

  1080 

  1081 sub isAddedStatus($)

  1082 {

  1083     my ($status) = @_;

  1084 

  1085     my %statusCodes = (

  1086         "A" => 1,

  1087         "C" => $isGit,

  1088         "R" => 1,

  1089     );

  1090 

  1091     return $statusCodes{$status};

  1092 }

  1093 

  1094 sub isConflictStatus($)

  1095 {

  1096     my ($status) = @_;

  1097 

  1098     my %svn = (

  1099         "C" => 1,

  1100     );

  1101 

  1102     my %git = (

  1103         "U" => 1,

  1104     );

  1105 

  1106     return 0 if $gitCommit; # an existing commit cannot have conflicts

  1107     return $svn{$status} if $isSVN;

  1108     return $git{$status} if $isGit;

  1109 }

  1110 

  1111 sub statusDescription($$)

  1112 {

  1113     my ($status, $original) = @_;

  1114 

  1115     my %svn = (

  1116         "A" => defined $original ? " Copied from \%s." : " Added.",

  1117         "D" => " Removed.",

  1118         "M" => "",

  1119         "R" => defined $original ? " Replaced with \%s." : " Replaced.",

  1120     );

  1121 

  1122     my %git = %svn;

  1123     $git{"A"} = " Added.";

  1124     $git{"C"} = " Copied from \%s.";

  1125     $git{"R"} = " Renamed from \%s.";

  1126 

  1127     return sprintf($svn{$status}, $original) if $isSVN && exists $svn{$status};

  1128     return sprintf($git{$status}, $original) if $isGit && exists $git{$status};

  1129     return undef;

  1130 }

  1131 

  1132 sub extractLineRange($)

  1133 {

  1134     my ($string) = @_;

  1135