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