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