Handle all common boilerplate cases in src/,

leaving about a dozen known exceptions.

Report copyright-related claims if a recognized boilerplate containing them is
going to be replaced with a standard one. These claims should then be cross
referenced with CONTRIBUTORS and CREDITS, updating those files if needed.
Boilerplates should not contain variable information, such as individual
copyright claims.

Leave DEBUG section information as a separate comment.

Improved error reporting.

diff --git a/scripts/source-mangler.pl b/scripts/source-mangler.pl
index c042695a22abdb1bd0a44780395d80ff60ff15ba..4c4907c5f04a658ae43f87bda34d5eb3ffd98375 100755 (executable)
--- a/scripts/source-mangler.pl
+++ b/scripts/source-mangler.pl
@@ -15,43 +15,112 @@ my ($BoilerName, @FileNames) = @ARGV;
 
 my $CorrectBoiler = `cat $BoilerName` or
        die("cannot load boilerplate from $BoilerName: $!, stopped");
-$CorrectBoiler = &trimL(&trimR($CorrectBoiler));
+$CorrectBoiler = &trimL(&trimR($CorrectBoiler)) . "\n\n";
+
+# the first /* comment */
+my $reComment = qr{
+       /\*.*?\*/
+}xs;
+
+# Debugging section inside a boilerplate comment
+my $reDebug = qr{
+       ^[\s*]*(DEBUG:.*?)$
+}mx;
+
+# Copyright-related claims inside a boilerplate comment
+my $reClaims = qr{
+       (
+               (?:AUTHOR\b|                            # either author 
+                COPYRIGHT\b(?!\sfile))         # or copyright (except "COPYRIGHT file")
+               .*?                                                     # and the claim content itself
+        )$
+}xmi;
+
+# The most common GPL text
+my $strGpl = 
+       "This program is free software; you can redistribute it and/or modify.*?".
+       "Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111, USA.";
+my $reGpl = qr{$strGpl}s;
+
 
 my $FileName; # for Warn()ings
+my %ReportedClaims; # to minimize noise in claims reporting
 
 # process each file in-place; do not touch files on known failures
 foreach my $fname (@FileNames) {
 
        $FileName = $fname;
-       my $code = &readFile($fname);
+       my $code = &readFile($fname) or next;
        my $virginCode = $code;
 
-       &Warn("Correct boilerplate already present, skipping"), next if
+       &Warn("Correct boilerplate already present, skipping:", $code), next if
                $code =~ /\Q$CorrectBoiler\E/s;
 
-       # Look for the current boiler, which may be absent.
        my $boiler;
 
-       # The first /* comment */ before a preprocessor instruction is a boiler.
-       my $re = qr{
-               ^\s*         # optional whitespace before the comment
-               (/\*.*?\*/)  # the first comment itself
-               [^#]*        # optional non-preprocessor code after the comment
-               [#]          # followed by a preprocessor instruction
-       }xs;
-
-       $re = qr{
-               (/\*.*?\*/)  # a comment
-       }xs;
-
-       if ($code =~ s/$re/$CorrectBoiler/) {
-               # updated!
-               # TODO: if $& contains a DEBUG section, add it after the boiler.
-       } else {
-               # TODO: we should try other patterns before giving up
+       if ($code =~ m/$reComment/) {
+               my $beforeComment = $`;
+               my $comment = $&;
+
+               # Is the matched comment a boilerplate?
+               if ($comment !~ m/\n/) {
+                       # A single line comment is not a boilerplate.
+               } elsif ($beforeComment =~ m/\#include/) {
+                       # A comment after include is not a boilerplate.
+               } elsif ($comment =~ m/numerous individuals/) {
+                       $boiler = $comment;
+               } elsif ($comment =~ m@^/\*\*\s@){
+                       # A Doxygen comment is not a boilerplate.
+               } elsif ($comment =~ m/internal declarations|stub file|unit test/i) {
+                       # These relatively common comments are not boilerplates.
+               } else {
+                       my $tmp = $comment;
+                       # Remove common text to detect an otherwise empty boilerplate.
+                       $tmp =~ s/$reDebug//;
+                       $tmp =~ s/$reGpl//;
+                       $tmp =~ s/$reClaims//g;
+                       $tmp =~ s/^[\s*]*(Created on.*?)$//mig;
+                       if ($tmp =~ m@[^\s*/]@) { # not empty
+                               &Warn("Unrecognized boilerplate, skipping:", $comment);
+                               next;
+                       } else {
+                               # This is an empty boiler.
+                               $boiler = $comment;
+                       }
+               }
+       }
 
-               &Warn("Cannot find old boilerplate, skipping");
-               next; # TODO: We should add a boilerplate instead of skipping
+       if (defined $boiler) {
+               my $debugStr = '';
+               if ($boiler =~ m/$reDebug/) {
+                       my $debug = $1;
+                       $debugStr = "/* $debug */\n\n";
+               }
+
+               my @claims = ($boiler =~ m/$reClaims/g);
+               if (my @newClaims = grep { !exists $ReportedClaims{$_} } @claims) {
+                       &Warn("New claim(s) found.");
+                       foreach my $claim (@newClaims) {
+                               warn("Claim: $claim\n");
+                               $ReportedClaims{$claim} = $fname;
+                       }
+               }
+
+               $code =~ s/$reComment//;
+               $code = &trimL($code);
+               $code = $CorrectBoiler . $debugStr . $code;
+       } else {
+               # Some files have license declarations way down in the code.
+               my $license = 
+                       "This program is free software|".
+                       "Permission to use, copy, modify|".
+                       "Redistribution and use in source and binary forms";
+               if ($code =~ m@($license).*?\*/@s) {
+                       &Warn("Suspected boilerplate in unusual location, skipping.", $`.$&);
+                       next;
+               }
+               &Warn("Cannot find old boilerplate, adding new boilerplate.", $code);
+               $code = $CorrectBoiler . $code;
        }
 
        &writeFile($fname, $code) unless $code eq $virginCode;
@@ -63,6 +132,11 @@ exit(0);
 sub readFile() {
        my ($fname) = @_;
 
+       if (!-f $fname) {
+               &Warn("Skipping directory or a special file.");
+               return undef();
+       }
+
        my $code = '';
        open(IF, "<$fname") or die("cannot open $fname: $!, stopped");
        while (<IF>) {
@@ -98,7 +172,10 @@ sub trimR {
 }
 
 sub Warn {
-       my ($msg) = @_;
-       $msg = sprintf("%s: WARNING: %s\n", $FileName, $msg) if defined $FileName;
+       my ($msg, $context) = @_;
+       $context = substr($context, 0, 1000) if defined $context;
+       $context .= "\n\n" if defined $context;
+       $context = '' unless defined $context;
+       $msg = sprintf("%s: WARNING: %s\n%s", $FileName, $msg, $context) if defined $FileName;
        warn($msg);
 }