Reviewed by Darin.
[WebKit-https.git] / WebKitTools / Scripts / prepare-ChangeLog
1 #!/usr/bin/perl -w
2 # -*- Mode: perl; indent-tabs-mode: nil; c-basic-offset: 2  -*-
3
4 #
5 #  Copyright (C) 2000, 2001 Eazel, Inc.
6 #  Copyright (C) 2002, 2003, 2004, 2005, 2006 Apple Computer, Inc.
7 #
8 #  prepare-ChangeLog is free software; you can redistribute it and/or
9 #  modify it under the terms of the GNU General Public
10 #  License as published by the Free Software Foundation; either
11 #  version 2 of the License, or (at your option) any later version.
12 #
13 #  prepare-ChangeLog is distributed in the hope that it will be useful,
14 #  but WITHOUT ANY WARRANTY; without even the implied warranty of
15 #  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
16 #  General Public License for more details.
17 #
18 #  You should have received a copy of the GNU General Public
19 #  License along with this program; if not, write to the Free
20 #  Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
21 #
22
23
24 # Perl script to create a ChangeLog entry with names of files
25 # and functions from a diff.
26 #
27 # Darin Adler <darin@bentspoon.com>, started 20 April 2000
28 # Java support added by Maciej Stachowiak <mjs@eazel.com>
29 # Objective-C, C++ and Objective-C++ support added by Maciej Stachowiak <mjs@apple.com>
30
31
32 #
33 # TODO:
34 #   List functions that have been removed too.
35 #   Decide what a good logical order is for the changed files
36 #     other than a normal text "sort" (top level first?)
37 #     (group directories?) (.h before .c?)
38 #   Handle yacc source files too (other languages?).
39 #   Help merge when there are ChangeLog conflicts or if there's
40 #     already a partly written ChangeLog entry.
41 #   Add command line option to put the ChangeLog into a separate
42 #     file or just spew it out stdout.
43 #   Add SVN version numbers for commit (can't do that until
44 #     the changes are checked in, though).
45 #   Work around diff stupidity where deleting a function that starts
46 #     with a comment makes diff think that the following function
47 #     has been changed (if the following function starts with a comment
48 #     with the same first line, such as /**)
49 #   Work around diff stupidity where deleting an entire function and
50 #     the blank lines before it makes diff think you've changed the
51 #     previous function.
52
53 use strict;
54 use warnings;
55
56 use File::Basename;
57 use File::Spec;
58 use File::Temp;
59 use FindBin;
60 use Getopt::Long;
61
62 sub canonicalizePath($);
63 sub get_function_line_ranges($$);
64 sub get_function_line_ranges_for_c($$);
65 sub get_function_line_ranges_for_java($$);
66 sub method_decl_to_selector($);
67 sub processPaths(\@);
68
69 my $openChangeLogs = 0;
70 my $showHelp = 0;
71 my $updateChangeLogs = 1;
72 my $spewDiff = $ENV{"PREPARE_CHANGELOG_DIFF"};
73 my $parseOptionsResult =
74     GetOptions("diff|d!" => \$spewDiff,
75                "help|h!" => \$showHelp,
76                "open|o!" => \$openChangeLogs,
77                "update!" => \$updateChangeLogs);
78 if (!$parseOptionsResult || $showHelp)
79   {
80     print STDERR basename($0) . " [-d|--diff] [-h|--help] [-o|--open] [svndir1 [svndir2 ...]]\n";
81     print STDERR "  -d|--diff      Spew diff to stdout when running\n";
82     print STDERR "  -h|--help      Show this help message\n";
83     print STDERR "  -o|--open      Open ChangeLogs in an editor when done\n";
84     print STDERR "  --[no-]update  Update ChangeLogs from svn before adding entry (default: update)\n";
85     exit 1;
86   }
87
88 my %paths = processPaths(@ARGV);
89
90 # Find the list of modified files
91 my @changed_files;
92 my $changed_files_string;
93 my %changed_line_ranges;
94 my %function_lists;
95 my @conflict_files;
96
97 my $SVN = "svn";
98
99 my %statusDescription = (
100     "A" => " Added.",
101     "D" => " Removed.",
102     "M" => "",
103     "R" => " Replaced.",
104 );
105
106 my $changedLayoutTests = 0;
107
108 my $DIFFOUT = new File::Temp(TEMPLATE => basename($0) . "-XXXXXXXX",
109                              DIR => ($ENV{'TMPDIR'} || "/tmp"),
110                              SUFFIX => ".diff");
111 my $diffTempFile = $DIFFOUT->filename();
112 my @diffFiles;
113
114 print STDERR "  Running 'svn diff' to find changed, added, or removed files.\n";
115 open SVNDIFF, "$SVN diff --diff-cmd diff -x -N '" . join("' '", keys %paths) . "'|"
116     or die "The svn diff failed: $!.\n";
117 while (<SVNDIFF>)
118   {
119     print $DIFFOUT $_;
120     if (/^Index: (.+)$/)
121       {
122         push @diffFiles, $1;
123       }
124   }
125 close SVNDIFF;
126 close $DIFFOUT;
127
128 if (@diffFiles)
129   {
130     my $diffFilesString = "'" . join ("' '", @diffFiles) . "'";
131     print STDERR "  Running 'svn stat' on changed, added, or removed files.\n";
132     open SVNSTAT, "$SVN stat $diffFilesString 2> /dev/stdout |" or die "The svn stat failed: $!.\n";
133     while(<SVNSTAT>)
134       {
135         if (/^([A-Z]).+\s+(.+)$/)
136           {
137               my $status = $1;
138               my $file = $2;
139               if ($status eq "A" || $status eq "M")
140                 {
141                   my @components = File::Spec->splitdir($file);
142                   $changedLayoutTests = 1 if $components[0] eq "LayoutTests";
143                   push @changed_files, $file if $components[$#components] ne "ChangeLog";
144                 }
145               push @conflict_files, $file if $status eq "C";
146               $function_lists{$file} = $statusDescription{$status} if exists $statusDescription{$status};
147           }
148         else
149           {
150             print;  # error output from svn stat
151           }
152       }
153     close SVNSTAT;
154   }
155
156 if (!@diffFiles || !%function_lists)
157   {
158     print STDERR "  No changes found.\n";
159     exit 1;
160   }
161
162 if (@conflict_files)
163   {
164     print STDERR "  The following files have conflicts. Run prepare-ChangeLog again after fixing the conflicts:\n";
165     print STDERR join("\n", @conflict_files), "\n";
166     exit 1;
167   }
168
169 if (@changed_files)
170   {
171     $changed_files_string = "'" . join ("' '", @changed_files) . "'";
172
173     # For each file, build a list of modified lines.
174     # Use line numbers from the "after" side of each diff.
175     print STDERR "  Reviewing 'svn diff' to determine which lines changed.\n";
176     my $file;
177     open DIFF, "< $diffTempFile" or die "Opening $diffTempFile failed: $!.\n";
178     while (<DIFF>)
179       {
180         $file = $1 if /^Index: (\S+)$/;
181         if (defined $file) {
182           if (/^\d+(,\d+)?[acd](\d+)(,(\d+))?/) {
183             push @{$changed_line_ranges{$file}}, [ $2, $4 || $2 ];
184           } elsif (/DO_NOT_COMMIT/) {
185             print STDERR "WARNING: file $file contains the string DO_NOT_COMMIT, line $.\n";
186           }
187         }
188       }
189     close DIFF;
190   }
191
192 # For each source file, convert line range to function list.
193 if (%changed_line_ranges)
194   {
195     print STDERR "  Extracting affected function names from source files.\n";
196     foreach my $file (keys %changed_line_ranges)
197       {
198         # Only look for function names in .c files.
199         next unless $file =~ /\.(c|cpp|m|mm|h|java)/;
200     
201         # Find all the functions in the file.
202         open SOURCE, $file or next;
203         my @function_ranges = get_function_line_ranges(\*SOURCE, $file);
204         close SOURCE;
205     
206         # Find all the modified functions.
207         my @functions;
208         my %saw_function;
209         my @change_ranges = (@{$changed_line_ranges{$file}}, []);
210         my @change_range = (0, 0);
211         FUNCTION: foreach my $function_range_ref (@function_ranges)
212           {
213             my @function_range = @$function_range_ref;
214     
215             # Advance to successive change ranges.
216             for (;; @change_range = @{shift @change_ranges})
217               {
218                 last FUNCTION unless @change_range;
219     
220                 # If past this function, move on to the next one.
221                 next FUNCTION if $change_range[0] > $function_range[1];
222     
223                 # If an overlap with this function range, record the function name.
224                 if ($change_range[1] >= $function_range[0]
225                     and $change_range[0] <= $function_range[1])
226                   {
227                     if (!$saw_function{$function_range[2]})
228                       {
229                         $saw_function{$function_range[2]} = 1;
230                         push @functions, $function_range[2];
231                       }
232                     next FUNCTION;
233                   }
234               }
235           }
236     
237         # Format the list of functions now.
238
239         if (@functions) {
240             $function_lists{$file} = "" if !defined $function_lists{$file};
241             $function_lists{$file} .= "\n        (" . join("):\n        (", @functions) . "):";
242         }
243       }
244   }
245
246 # Get some parameters for the ChangeLog we are about to write.
247 my $date = sprintf "%d-%02d-%02d",
248   1900 + (localtime $^T)[5], # year
249   1 + (localtime $^T)[4], # month
250   (localtime $^T)[3]; # day within month
251 my $name = $ENV{CHANGE_LOG_NAME}
252   || $ENV{REAL_NAME}
253   || (getpwuid $<)[6]
254   || "set REAL_NAME environment variable";
255 my $email_address = $ENV{CHANGE_LOG_EMAIL_ADDRESS}
256   || $ENV{EMAIL_ADDRESS}
257   || "set EMAIL_ADDRESS environment variable";
258
259 # Remove trailing parenthesized notes from user name (bit of hack).
260 $name =~ s/\(.*?\)\s*$//g;
261
262 # Find the change logs.
263 my %has_log;
264 my %files;
265 foreach my $file (sort keys %function_lists)
266   {
267     my $prefix = $file;
268     my $has_log = 0;
269     while ($prefix)
270       {
271         $prefix =~ s-/[^/]+/?$-/- or $prefix = "";
272         $has_log = $has_log{$prefix};
273         if (!defined $has_log)
274           {
275             $has_log = -f "${prefix}ChangeLog";
276             $has_log{$prefix} = $has_log;
277           }
278         last if $has_log;
279       }
280     if (!$has_log)
281       {
282         print STDERR "No ChangeLog found for $file.\n";
283       }
284     else
285       {
286         push @{$files{$prefix}}, $file;
287       }
288   }
289
290 # Get the latest ChangeLog files from svn.
291 my $logs = "";
292 foreach my $prefix (sort keys %files)
293   {
294     $logs .= " ${prefix}ChangeLog";
295   }
296 if ($logs && $updateChangeLogs)
297   {
298     print STDERR "  Running 'svn update' to update ChangeLog files.\n";
299     open ERRORS, "$SVN update -q$logs |" or die "The svn update of ChangeLog files failed: $!.\n";
300     print STDERR "    $_" while <ERRORS>;
301     close ERRORS;
302   }
303
304 # Write out a new ChangeLog file.
305 foreach my $prefix (sort keys %files)
306   {
307     print STDERR "  Editing the ${prefix}ChangeLog file.\n";
308     open OLD_CHANGE_LOG, "${prefix}ChangeLog" or die "Could not open ${prefix}ChangeLog file: $!.\n";
309     # It's less efficient to read the whole thing into memory than it would be
310     # to read it while we prepend to it later, but I like doing this part first.
311     my @old_change_log = <OLD_CHANGE_LOG>;
312     close OLD_CHANGE_LOG;
313     open CHANGE_LOG, "> ${prefix}ChangeLog" or die "Could not write ${prefix}ChangeLog\n.";
314     print CHANGE_LOG "$date  $name  <$email_address>\n\n";
315     print CHANGE_LOG "        Reviewed by NOBODY (OO" . "PS!).\n\n";
316     if ($prefix =~ m/WebCore/ || `pwd` =~ m/WebCore/) {
317         print CHANGE_LOG "        WARNING: NO TEST CASES ADDED OR CHANGED\n\n" unless $changedLayoutTests;
318     }
319
320     foreach my $file (sort @{$files{$prefix}})
321       {
322         my $file_stem = substr $file, length $prefix;
323         print CHANGE_LOG "        * $file_stem:$function_lists{$file}\n";
324       }
325     print CHANGE_LOG "\n", @old_change_log;
326     close CHANGE_LOG;
327   }
328
329 # Write out another diff.
330 if ($spewDiff && @changed_files)
331   {
332     print STDERR "  Running 'svn diff' to help you write the ChangeLog entries.\n";
333     open DIFF, "'$FindBin::Bin/svn-create-patch' $changed_files_string |" or die "The svn diff failed: $!.\n";
334     while (<DIFF>) { print; }
335     close DIFF;
336   }
337
338 # Open ChangeLogs.
339 if ($openChangeLogs && $logs)
340   {
341     print STDERR "  Opening the edited ChangeLog files.\n";
342     my $editor = $ENV{"CHANGE_LOG_EDIT_APPLICATION"};
343     if ($editor) {
344         system "open -a '$editor'$logs";
345     } else {
346         system "open -e$logs";
347     }
348   }
349
350 # Done.
351 exit;
352
353 sub canonicalizePath($)
354   {
355     my ($file) = @_;
356
357     # Remove extra slashes and '.' directories in path
358     $file = File::Spec->canonpath($file);
359
360     # Remove '..' directories in path
361     my @dirs = ();
362     foreach my $dir (File::Spec->splitdir($file))
363       {
364         if ($dir eq '..' && $#dirs >= 0 && $dirs[$#dirs] ne '..')
365           {
366             pop(@dirs);
367           }
368         else
369           {
370             push(@dirs, $dir);
371           }
372       }
373     return ($#dirs >= 0) ? File::Spec->catdir(@dirs) : ".";
374   }
375
376 sub get_function_line_ranges($$)
377   {
378     my ($file_handle, $file_name) = @_;
379
380     if ($file_name =~ /\.(c|cpp|m|mm|h)$/) {
381         return get_function_line_ranges_for_c ($file_handle, $file_name);
382     } elsif ($file_name =~ /\.java$/) {
383         return get_function_line_ranges_for_java ($file_handle, $file_name);
384     }
385     return ();
386   }
387
388
389 sub method_decl_to_selector($)
390   {
391     (my $method_decl) = @_;
392
393     $_ = $method_decl;
394
395     if ((my $comment_stripped) = m-([^/]*)(//|/*).*-) 
396       {
397         $_ = $comment_stripped;
398       }
399
400     s/,\s*...//;
401
402     if (/:/) 
403       {
404         my @components = split /:/;
405         pop @components if (scalar @components > 1);
406         $_ = (join ':', map {s/.*[^[:word:]]//; scalar $_;} @components) . ':';
407       } else {
408         s/\s*$//;
409         s/.*[^[:word:]]//;
410       }
411
412     return $_;
413   }
414
415
416
417 # Read a file and get all the line ranges of the things that look like C functions.
418 # A function name is the last word before an open parenthesis before the outer
419 # level open brace. A function starts at the first character after the last close
420 # brace or semicolon before the function name and ends at the close brace.
421 # Comment handling is simple-minded but will work for all but pathological cases.
422 #
423 # Result is a list of triples: [ start_line, end_line, function_name ].
424
425 sub get_function_line_ranges_for_c($$)
426   {
427     my ($file_handle, $file_name) = @_;
428
429     my @ranges;
430
431     my $in_comment = 0;
432     my $in_macro = 0;
433     my $in_method_declaration = 0;
434     my $in_parentheses = 0;
435     my $in_braces = 0;
436     my $brace_start = 0;
437     my $brace_end = 0;
438     my $skip_til_brace_or_semicolon = 0;
439
440     my $word = "";
441     my $interface_name = "";
442
443     my $potential_method_char = "";
444     my $potential_method_spec = "";
445
446     my $potential_start = 0;
447     my $potential_name = "";
448
449     my $start = 0;
450     my $name = "";
451
452     my $next_word_could_be_namespace = 0;
453     my $potential_namespace = "";
454     my @namespaces;
455
456     while (<$file_handle>)
457       {
458         # Handle continued multi-line comment.
459         if ($in_comment)
460           {
461             next unless s-.*\*/--;
462             $in_comment = 0;
463           }
464
465         # Handle continued macro.
466         if ($in_macro)
467           {
468             $in_macro = 0 unless /\\$/;
469             next;
470           }
471
472         # Handle start of macro (or any preprocessor directive).
473         if (/^\s*\#/)
474           {
475             $in_macro = 1 if /^([^\\]|\\.)*\\$/;
476             next;
477           }
478
479         # Handle comments and quoted text.
480         while (m-(/\*|//|\'|\")-) # \' and \" keep emacs perl mode happy
481           {
482             my $match = $1;
483             if ($match eq "/*")
484               {
485                 if (!s-/\*.*?\*/--)
486                   {
487                     s-/\*.*--;
488                     $in_comment = 1;
489                   }
490               }
491             elsif ($match eq "//")
492               {
493                 s-//.*--;
494               }
495             else # ' or "
496               {
497                 if (!s-$match([^\\]|\\.)*?$match--)
498                   {
499                     warn "mismatched quotes at line $. in $file_name\n";
500                     s-$match.*--;
501                   }
502               }
503           }
504
505
506         # continued method declaration
507         if ($in_method_declaration) 
508           {
509               my $original = $_;
510               my $method_cont = $_;
511
512               chomp $method_cont;
513               $method_cont =~ s/[;\{].*//;
514               $potential_method_spec = "${potential_method_spec} ${method_cont}";
515
516               $_ = $original;
517               if (/;/) 
518                 {
519                   $potential_start = 0;
520                   $potential_method_spec = "";
521                   $potential_method_char = "";
522                   $in_method_declaration = 0;
523                   s/^[^;\{]*//;
524                 } elsif (/{/) {
525                   my $selector = method_decl_to_selector ($potential_method_spec);
526                   $potential_name = "${potential_method_char}\[${interface_name} ${selector}\]";
527                   
528                   $potential_method_spec = "";
529                   $potential_method_char = "";
530                   $in_method_declaration = 0;
531   
532                   $_ = $original;
533                   s/^[^;{]*//;
534                 } elsif (/\@end/) {
535                   $in_method_declaration = 0;
536                   $interface_name = "";
537                   $_ = $original;
538                 } else {
539                   next;
540                 }
541           }
542
543         
544         # start of method declaration
545         if ((my $method_char, my $method_spec) = m&^([-+])([^0-9;][^;]*);?$&)
546           {
547             my $original = $_;
548
549             if ($interface_name) 
550               {
551                 chomp $method_spec;
552                 $method_spec =~ s/\{.*//;
553             
554                 $potential_method_char = $method_char;
555                 $potential_method_spec = $method_spec;
556                 $potential_start = $.;
557                 $in_method_declaration = 1;
558               } else { 
559                 warn "declaring a method but don't have interface on line $. in $file_name\n";
560               }
561             $_ = $original;
562             if (/\{/) {
563               my $selector = method_decl_to_selector ($potential_method_spec);
564               $potential_name = "${potential_method_char}\[${interface_name} ${selector}\]";
565               
566               $potential_method_spec = "";
567               $potential_method_char = "";
568               $in_method_declaration = 0;
569               $_ = $original;
570               s/^[^{]*//;
571             } elsif (/\@end/) {
572               $in_method_declaration = 0;
573               $interface_name = "";
574               $_ = $original;
575             } else {
576               next;
577             }
578           }
579
580
581         # Find function, interface and method names.
582         while (m&((?:[[:word:]]+::)*operator(?:[ \t]*\(\)|[^()]*)|[[:word:]:~]+|[(){}:;])|\@(?:implementation|interface|protocol)\s+(\w+)[^{]*&g)
583           {
584             # interface name
585             if ($2) 
586               {
587                 $interface_name = $2;
588                 next;
589               }
590
591             # Open parenthesis.
592             if ($1 eq "(")
593               {
594                 $potential_name = $word unless $in_parentheses || $skip_til_brace_or_semicolon;
595                 $in_parentheses++;
596                 next;
597               }
598
599             # Close parenthesis.
600             if ($1 eq ")")
601               {
602                 $in_parentheses--;
603                 next;
604               }
605
606             # C++ constructor initializers
607             if ($1 eq ":")
608               {
609                   $skip_til_brace_or_semicolon = 1 unless ($in_parentheses || $in_braces);
610               }
611
612             # Open brace.
613             if ($1 eq "{")
614               {
615                 $skip_til_brace_or_semicolon = 0;
616
617                 if ($potential_namespace) {
618                     push @namespaces, $potential_namespace;
619                     $potential_namespace = "";
620                     next;
621                 }
622
623                 # Promote potential name to real function name at the
624                 # start of the outer level set of braces (function body?).
625                 if (!$in_braces and $potential_start)
626                   {
627                     $start = $potential_start;
628                     $name = $potential_name;
629                     if (@namespaces && (length($name) < 2 || substr($name,1,1) ne "[")) {
630                         $name = join ('::', @namespaces, $name);
631                     }
632                   }
633
634                 $in_method_declaration = 0;
635
636                 $brace_start = $. if (!$in_braces);
637                 $in_braces++;
638                 next;
639               }
640
641             # Close brace.
642             if ($1 eq "}")
643               {
644                 if (!$in_braces && @namespaces) {
645                     pop @namespaces;
646                     next;
647                 }
648
649                 $in_braces--;
650                 $brace_end = $. if (!$in_braces);
651
652                 # End of an outer level set of braces.
653                 # This could be a function body.
654                 if (!$in_braces and $name)
655                   {
656                     push @ranges, [ $start, $., $name ];
657                     $name = "";
658                   }
659
660                 $potential_start = 0;
661                 $potential_name = "";
662                 next;
663               }
664
665             # Semicolon.
666             if ($1 eq ";")
667               {
668                 $skip_til_brace_or_semicolon = 0;
669                 $potential_start = 0;
670                 $potential_name = "";
671                 $in_method_declaration = 0;
672                 next;
673               }
674
675             # Ignore "const" method qualifier.
676             if ($1 eq "const") {
677                 next;
678             }
679
680             if ($1 eq "namespace" || $1 eq "class" || $1 eq "struct") {
681                 $next_word_could_be_namespace = 1;
682                 next;
683             }
684
685             # Word.
686             $word = $1;
687             if (!$skip_til_brace_or_semicolon) {
688               if ($next_word_could_be_namespace) {
689                 $potential_namespace = $word;
690                 $next_word_could_be_namespace = 0;
691               } elsif ($potential_namespace) {
692                 $potential_namespace = "";
693               }
694
695               if (!$in_parentheses) {
696                 $potential_start = 0;
697                 $potential_name = "";
698               }
699               if (!$potential_start) {
700                 $potential_start = $.;
701                 $potential_name = "";
702               }
703             }
704           }
705       }
706
707     warn "missing close braces in $file_name (probable start at $brace_start)\n" if ($in_braces > 0);
708     warn "too many close braces in $file_name (probable start at $brace_end)\n" if ($in_braces < 0);
709
710     warn "mismatched parentheses in $file_name\n" if $in_parentheses;
711
712     return @ranges;
713   }
714
715
716
717 # Read a file and get all the line ranges of the things that look like Java
718 # classes, interfaces and methods.
719 #
720 # A class or interface name is the word that immediately follows
721 # `class' or `interface' when followed by an open curly brace and not
722 # a semicolon. It can appear at the top level, or inside another class
723 # or interface block, but not inside a function block
724 #
725 # A class or interface starts at the first character after the first close
726 # brace or after the function name and ends at the close brace.
727 #
728 # A function name is the last word before an open parenthesis before
729 # an open brace rather than a semicolon. It can appear at top level or
730 # inside a class or interface block, but not inside a function block.
731 #
732 # A function starts at the first character after the first close
733 # brace or after the function name and ends at the close brace.
734 #
735 # Comment handling is simple-minded but will work for all but pathological cases.
736 #
737 # Result is a list of triples: [ start_line, end_line, function_name ].
738
739 sub get_function_line_ranges_for_java($$)
740   {
741     my ($file_handle, $file_name) = @_;
742
743     my @current_scopes;
744
745     my @ranges;
746
747     my $in_comment = 0;
748     my $in_macro = 0;
749     my $in_parentheses = 0;
750     my $in_braces = 0;
751     my $in_non_block_braces = 0;
752     my $class_or_interface_just_seen = 0;
753
754     my $word = "";
755
756     my $potential_start = 0;
757     my $potential_name = "";
758     my $potential_name_is_class_or_interface = 0;
759
760     my $start = 0;
761     my $name = "";
762     my $current_name_is_class_or_interface = 0;
763
764     while (<$file_handle>)
765       {
766         # Handle continued multi-line comment.
767         if ($in_comment)
768           {
769             next unless s-.*\*/--;
770             $in_comment = 0;
771           }
772
773         # Handle continued macro.
774         if ($in_macro)
775           {
776             $in_macro = 0 unless /\\$/;
777             next;
778           }
779
780         # Handle start of macro (or any preprocessor directive).
781         if (/^\s*\#/)
782           {
783             $in_macro = 1 if /^([^\\]|\\.)*\\$/;
784             next;
785           }
786
787         # Handle comments and quoted text.
788         while (m-(/\*|//|\'|\")-) # \' and \" keep emacs perl mode happy
789           {
790             my $match = $1;
791             if ($match eq "/*")
792               {
793                 if (!s-/\*.*?\*/--)
794                   {
795                     s-/\*.*--;
796                     $in_comment = 1;
797                   }
798               }
799             elsif ($match eq "//")
800               {
801                 s-//.*--;
802               }
803             else # ' or "
804               {
805                 if (!s-$match([^\\]|\\.)*?$match--)
806                   {
807                     warn "mismatched quotes at line $. in $file_name\n";
808                     s-$match.*--;
809                   }
810               }
811           }
812
813         # Find function names.
814         while (m-(\w+|[(){};])-g)
815           {
816             # Open parenthesis.
817             if ($1 eq "(")
818               {
819                 if (!$in_parentheses) {
820                     $potential_name = $word;
821                     $potential_name_is_class_or_interface = 0;
822                 }
823                 $in_parentheses++;
824                 next;
825               }
826
827             # Close parenthesis.
828             if ($1 eq ")")
829               {
830                 $in_parentheses--;
831                 next;
832               }
833
834             # Open brace.
835             if ($1 eq "{")
836               {
837                 # Promote potential name to real function name at the
838                 # start of the outer level set of braces (function/class/interface body?).
839                 if (!$in_non_block_braces
840                     and (!$in_braces or $current_name_is_class_or_interface)
841                     and $potential_start)
842                   {
843                     if ($name)
844                       {
845                           push @ranges, [ $start, ($. - 1),
846                                           join ('.', @current_scopes) ];
847                       }
848
849
850                     $current_name_is_class_or_interface = $potential_name_is_class_or_interface;
851
852                     $start = $potential_start;
853                     $name = $potential_name;
854
855                     push (@current_scopes, $name);
856                   } else {
857                       $in_non_block_braces++;
858                   }
859
860                 $potential_name = "";
861                 $potential_start = 0;
862
863                 $in_braces++;
864                 next;
865               }
866
867             # Close brace.
868             if ($1 eq "}")
869               {
870                 $in_braces--;
871
872                 # End of an outer level set of braces.
873                 # This could be a function body.
874                 if (!$in_non_block_braces)
875                   {
876                     if ($name)
877                       {
878                         push @ranges, [ $start, $.,
879                                         join ('.', @current_scopes) ];
880
881                         pop (@current_scopes);
882
883                         if (@current_scopes)
884                           {
885                             $current_name_is_class_or_interface = 1;
886
887                             $start = $. + 1;
888                             $name =  $current_scopes[$#current_scopes-1];
889                           }
890                         else
891                           {
892                             $current_name_is_class_or_interface = 0;
893                             $start = 0;
894                             $name =  "";
895                           }
896                     }
897                   }
898                 else
899                   {
900                     $in_non_block_braces-- if $in_non_block_braces;
901                   }
902
903                 $potential_start = 0;
904                 $potential_name = "";
905                 next;
906               }
907
908             # Semicolon.
909             if ($1 eq ";")
910               {
911                 $potential_start = 0;
912                 $potential_name = "";
913                 next;
914               }
915
916             if ($1 eq "class" or $1 eq "interface")
917               {
918                 $class_or_interface_just_seen = 1;
919                 next;
920               }
921
922             # Word.
923             $word = $1;
924             if (!$in_parentheses)
925               {
926                 if ($class_or_interface_just_seen) {
927                     $potential_name = $word;
928                     $potential_start = $.;
929                     $class_or_interface_just_seen = 0;
930                     $potential_name_is_class_or_interface = 1;
931                     next;
932                 }
933               }
934             if (!$potential_start)
935               {
936                 $potential_start = $.;
937                 $potential_name = "";
938               }
939             $class_or_interface_just_seen = 0;
940           }
941       }
942
943     warn "mismatched braces in $file_name\n" if $in_braces;
944     warn "mismatched parentheses in $file_name\n" if $in_parentheses;
945
946     return @ranges;
947   }
948
949 sub processPaths(\@)
950   {
951     my ($paths) = @_;
952     return ("." => 1) if (!@{$paths});
953
954     my %result = ();
955
956     for my $file (@{$paths})
957       {
958         die "can't handle absolute paths like \"$file\"\n" if File::Spec->file_name_is_absolute($file);
959         die "can't handle empty string path\n" if $file eq "";
960         die "can't handle path with single quote in the name like \"$file\"\n" if $file =~ /'/; # ' (keep Xcode syntax highlighting happy)
961
962         my $untouchedFile = $file;
963
964         $file = canonicalizePath($file);
965
966         die "can't handle paths with .. like \"$untouchedFile\"\n" if $file =~ m|/\.\./|;
967
968         $result{$file} = 1;
969       }
970
971     return ("." => 1) if ($result{"."});
972
973     # Remove any paths that also have a parent listed.
974     for my $path (keys %result)
975       {
976         for (my $parent = dirname($path); $parent ne '.'; $parent = dirname($parent))
977          {
978             if ($result{$parent})
979               {
980                 delete $result{$path};
981                 last;
982               }
983           }
984       }
985
986     return %result;
987   }