#!/usr/bin/perl -w # -*- Mode: perl; indent-tabs-mode: nil; c-basic-offset: 2 -*- # # Copyright (C) 2000, 2001 Eazel, Inc. # Copyright (C) 2002, 2003, 2004, 2005, 2006 Apple Computer, Inc. # # prepare-ChangeLog is free software; you can redistribute it and/or # modify it under the terms of the GNU General Public # License as published by the Free Software Foundation; either # version 2 of the License, or (at your option) any later version. # # prepare-ChangeLog is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU # General Public License for more details. # # You should have received a copy of the GNU General Public # License along with this program; if not, write to the Free # Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. # # Perl script to create a ChangeLog entry with names of files # and functions from a diff. # # Darin Adler , started 20 April 2000 # Java support added by Maciej Stachowiak # Objective-C, C++ and Objective-C++ support added by Maciej Stachowiak # # TODO: # 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?) # Handle yacc source files too (other languages?). # Help merge when there are ChangeLog conflicts or if there's # already a partly written ChangeLog entry. # Add command line option to put the ChangeLog into a separate # file or just spew it out stdout. # Add SVN version numbers for commit (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 strict; use warnings; use File::Basename; use File::Spec; use File::Temp; use FindBin; use Getopt::Long; sub canonicalizePath($); sub get_function_line_ranges($$); sub get_function_line_ranges_for_c($$); sub get_function_line_ranges_for_java($$); sub method_decl_to_selector($); sub processPaths(\@); my $openChangeLogs = 0; my $showHelp = 0; my $updateChangeLogs = 1; my $spewDiff = $ENV{"PREPARE_CHANGELOG_DIFF"}; my $parseOptionsResult = GetOptions("diff|d!" => \$spewDiff, "help|h!" => \$showHelp, "open|o!" => \$openChangeLogs, "update!" => \$updateChangeLogs); if (!$parseOptionsResult || $showHelp) { print STDERR basename($0) . " [-d|--diff] [-h|--help] [-o|--open] [svndir1 [svndir2 ...]]\n"; print STDERR " -d|--diff Spew diff to stdout when running\n"; print STDERR " -h|--help Show this help message\n"; print STDERR " -o|--open Open ChangeLogs in an editor when done\n"; print STDERR " --[no-]update Update ChangeLogs from svn before adding entry (default: update)\n"; exit 1; } my %paths = processPaths(@ARGV); # Find the list of modified files my @changed_files; my $changed_files_string; my %changed_line_ranges; my %function_lists; my @conflict_files; my $SVN = "svn"; my %statusDescription = ( "A" => " Added.", "D" => " Removed.", "M" => "", "R" => " Replaced.", ); my $changedLayoutTests = 0; my $DIFFOUT = new File::Temp(TEMPLATE => basename($0) . "-XXXXXXXX", DIR => ($ENV{'TMPDIR'} || "/tmp"), SUFFIX => ".diff"); my $diffTempFile = $DIFFOUT->filename(); my @diffFiles; print STDERR " Running 'svn diff' to find changed, added, or removed files.\n"; open SVNDIFF, "$SVN diff --diff-cmd diff -x -N '" . join("' '", keys %paths) . "'|" or die "The svn diff failed: $!.\n"; while () { print $DIFFOUT $_; if (/^Index: (.+)$/) { push @diffFiles, $1; } } close SVNDIFF; close $DIFFOUT; if (@diffFiles) { my $diffFilesString = "'" . join ("' '", @diffFiles) . "'"; print STDERR " Running 'svn stat' on changed, added, or removed files.\n"; open SVNSTAT, "$SVN stat $diffFilesString 2> /dev/stdout |" or die "The svn stat failed: $!.\n"; while () { if (/^([A-Z]).+\s+(.+)$/) { my $status = $1; my $file = $2; if ($status eq "A" || $status eq "M") { my @components = File::Spec->splitdir($file); $changedLayoutTests = 1 if $components[0] eq "LayoutTests"; push @changed_files, $file if $components[$#components] ne "ChangeLog"; } push @conflict_files, $file if $status eq "C"; $function_lists{$file} = $statusDescription{$status} if exists $statusDescription{$status}; } else { print; # error output from svn stat } } close SVNSTAT; } if (!@diffFiles || !%function_lists) { print STDERR " No changes found.\n"; exit 1; } if (@conflict_files) { print STDERR " The following files have conflicts. Run prepare-ChangeLog again after fixing the conflicts:\n"; print STDERR join("\n", @conflict_files), "\n"; exit 1; } if (@changed_files) { $changed_files_string = "'" . join ("' '", @changed_files) . "'"; # For each file, build a list of modified lines. # Use line numbers from the "after" side of each diff. print STDERR " Reviewing 'svn diff' to determine which lines changed.\n"; my $file; open DIFF, "< $diffTempFile" or die "Opening $diffTempFile failed: $!.\n"; while () { $file = $1 if /^Index: (\S+)$/; if (defined $file) { if (/^\d+(,\d+)?[acd](\d+)(,(\d+))?/) { push @{$changed_line_ranges{$file}}, [ $2, $4 || $2 ]; } elsif (/DO_NOT_COMMIT/) { print STDERR "WARNING: file $file contains the string DO_NOT_COMMIT, line $.\n"; } } } close DIFF; } # For each source file, convert line range to function list. if (%changed_line_ranges) { print STDERR " Extracting affected function names from source files.\n"; foreach my $file (keys %changed_line_ranges) { # Only look for function names in .c files. next unless $file =~ /\.(c|cpp|m|mm|h|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. if (@functions) { $function_lists{$file} = "" if !defined $function_lists{$file}; $function_lists{$file} .= "\n (" . join("):\n (", @functions) . "):"; } } } # Get some parameters for the ChangeLog we are about to write. my $date = sprintf "%d-%02d-%02d", 1900 + (localtime $^T)[5], # year 1 + (localtime $^T)[4], # month (localtime $^T)[3]; # day within month my $name = $ENV{CHANGE_LOG_NAME} || $ENV{REAL_NAME} || (getpwuid $<)[6] || "set REAL_NAME environment variable"; my $email_address = $ENV{CHANGE_LOG_EMAIL_ADDRESS} || $ENV{EMAIL_ADDRESS} || "set EMAIL_ADDRESS environment variable"; # Remove trailing parenthesized notes from user name (bit of hack). $name =~ s/\(.*?\)\s*$//g; # Find the change logs. my %has_log; my %files; foreach my $file (sort keys %function_lists) { my $prefix = $file; my $has_log = 0; while ($prefix) { $prefix =~ s-/[^/]+/?$-/- or $prefix = ""; $has_log = $has_log{$prefix}; if (!defined $has_log) { $has_log = -f "${prefix}ChangeLog"; $has_log{$prefix} = $has_log; } last if $has_log; } if (!$has_log) { print STDERR "No ChangeLog found for $file.\n"; } else { push @{$files{$prefix}}, $file; } } # Get the latest ChangeLog files from svn. my $logs = ""; foreach my $prefix (sort keys %files) { $logs .= " ${prefix}ChangeLog"; } if ($logs && $updateChangeLogs) { print STDERR " Running 'svn update' to update ChangeLog files.\n"; open ERRORS, "$SVN update -q$logs |" or die "The svn update of ChangeLog files failed: $!.\n"; print STDERR " $_" while ; close ERRORS; } # Write out a new ChangeLog file. foreach my $prefix (sort keys %files) { print STDERR " Editing the ${prefix}ChangeLog file.\n"; open OLD_CHANGE_LOG, "${prefix}ChangeLog" or die "Could not open ${prefix}ChangeLog file: $!.\n"; # 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. my @old_change_log = ; close OLD_CHANGE_LOG; open CHANGE_LOG, "> ${prefix}ChangeLog" or die "Could not write ${prefix}ChangeLog\n."; print CHANGE_LOG "$date $name <$email_address>\n\n"; print CHANGE_LOG " Reviewed by NOBODY (OO" . "PS!).\n\n"; if ($prefix =~ m/WebCore/ || `pwd` =~ m/WebCore/) { print CHANGE_LOG " WARNING: NO TEST CASES ADDED OR CHANGED\n\n" unless $changedLayoutTests; } foreach my $file (sort @{$files{$prefix}}) { my $file_stem = substr $file, length $prefix; print CHANGE_LOG " * $file_stem:$function_lists{$file}\n"; } print CHANGE_LOG "\n", @old_change_log; close CHANGE_LOG; } # Write out another diff. if ($spewDiff && @changed_files) { print STDERR " Running 'svn diff' to help you write the ChangeLog entries.\n"; open DIFF, "'$FindBin::Bin/svn-create-patch' $changed_files_string |" or die "The svn diff failed: $!.\n"; while () { print; } close DIFF; } # Open ChangeLogs. if ($openChangeLogs && $logs) { print STDERR " Opening the edited ChangeLog files.\n"; my $editor = $ENV{"CHANGE_LOG_EDIT_APPLICATION"}; if ($editor) { system "open -a '$editor'$logs"; } else { system "open -e$logs"; } } # Done. exit; sub canonicalizePath($) { my ($file) = @_; # Remove extra slashes and '.' directories in path $file = File::Spec->canonpath($file); # Remove '..' directories in path my @dirs = (); foreach my $dir (File::Spec->splitdir($file)) { if ($dir eq '..' && $#dirs >= 0 && $dirs[$#dirs] ne '..') { pop(@dirs); } else { push(@dirs, $dir); } } return ($#dirs >= 0) ? File::Spec->catdir(@dirs) : "."; } sub get_function_line_ranges($$) { my ($file_handle, $file_name) = @_; if ($file_name =~ /\.(c|cpp|m|mm|h)$/) { 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 (); } sub method_decl_to_selector($) { (my $method_decl) = @_; $_ = $method_decl; if ((my $comment_stripped) = m-([^/]*)(//|/*).*-) { $_ = $comment_stripped; } s/,\s*...//; if (/:/) { my @components = split /:/; pop @components if (scalar @components > 1); $_ = (join ':', map {s/.*[^[:word:]]//; scalar $_;} @components) . ':'; } else { s/\s*$//; s/.*[^[:word:]]//; } 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_method_declaration = 0; my $in_parentheses = 0; my $in_braces = 0; my $brace_start = 0; my $brace_end = 0; my $skip_til_brace_or_semicolon = 0; my $word = ""; my $interface_name = ""; my $potential_method_char = ""; my $potential_method_spec = ""; my $potential_start = 0; my $potential_name = ""; my $start = 0; my $name = ""; my $next_word_could_be_namespace = 0; my $potential_namespace = ""; my @namespaces; 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 $. in $file_name\n"; s-$match.*--; } } } # continued method declaration if ($in_method_declaration) { my $original = $_; my $method_cont = $_; chomp $method_cont; $method_cont =~ s/[;\{].*//; $potential_method_spec = "${potential_method_spec} ${method_cont}"; $_ = $original; if (/;/) { $potential_start = 0; $potential_method_spec = ""; $potential_method_char = ""; $in_method_declaration = 0; s/^[^;\{]*//; } elsif (/{/) { my $selector = method_decl_to_selector ($potential_method_spec); $potential_name = "${potential_method_char}\[${interface_name} ${selector}\]"; $potential_method_spec = ""; $potential_method_char = ""; $in_method_declaration = 0; $_ = $original; s/^[^;{]*//; } elsif (/\@end/) { $in_method_declaration = 0; $interface_name = ""; $_ = $original; } else { next; } } # start of method declaration if ((my $method_char, my $method_spec) = m&^([-+])([^0-9;][^;]*);?$&) { my $original = $_; if ($interface_name) { chomp $method_spec; $method_spec =~ s/\{.*//; $potential_method_char = $method_char; $potential_method_spec = $method_spec; $potential_start = $.; $in_method_declaration = 1; } else { warn "declaring a method but don't have interface on line $. in $file_name\n"; } $_ = $original; if (/\{/) { my $selector = method_decl_to_selector ($potential_method_spec); $potential_name = "${potential_method_char}\[${interface_name} ${selector}\]"; $potential_method_spec = ""; $potential_method_char = ""; $in_method_declaration = 0; $_ = $original; s/^[^{]*//; } elsif (/\@end/) { $in_method_declaration = 0; $interface_name = ""; $_ = $original; } else { next; } } # Find function, interface and method names. while (m&((?:[[:word:]]+::)*operator(?:[ \t]*\(\)|[^()]*)|[[:word:]:~]+|[(){}:;])|\@(?:implementation|interface|protocol)\s+(\w+)[^{]*&g) { # interface name if ($2) { $interface_name = $2; next; } # Open parenthesis. if ($1 eq "(") { $potential_name = $word unless $in_parentheses || $skip_til_brace_or_semicolon; $in_parentheses++; next; } # Close parenthesis. if ($1 eq ")") { $in_parentheses--; next; } # C++ constructor initializers if ($1 eq ":") { $skip_til_brace_or_semicolon = 1 unless ($in_parentheses || $in_braces); } # Open brace. if ($1 eq "{") { $skip_til_brace_or_semicolon = 0; if ($potential_namespace) { push @namespaces, $potential_namespace; $potential_namespace = ""; next; } # Promote potential 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; if (@namespaces && (length($name) < 2 || substr($name,1,1) ne "[")) { $name = join ('::', @namespaces, $name); } } $in_method_declaration = 0; $brace_start = $. if (!$in_braces); $in_braces++; next; } # Close brace. if ($1 eq "}") { if (!$in_braces && @namespaces) { pop @namespaces; next; } $in_braces--; $brace_end = $. if (!$in_braces); # End of an outer level set of braces. # This could be a function body. if (!$in_braces and $name) { push @ranges, [ $start, $., $name ]; $name = ""; } $potential_start = 0; $potential_name = ""; next; } # Semicolon. if ($1 eq ";") { $skip_til_brace_or_semicolon = 0; $potential_start = 0; $potential_name = ""; $in_method_declaration = 0; next; } # Ignore "const" method qualifier. if ($1 eq "const") { next; } if ($1 eq "namespace" || $1 eq "class" || $1 eq "struct") { $next_word_could_be_namespace = 1; next; } # Word. $word = $1; if (!$skip_til_brace_or_semicolon) { if ($next_word_could_be_namespace) { $potential_namespace = $word; $next_word_could_be_namespace = 0; } elsif ($potential_namespace) { $potential_namespace = ""; } if (!$in_parentheses) { $potential_start = 0; $potential_name = ""; } if (!$potential_start) { $potential_start = $.; $potential_name = ""; } } } } warn "missing close braces in $file_name (probable start at $brace_start)\n" if ($in_braces > 0); warn "too many close braces in $file_name (probable start at $brace_end)\n" if ($in_braces < 0); 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 $. 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 potential 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, ($. - 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, $., join ('.', @current_scopes) ]; pop (@current_scopes); if (@current_scopes) { $current_name_is_class_or_interface = 1; $start = $. + 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 = $.; $class_or_interface_just_seen = 0; $potential_name_is_class_or_interface = 1; next; } } if (!$potential_start) { $potential_start = $.; $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; } sub processPaths(\@) { my ($paths) = @_; return ("." => 1) if (!@{$paths}); my %result = (); for my $file (@{$paths}) { die "can't handle absolute paths like \"$file\"\n" if File::Spec->file_name_is_absolute($file); die "can't handle empty string path\n" if $file eq ""; die "can't handle path with single quote in the name like \"$file\"\n" if $file =~ /'/; # ' (keep Xcode syntax highlighting happy) my $untouchedFile = $file; $file = canonicalizePath($file); die "can't handle paths with .. like \"$untouchedFile\"\n" if $file =~ m|/\.\./|; $result{$file} = 1; } return ("." => 1) if ($result{"."}); # Remove any paths that also have a parent listed. for my $path (keys %result) { for (my $parent = dirname($path); $parent ne '.'; $parent = dirname($parent)) { if ($result{$parent}) { delete $result{$path}; last; } } } return %result; }