10139N/A

10139N/A

10139N/A

10139N/A

10139N/A

10139N/A

10139N/Ause strict;

10139N/A

10139N/Ause Getopt::Long;

10139N/A

10139N/Amy $spewDiff = $ENV{"PREPARE_CHANGELOG_DIFF"};

10139N/Amy $openChangeLogs = 0;

10139N/AGetOptions("diff|d!" => \$spewDiff,

13688N/A "open|o!" => \$openChangeLogs);

10638N/A

10354N/Amy @changed_files;

10544N/Amy $changed_files_string;

10544N/Amy %changed_line_ranges;

10544N/Amy %function_lists;

10544N/Amy @conflict_files;

10728N/A

10728N/Amy $SVN = "svn";

10728N/A

10728N/Aprint STDERR " Running 'svn status' to find changed, added, or removed files.\n";

10844N/Aopen UPDATE, "$SVN status 2> /dev/stdout |" or die "The svn status failed: $!.\n";

10844N/Awhile (<UPDATE>)

10844N/A {

12653N/A if (/^[MA].+\s+(.+)$/)

12653N/A {

12653N/A my $file = $1;

11920N/A $function_lists{$file} = "";

13301N/A push @changed_files, $file if $file ne "ChangeLog";

13301N/A }

14531N/A

13301N/A push @conflict_files, $1 if /^C.+\s+(.+)$/;

13301N/A

13301N/A $function_lists{$1} = " Added." if /^A.+\s+(.+)$/;

13301N/A $function_lists{$1} = " Removed." if /^D.+\s+(.+)$/;

13301N/A $function_lists{$1} = " Replaced." if /^R.+\s+(.+)$/;

13729N/A

13729N/A print unless /^[A-Z]/;

13729N/A }

13688N/Aclose UPDATE;

14514N/A

14514N/Aif (@conflict_files)

14514N/A {

14514N/A print STDERR " The following files have conflicts. Run prepare-ChangeLog again after fixing the conflicts:\n";

10139N/A print STDERR join("\n", @conflict_files), "\n";

10139N/A exit 1;

10139N/A }

10139N/A

10139N/Aif (@changed_files)

10139N/A {

10139N/A $changed_files_string = "'" . join ("' '", @changed_files) . "'";

10139N/A

10139N/A # For each file, build a list of modified lines.

10139N/A # Use line numbers from the "after" side of each diff.

10139N/A print STDERR " Running 'svn diff' to determine which lines changed.\n";

10139N/A my $file;

10139N/A open DIFF, "$SVN diff --diff-cmd diff -x -N $changed_files_string |" or die "The svn diff failed: $!.\n";

10139N/A while (<DIFF>)

10139N/A {

10139N/A $file = $1 if /^Index: (\S+)$/;

10139N/A if (defined $file) {

10139N/A if (/^\d+(,\d+)?[acd](\d+)(,(\d+))?/) {

10139N/A push @{$changed_line_ranges{$file}}, [ $2, $4 || $2 ];

10139N/A } elsif (/DO_NOT_COMMIT/) {

10139N/A print STDERR "WARNING: file $file contains the string DO_NOT_COMMIT, line $.\n";

10139N/A }

10139N/A }

10139N/A }

10139N/A close DIFF;

10139N/A }

10139N/A

10139N/Aif (%changed_line_ranges)

10139N/A {

10139N/A print STDERR " Extracting affected function names from source files.\n";

10139N/A foreach my $file (keys %changed_line_ranges)

10139N/A {

10139N/A # Only look for function names in .c files.

10139N/A next unless $file =~ /\.(c|cpp|m|mm|h|java)/;

10139N/A

10139N/A # Find all the functions in the file.

10139N/A open SOURCE, $file or next;

10139N/A my @function_ranges = get_function_line_ranges(\*SOURCE, $file);

10139N/A close SOURCE;

10139N/A

10139N/A # Find all the modified functions.

10139N/A my @functions;

10139N/A my %saw_function;

10139N/A my @change_ranges = (@{$changed_line_ranges{$file}}, []);

10139N/A my @change_range = (0, 0);

10139N/A FUNCTION: foreach my $function_range_ref (@function_ranges)

10139N/A {

10139N/A my @function_range = @$function_range_ref;

10139N/A

10139N/A # Advance to successive change ranges.

10139N/A for (;; @change_range = @{shift @change_ranges})

10139N/A {

10139N/A last FUNCTION unless @change_range;

10139N/A

10139N/A # If past this function, move on to the next one.

10139N/A next FUNCTION if $change_range[0] > $function_range[1];

10139N/A

10139N/A # If an overlap with this function range, record the function name.

10139N/A if ($change_range[1] >= $function_range[0]

10139N/A and $change_range[0] <= $function_range[1])

10139N/A {

10139N/A if (!$saw_function{$function_range[2]})

10139N/A {

10139N/A $saw_function{$function_range[2]} = 1;

10139N/A push @functions, $function_range[2];

10139N/A }

10139N/A next FUNCTION;

10139N/A }

10139N/A }

10466N/A }

10139N/A

10544N/A # Format the list of functions now.

10728N/A

10844N/A if (@functions) {

12653N/A $function_lists{$file} = "" if !defined $function_lists{$file};

13301N/A $function_lists{$file} .= "\n (" . join("):\n (", @functions) . "):";

13301N/A }

13301N/A }

13729N/A }

13729N/A

13729N/Aif (!%function_lists)

14514N/A {

10139N/A print STDERR " No changes found.\n";

10139N/A exit 1;

10139N/A }

10139N/A

10139N/Amy $date = sprintf "%d-%02d-%02d",

10139N/A 1900 + (localtime $^T)[5], # year

10139N/A 1 + (localtime $^T)[4], # month

10139N/A (localtime $^T)[3]; # day within month

10139N/Amy $name = $ENV{CHANGE_LOG_NAME}

10139N/A || $ENV{REAL_NAME}

10139N/A || (getpwuid $<)[6]

10139N/A || "set REAL_NAME environment variable";

10139N/Amy $email_address = $ENV{CHANGE_LOG_EMAIL_ADDRESS}

10139N/A || $ENV{EMAIL_ADDRESS}

10139N/A || "set EMAIL_ADDRESS environment variable";

10139N/A

10139N/A$name =~ s/\(.*?\)\s*$//g;

10139N/A

10139N/Amy %has_log;

10139N/Amy %files;

10139N/Aforeach my $file (sort keys %function_lists)

10139N/A {

10139N/A my $prefix = $file;

10139N/A my $has_log = 0;

10139N/A while ($prefix)

10139N/A {

10139N/A $prefix =~ s-/[^/]+/?$-/- or $prefix = "";

10465N/A $has_log = $has_log{$prefix};

10139N/A if (!defined $has_log)

10139N/A {

10139N/A $has_log = -f "${prefix}ChangeLog";

10139N/A $has_log{$prefix} = $has_log;

10139N/A }

10139N/A last if $has_log;

10139N/A }

10139N/A if (!$has_log)

10139N/A {

10139N/A print STDERR "No ChangeLog found for $file.\n";

10139N/A }

10139N/A else

10139N/A {

10139N/A push @{$files{$prefix}}, $file;

10139N/A }

10139N/A }

10139N/A

10139N/Amy $logs = "";

10139N/Aforeach my $prefix (sort keys %files)

10139N/A {

10139N/A $logs .= " ${prefix}ChangeLog";

10139N/A }

10139N/Aif ($logs)

10139N/A {

10139N/A print STDERR " Running 'svn update' to update ChangeLog files.\n";

10139N/A open ERRORS, "$SVN update -q$logs |" or die "The svn update of ChangeLog files failed: $!.\n";

10139N/A print STDERR " $_" while <ERRORS>;

10139N/A close ERRORS;

10139N/A }

10139N/A

10139N/Aforeach my $prefix (sort keys %files)

10139N/A {

10139N/A print STDERR " Editing the ${prefix}ChangeLog file.\n";

10139N/A open OLD_CHANGE_LOG, "${prefix}ChangeLog" or die "Could not open ${prefix}ChangeLog file: $!.\n";

10139N/A # It's less efficient to read the whole thing into memory than it would be

10139N/A # to read it while we prepend to it later, but I like doing this part first.

10139N/A my @old_change_log = <OLD_CHANGE_LOG>;

10139N/A close OLD_CHANGE_LOG;

10139N/A open CHANGE_LOG, "> ${prefix}ChangeLog" or die "Could not write ${prefix}ChangeLog\n.";

10139N/A print CHANGE_LOG "$date $name <$email_address>\n\n";

10139N/A print CHANGE_LOG " Reviewed by NOBODY (OOPS!).\n\n";

10139N/A if ($prefix =~ m/WebCore/ || `pwd` =~ m/WebCore/) {

10139N/A my $testsDir = "../LayoutTests";

10139N/A $testsDir = "$prefix/$testsDir" if length($prefix);

10139N/A my $haveNewTests = (-x "$testsDir/../LayoutTests" && `svn diff \"$testsDir/../LayoutTests\"`);

10139N/A print CHANGE_LOG " WARNING: NO TEST CASES ADDED OR CHANGED\n\n" unless $haveNewTests;

10139N/A }

10139N/A

10139N/A foreach my $file (sort @{$files{$prefix}})

10139N/A {

10139N/A my $file_stem = substr $file, length $prefix;

10139N/A print CHANGE_LOG " * $file_stem:$function_lists{$file}\n";

10139N/A }

10139N/A print CHANGE_LOG "\n", @old_change_log;

10139N/A close CHANGE_LOG;

10139N/A }

10139N/A

10139N/Aif ($spewDiff && @changed_files)

10139N/A {

10544N/A print STDERR " Running 'svn diff' to help you write the ChangeLog entries.\n";

10544N/A open DIFF, "$SVN diff $changed_files_string |" or die "The svn diff failed: $!.\n";

10544N/A while (<DIFF>) { print; }

10550N/A close DIFF;

10550N/A }

10550N/A

10550N/Aif ($openChangeLogs && $logs)

10550N/A {

10139N/A print STDERR " Opening the edited ChangeLog files.\n";

10139N/A my $editor = $ENV{"CHANGE_LOG_EDIT_APPLICATION"};

10139N/A if ($editor) {

10139N/A system "open -a '$editor'$logs";

10139N/A } else {

10139N/A system "open -e$logs";

10139N/A }

10139N/A }

10139N/A

10139N/Aexit;

10139N/A

10139N/Asub get_function_line_ranges

10139N/A {

10139N/A my ($file_handle, $file_name) = @_;

10139N/A

10139N/A if ($file_name =~ /\.(c|cpp|m|mm|h)$/) {

10139N/A return get_function_line_ranges_for_c ($file_handle, $file_name);

10139N/A } elsif ($file_name =~ /\.java$/) {

10139N/A return get_function_line_ranges_for_java ($file_handle, $file_name);

10139N/A }

10139N/A return ();

10139N/A }

10139N/A

10139N/A

10139N/Asub method_decl_to_selector

10139N/A {

10139N/A (my $method_decl) = @_;

10139N/A

10358N/A $_ = $method_decl;

15168N/A

15168N/A if ((my $comment_stripped) = m-([^/]*)(//|/*).*-)

15168N/A {

14526N/A $_ = $comment_stripped;

14526N/A }

14526N/A

14514N/A s/,\s*...//;

13688N/A

13688N/A if (/:/)

13600N/A {

13600N/A my @components = split /:/;

13301N/A pop @components if (scalar @components > 1);

13301N/A $_ = (join ':', map {s/.*[^[:word:]]//; scalar $_;} @components) . ':';

12991N/A } else {

12991N/A s/\s*$//;

12940N/A s/.*[^[:word:]]//;

12940N/A }

12653N/A

12653N/A return $_;

12496N/A }

12496N/A

11999N/A

11999N/A

11851N/A

11851N/Asub get_function_line_ranges_for_c

11004N/A {

11004N/A my ($file_handle, $file_name) = @_;

10947N/A

10947N/A my @ranges;

10844N/A

10844N/A my $in_comment = 0;

10844N/A my $in_macro = 0;

10728N/A my $in_method_declaration = 0;

10728N/A my $in_parentheses = 0;

10550N/A my $in_braces = 0;

10550N/A my $brace_start = 0;

10544N/A my $brace_end = 0;

10544N/A my $skip_til_brace_or_semicolon = 0;

10509N/A

10509N/A my $word = "";

10465N/A my $interface_name = "";

10466N/A

10466N/A my $potential_method_char = "";

10466N/A my $potential_method_spec = "";

10465N/A

10465N/A my $potential_start = 0;

10359N/A my $potential_name = "";

10354N/A

10275N/A my $start = 0;

10275N/A my $name = "";

10254N/A

10254N/A my $next_word_could_be_namespace = 0;

10162N/A my $potential_namespace = "";

10162N/A my @namespaces;

10139N/A

10139N/A while (<$file_handle>)

10139N/A {

10139N/A # Handle continued multi-line comment.

10139N/A if ($in_comment)

10139N/A {

10139N/A next unless s-.*\*/--;

10139N/A $in_comment = 0;

10139N/A }

10139N/A

10139N/A # Handle continued macro.

10139N/A if ($in_macro)

10139N/A {

10139N/A $in_macro = 0 unless /\\$/;

10139N/A next;

10139N/A }

10139N/A

10139N/A # Handle start of macro (or any preprocessor directive).

10139N/A if (/^\s*\#/)

10139N/A {

10139N/A $in_macro = 1 if /^([^\\]|\\.)*\\$/;

10139N/A next;

10139N/A }

10139N/A

10139N/A # Handle comments and quoted text.

10139N/A while (m-(/\*|//|\'|\")-) # \' and \" keep emacs perl mode happy

10139N/A {

10139N/A my $match = $1;

10139N/A if ($match eq "/*")

10139N/A {

10139N/A if (!s-/\*.*?\*/--)

10139N/A {

10139N/A s-/\*.*--;

10139N/A $in_comment = 1;

10139N/A }

10139N/A }

10139N/A elsif ($match eq "//")

10139N/A {

10139N/A s-//.*--;

10139N/A }

10139N/A else # ' or "

10139N/A {

10139N/A if (!s-$match([^\\]|\\.)*?$match--)

10139N/A {

10139N/A warn "mismatched quotes at line $. in $file_name\n";

10139N/A s-$match.*--;

10139N/A }

10139N/A }

10139N/A }

10139N/A

10139N/A

10139N/A # continued method declaration

10139N/A if ($in_method_declaration)

10139N/A {

10139N/A my $original = $_;

10139N/A my $method_cont = $_;

10139N/A

10139N/A chomp $method_cont;

10139N/A $method_cont =~ s/[;\{].*//;

10139N/A $potential_method_spec = "${potential_method_spec} ${method_cont}";

10139N/A

10139N/A $_ = $original;

10139N/A if (/;/)

10139N/A {

10139N/A $potential_start = 0;

10139N/A $potential_method_spec = "";

10139N/A $potential_method_char = "";

10139N/A $in_method_declaration = 0;

10139N/A s/^[^;\{]*//;

10139N/A } elsif (/{/) {

10139N/A my $selector = method_decl_to_selector ($potential_method_spec);

10139N/A $potential_name = "${potential_method_char}\[${interface_name} ${selector}\]";

10139N/A

10139N/A $potential_method_spec = "";

10139N/A $potential_method_char = "";

10139N/A $in_method_declaration = 0;

10139N/A

10139N/A $_ = $original;

10139N/A s/^[^;{]*//;

10139N/A } else {

10139N/A next;

10139N/A }

10139N/A }

10139N/A

10139N/A

10139N/A # start of method declaration

10139N/A if ((my $method_char, my $method_spec) = m&^([-+])([^0-9;][^;]*);?$&)

10139N/A {

10139N/A my $original = $_;

10139N/A

10139N/A if ($interface_name)

10139N/A {

10139N/A chomp $method_spec;

10139N/A $method_spec =~ s/\{.*//;

10139N/A

10139N/A $potential_method_char = $method_char;

10139N/A $potential_method_spec = $method_spec;

10139N/A $potential_start = $.;

10139N/A $in_method_declaration = 1;

10139N/A } else {

10139N/A warn "declaring a method but don't have interface on line $. in $file_name\n";

10139N/A }

$_ = $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/^[^{]*//;

} 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;

}

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;

}