added

1 files changed, 564 insertions, 0 deletions

diff --git a/prepare-ChangeLog.pl b/prepare-ChangeLog.pl
new file mode 100755
index 0000000..b52482f
--- /dev/null
+++ b/prepare-ChangeLog.pl
@@ -0,0 +1,564 @@
+#!/usr/bin/perl -w
+# -*- Mode: perl; indent-tabs-mode: nil; c-basic-offset: 2  -*-
+
+# Perl script to create a ChangeLog entry with names of files
+# and functions from a cvs diff.
+#
+# Darin Adler <darin@eazel.com>, started 20 April 2000
+# Java support added by Maciej Stachowiak <mjs@eazel.com>
+# last updated 28 December 2000
+#
+# (Someone put a license in here, like maybe GPL.)
+#
+# TODO:
+#   Provide option to put new ChangeLog into a separate file
+#     instead of editing the ChangeLog.
+#   For new files, just say "New file" instead of listing
+#     function names.
+#   List functions that have been removed too.
+#   Decide what a good logical order is for the changed files
+#     other than a normal text "sort" (top level first?)
+#     (group directories?) (.h before .c?)
+#   Leave a diff file behind if asked, but in unified format.
+#   Handle C++ and yacc source files too (other languages?).
+#   Help merge when there are ChangeLog conflicts or if there's
+#     already a partly written ChangeLog entry.
+#   Find appropriate ChangeLog to edit for each changed file
+#     instead of always using ChangeLog in current directory.
+#   Add command line option to put the ChangeLog into a separate
+#     file or just spew it out stdout.
+#   Figure out how to allow -z options from .cvsrc to work without
+#     letting other bad options work. Currently the -f disables
+#     everything from the .cvsrc.
+#   Add CVS version numbers for each file too (can't do that until
+#     the changes are checked in, though).
+#   Work around diff stupidity where deleting a function that starts
+#     with a comment makes diff think that the following function
+#     has been changed (if the following function starts with a comment
+#     with the same first line, such as /**)
+#   Work around diff stupidity where deleting an entire function and
+#     the blank lines before it makes diff think you've changed the
+#     previous function.
+
+use diagnostics;
+use strict;
+
+use English;
+use Text::Wrap;
+
+# Read the old change log file.
+# It's less efficient to read the whole thing into memory than it would be
+# to read it while we prepend to it later, but I like doing this part first.
+print STDERR "  Updating ChangeLog from cvs repository.\n";
+open ERRORS, "cvs update ChangeLog |" or die "The cvs update of ChangeLog failed: $OS_ERROR.\n";
+print STDERR "    $ARG" while <ERRORS>;
+close ERRORS;
+open OLD_CHANGE_LOG, "ChangeLog" or die "Could not open ChangeLog file: $OS_ERROR.\n";
+my @old_change_log = <OLD_CHANGE_LOG>;
+close OLD_CHANGE_LOG;
+
+# For each file, build a list of modified lines.
+# Use line numbers from the "after" side of each diff.
+print STDERR "  Running cvs diff to find changes.\n";
+my %changed_line_ranges;
+my $file;
+open DIFF, "cvs -fq diff -N |" or die "The cvs diff failed: $OS_ERROR.\n";
+while (<DIFF>)
+  {
+    $file = $1 if /^Index: (\S+)$/;
+    if (defined $file
+        and $file ne "ChangeLog"
+        and (/^\d+(,\d+)?[acd](\d+)(,(\d+))?/ or /^Binary files/) )
+      {
+        push @{$changed_line_ranges{$file}}, [ $2, $4 || $2 ];
+      }
+  }
+close DIFF;
+if (!%changed_line_ranges)
+  {
+    print STDERR "  No changes found.\n";
+    exit;
+  }
+
+# For each ".c" file, convert line range to function list.
+print STDERR "  Extracting affected function names from C source files.\n";
+my %function_lists;
+foreach my $file (keys %changed_line_ranges)
+  {
+    # An empty function list still indicates that something changed.
+    $function_lists{$file} = "";
+
+    # Only look for function names in .c files.
+    next unless $file =~ /\.(c|java)/;
+
+    # Find all the functions in the file.
+    open SOURCE, $file or next;
+    my @function_ranges = get_function_line_ranges(\*SOURCE, $file);
+    close SOURCE;
+
+    # Find all the modified functions.
+    my @functions;
+    my %saw_function;
+    my @change_ranges = (@{$changed_line_ranges{$file}}, []);
+    my @change_range = (0, 0);
+    FUNCTION: foreach my $function_range_ref (@function_ranges)
+      {
+        my @function_range = @$function_range_ref;
+
+        # Advance to successive change ranges.
+        for (;; @change_range = @{shift @change_ranges})
+          {
+            last FUNCTION unless @change_range;
+
+            # If past this function, move on to the next one.
+            next FUNCTION if $change_range[0] > $function_range[1];
+            
+            # If an overlap with this function range, record the function name.
+            if ($change_range[1] >= $function_range[0]
+                and $change_range[0] <= $function_range[1])
+              {
+                if (!$saw_function{$function_range[2]})
+                  {
+                    $saw_function{$function_range[2]} = 1;
+                    push @functions, $function_range[2]; 
+                  }
+                next FUNCTION;
+              }
+          }
+      }
+
+    # Format the list of functions now.
+    $function_lists{$file} = " (" . join("), (", @functions) . "):" if @functions;
+  }
+
+# Write out a new ChangeLog file.
+print STDERR "  Editing the ChangeLog file.\n";
+my $date = sprintf "%d-%02d-%02d",
+  1900 + (localtime $BASETIME)[5], # year
+  1 + (localtime $BASETIME)[4], # month
+  (localtime $BASETIME)[3]; # day within month
+my $name = $ENV{CHANGE_LOG_NAME}
+  || $ENV{REAL_NAME}
+  || (getpwuid $REAL_USER_ID)[6]
+  || "set REAL_NAME environment variable";
+my $email_address = $ENV{CHANGE_LOG_EMAIL_ADDRESS}
+  || $ENV{EMAIL_ADDRESS}
+  || "set EMAIL_ADDRESS environment variable";
+open CHANGE_LOG, "> ChangeLog" or die "Could not write ChangeLog\n.";
+print CHANGE_LOG "$date  $name  <$email_address>\n\n";
+print CHANGE_LOG "\treviewed by: <delete if not using a buddy>\n\n";
+foreach my $file (sort keys %function_lists)
+  {
+    my $lines = wrap("\t", "\t", "XX$file:$function_lists{$file}");
+    $lines =~ s/^\tXX/\t* /;
+    print CHANGE_LOG "$lines\n";
+  }
+print CHANGE_LOG "\n", @old_change_log;
+close CHANGE_LOG;
+
+# Done.
+print STDERR "  Done editing ChangeLog.\n";
+exit;
+
+
+
+sub get_function_line_ranges
+  {
+    my ($file_handle, $file_name) = @_;
+
+    if ($file_name =~ /\.c$/) {
+        return get_function_line_ranges_for_c ($file_handle, $file_name);
+    } elsif ($file_name =~ /\.java$/) {
+        return get_function_line_ranges_for_java ($file_handle, $file_name);
+    }
+    return ();
+  }
+
+# Read a file and get all the line ranges of the things that look like C functions.
+# A function name is the last word before an open parenthesis before the outer
+# level open brace. A function starts at the first character after the last close
+# brace or semicolon before the function name and ends at the close brace.
+# Comment handling is simple-minded but will work for all but pathological cases.
+#
+# Result is a list of triples: [ start_line, end_line, function_name ].
+
+sub get_function_line_ranges_for_c
+  {
+    my ($file_handle, $file_name) = @_;
+
+    my @ranges;
+
+    my $in_comment = 0;
+    my $in_macro = 0;
+    my $in_parentheses = 0;
+    my $in_braces = 0;
+    
+    my $word = "";
+
+    my $potential_start = 0;
+    my $potential_name = "";
+    
+    my $start = 0;
+    my $name = "";
+    
+    while (<$file_handle>)
+      {
+        # Handle continued multi-line comment.
+        if ($in_comment)
+          {
+            next unless s-.*\*/--;
+            $in_comment = 0;
+          }
+
+        # Handle continued macro.
+        if ($in_macro)
+          {
+            $in_macro = 0 unless /\\$/;
+            next;
+          }
+
+        # Handle start of macro (or any preprocessor directive).
+        if (/^\s*\#/)
+          {
+            $in_macro = 1 if /^([^\\]|\\.)*\\$/;
+            next;
+          }
+
+        # Handle comments and quoted text.
+        while (m-(/\*|//|\'|\")-) # \' and \" keep emacs perl mode happy
+          {
+            my $match = $1;
+            if ($match eq "/*")
+              {
+                if (!s-/\*.*?\*/--)
+                  {
+                    s-/\*.*--;
+                    $in_comment = 1;
+                  }
+              }
+            elsif ($match eq "//")
+              {
+                s-//.*--;
+              }
+            else # ' or "
+              {
+                if (!s-$match([^\\]|\\.)*?$match--)
+                  {
+                    warn "mismatched quotes at line $INPUT_LINE_NUMBER in $file_name\n";
+                    s-$match.*--;
+                  }
+              }
+          }
+        
+        # Find function names.
+        while (m-(\w+|[(){};])-g)
+          {
+            # Open parenthesis.
+            if ($1 eq "(")
+              {
+                $potential_name = $word unless $in_parentheses;
+                $in_parentheses++;
+                next;
+              }
+
+            # Close parenthesis.
+            if ($1 eq ")")
+              {
+                $in_parentheses--;
+                next;
+              }
+
+            # Open brace.
+            if ($1 eq "{")
+              {
+                # Promote potiential name to real function name at the
+                # start of the outer level set of braces (function body?).
+                if (!$in_braces and $potential_start)
+                  {
+                    $start = $potential_start;
+                    $name = $potential_name;
+                  }
+
+                $in_braces++;
+                next;
+              }
+
+            # Close brace.
+            if ($1 eq "}")
+              {
+                $in_braces--;
+
+                # End of an outer level set of braces.
+                # This could be a function body.
+                if (!$in_braces and $name)
+                  {
+                    push @ranges, [ $start, $INPUT_LINE_NUMBER, $name ];
+                    $name = "";
+                  }
+
+                $potential_start = 0;
+                $potential_name = "";
+                next;
+              }
+
+            # Semicolon.
+            if ($1 eq ";")
+              {
+                $potential_start = 0;
+                $potential_name = "";
+                next;
+              }
+
+            # Word.
+            $word = $1;
+            if (!$in_parentheses)
+              {
+                $potential_start = 0;
+                $potential_name = "";
+              }
+            if (!$potential_start)
+              {
+                $potential_start = $INPUT_LINE_NUMBER;
+                $potential_name = "";
+              }
+          }
+      }
+
+    warn "mismatched braces in $file_name\n" if $in_braces;
+    warn "mismatched parentheses in $file_name\n" if $in_parentheses;
+
+    return @ranges;
+  }
+
+
+
+# Read a file and get all the line ranges of the things that look like Java
+# classes, interfaces and methods.
+#
+# A class or interface name is the word that immediately follows
+# `class' or `interface' when followed by an open curly brace and not
+# a semicolon. It can appear at the top level, or inside another class
+# or interface block, but not inside a function block
+#
+# A class or interface starts at the first character after the first close
+# brace or after the function name and ends at the close brace.
+#
+# A function name is the last word before an open parenthesis before
+# an open brace rather than a semicolon. It can appear at top level or
+# inside a class or interface block, but not inside a function block.
+#
+# A function starts at the first character after the first close
+# brace or after the function name and ends at the close brace.
+#
+# Comment handling is simple-minded but will work for all but pathological cases.
+#
+# Result is a list of triples: [ start_line, end_line, function_name ].
+
+sub get_function_line_ranges_for_java
+  {
+    my ($file_handle, $file_name) = @_;
+
+    my @current_scopes;
+
+    my @ranges;
+
+    my $in_comment = 0;
+    my $in_macro = 0;
+    my $in_parentheses = 0;
+    my $in_braces = 0;
+    my $in_non_block_braces = 0;
+    my $class_or_interface_just_seen = 0;
+
+    my $word = "";
+
+    my $potential_start = 0;
+    my $potential_name = "";
+    my $potential_name_is_class_or_interface = 0;
+    
+    my $start = 0;
+    my $name = "";
+    my $current_name_is_class_or_interface = 0;
+    
+    while (<$file_handle>)
+      {
+        # Handle continued multi-line comment.
+        if ($in_comment)
+          {
+            next unless s-.*\*/--;
+            $in_comment = 0;
+          }
+
+        # Handle continued macro.
+        if ($in_macro)
+          {
+            $in_macro = 0 unless /\\$/;
+            next;
+          }
+
+        # Handle start of macro (or any preprocessor directive).
+        if (/^\s*\#/)
+          {
+            $in_macro = 1 if /^([^\\]|\\.)*\\$/;
+            next;
+          }
+
+        # Handle comments and quoted text.
+        while (m-(/\*|//|\'|\")-) # \' and \" keep emacs perl mode happy
+          {
+            my $match = $1;
+            if ($match eq "/*")
+              {
+                if (!s-/\*.*?\*/--)
+                  {
+                    s-/\*.*--;
+                    $in_comment = 1;
+                  }
+              }
+            elsif ($match eq "//")
+              {
+                s-//.*--;
+              }
+            else # ' or "
+              {
+                if (!s-$match([^\\]|\\.)*?$match--)
+                  {
+                    warn "mismatched quotes at line $INPUT_LINE_NUMBER in $file_name\n";
+                    s-$match.*--;
+                  }
+              }
+          }
+        
+        # Find function names.
+        while (m-(\w+|[(){};])-g)
+          {
+            # Open parenthesis.
+            if ($1 eq "(")
+              {
+                if (!$in_parentheses) {
+                    $potential_name = $word;
+                    $potential_name_is_class_or_interface = 0;
+                }
+                $in_parentheses++;
+                next;
+              }
+
+            # Close parenthesis.
+            if ($1 eq ")")
+              {
+                $in_parentheses--;
+                next;
+              }
+
+            # Open brace.
+            if ($1 eq "{")
+              {
+                # Promote potiential name to real function name at the
+                # start of the outer level set of braces (function/class/interface body?).
+                if (!$in_non_block_braces
+                    and (!$in_braces or $current_name_is_class_or_interface) 
+                    and $potential_start)
+                  {
+                    if ($name)
+                      {
+                          push @ranges, [ $start, ($INPUT_LINE_NUMBER - 1), 
+                                          join ('.', @current_scopes) ];
+                      }
+
+
+                    $current_name_is_class_or_interface = $potential_name_is_class_or_interface;
+                    
+                    $start = $potential_start;
+                    $name = $potential_name;
+
+                    push (@current_scopes, $name);
+                  } else {
+                      $in_non_block_braces++;
+                  }
+
+                $potential_name = "";
+                $potential_start = 0;
+ 
+                $in_braces++;
+                next;
+              }
+
+            # Close brace.
+            if ($1 eq "}")
+              {
+                $in_braces--;
+                
+                # End of an outer level set of braces.
+                # This could be a function body.
+                if (!$in_non_block_braces) 
+                  {
+                    if ($name)
+                      {
+                        push @ranges, [ $start, $INPUT_LINE_NUMBER, 
+                                        join ('.', @current_scopes) ];
+                        
+                        pop (@current_scopes);                        
+
+                        if (@current_scopes) 
+                          {
+                            $current_name_is_class_or_interface = 1;
+                            
+                            $start = $INPUT_LINE_NUMBER + 1;
+                            $name =  $current_scopes[$#current_scopes-1];
+                          }
+                        else
+                          {
+                            $current_name_is_class_or_interface = 0;
+                            $start = 0;
+                            $name =  "";
+                          } 
+                    }
+                  }
+                else
+                  {
+                    $in_non_block_braces-- if $in_non_block_braces;
+                  }
+
+                $potential_start = 0;
+                $potential_name = "";
+                next;
+              }
+
+            # Semicolon.
+            if ($1 eq ";")
+              {
+                $potential_start = 0;
+                $potential_name = "";
+                next;
+              }
+            
+            if ($1 eq "class" or $1 eq "interface") {
+                $class_or_interface_just_seen = 1;
+                next;
+            }
+
+            # Word.
+            $word = $1;
+            if (!$in_parentheses)
+              {
+                if ($class_or_interface_just_seen) {
+                    $potential_name = $word;
+                    $potential_start = $INPUT_LINE_NUMBER;
+                    $class_or_interface_just_seen = 0;
+                    $potential_name_is_class_or_interface = 1;
+                    next;
+                }
+              }
+            if (!$potential_start)
+              {
+                $potential_start = $INPUT_LINE_NUMBER;
+                $potential_name = "";
+              }
+            $class_or_interface_just_seen = 0;
+          }
+      }
+
+    warn "mismatched braces in $file_name\n" if $in_braces;
+    warn "mismatched parentheses in $file_name\n" if $in_parentheses;
+
+    return @ranges;
+  }