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