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