[SCRIPT] fixdates: script for updating copyright notices

[Kevin Buettner <kevinb at cygnus dot com>]

I recently committed a patch which updates and corrects many of the
copyright notices in files that make up the GDB sources.  The patch
may be found at:

    http://sources.redhat.com/ml/gdb-patches/2001-03/msg00100.html

The script below was used to generate these changes.

--- fixdates ---
#!/usr/bin/perl -w

# fixdates - Fix dates in copyright notices based upon ChangeLog entries
#
# Copyright 2001 Free Software Foundation, Inc.
#
# This file is free software; as a special exception the author gives
# unlimited permission to copy and/or distribute it, with or without
# modifications, as long as this notice is preserved.
#
# This program is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY, to the extent permitted by law; without even the
# implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.

# Written by Kevin Buettner <kevinb@redhat.com>
# Version 0.02

use Date::Manip;
use File::Basename;
use Getopt::Long;
use English;
use File::Find;

my $show_only;

# Get user supplied options; the only one defined for this program
# is --show-only which limits this script to scanning ChangeLog
# entries and printing the years associated with each file found.
GetOptions('show-only!'	=> \$show_only);

# After the options are disposed of, the first argument is the root.
my ($root) = @ARGV;

# Print a minimal usage message if the wrong number of arguments
# are supplied to the script.
if (!defined($root) || @ARGV > 1) {
    die "Usage: $0 root\n";
}

# Construct a hash of predetermined filenames to exclude from
# consideration in GDB sources.  These are either files that a
# maintainer has requested not be touched or are generated files.
#
# The latter files in this list (beginning with COPYING) are ones that
# Michael Chastain identified as ones that should not be touched by
# this script during his proofreading of these patches.  For details
# regarding each of these files, see: 
#   http://sources.redhat.com/ml/gdb-patches/2001-03/msg00058.html

my %exclude_files = map(("$root/$_", 1), qw {
    go32-nat.c
    ser-go32.c
    config/djgpp/README
    config/djgpp/config.sed
    config/djgpp/djcheck.sh
    config/djgpp/djconfig.sh
    config/djgpp/fnchange.lst
    config/i386/go32.mh
    config/i386/go32.mt
    config/i386/nm-go32.h
    config/i386/tm-go32.h
    config/i386/xm-go32.h

    configure
    doc/configure
    gdbserver/configure
    nlm/configure
    rdi-share/configure
    testsuite/configure
    testsuite/gdb.asm/configure
    testsuite/gdb.base/configure
    testsuite/gdb.c++/configure
    testsuite/gdb.chill/configure
    testsuite/gdb.disasm/configure
    testsuite/gdb.hp/gdb.aCC/configure
    testsuite/gdb.hp/configure
    testsuite/gdb.hp/gdb.base-hp/configure
    testsuite/gdb.hp/gdb.compat/configure
    testsuite/gdb.hp/gdb.defects/configure
    testsuite/gdb.hp/gdb.objdbg/configure
    testsuite/gdb.hp/gdb.threads-hp/configure
    testsuite/gdb.java/configure
    testsuite/gdb.mi/configure
    testsuite/gdb.stabs/configure
    testsuite/gdb.threads/configure
    testsuite/gdb.trace/configure

    gdbarch.c
    gdbarch.h

    COPYING
    config/m32r/tm-m32r.h
    config/m68k/tm-delta68.h
    doc/gdbgui.texinfo
    expression.h
    testsuite/config/netware.exp
    testsuite/gdb.base/gdbvars.exp
    testsuite/gdb.base/langs.exp
    testsuite/gdb.base/return.exp
    testsuite/gdb.c++/cplusfuncs.exp
    testsuite/gdb.c++/demangle.exp
    testsuite/gdb.c++/ovldbreak.exp
    testsuite/gdb.disasm/sh3.exp
    testsuite/gdb.fortran/exprs.exp
    testsuite/gdb.threads/pthreads.exp
    typeprint.h
    valprint.h
});

# Reset the argument vector to the empty list.
@ARGV = ();

# Find all ChangeLog files; the paths to these files will be
# pushed onto @ARGV.
find(
    sub { 
	if (-f && -T && /^ChangeLog/) {
	    push @ARGV, $File::Find::name;
	}
    },
    $root
);

# Scan ChangeLog files looking for files and dates

my %cldat;
my ($date, $year);

$/ = "";					# slurp paragraphs

while (<>) {
    if (not defined $dirprefix) {
	$dirprefix = dirname($ARGV);
	if ($dirprefix eq '.') {
	    $dirprefix = '';
	}
	else {
	    $dirprefix =~ s#^\./##;
	    $dirprefix .= '/';
	}
    }

    chomp;

    my ($name, $email, $datestr);
    if (($datestr, $name, $email)
          =  / ^((?:\w.* (?:19|20)\d\d)|(?:\d\d\d\d-\d\d-\d\d))
	  					# Date
               \s+				# spaces
	       (\S+(?:\s+\S+)*)			# name
	       \s+				# spaces
	       [(<] ([^)>]*)			# email address
	     /x                   ) {

	$date = ParseDateString($datestr);
	$year = UnixDate ($date, "%Y");

	# We won't be able to get a year out of a malformed date; if
	# this happens, we'll examine the date string to try to determine
	# the year.
	if (!defined $year) {
	    ($year) = $datestr =~ /((?:19|20)\d\d)/;
	}
    }
    else {
	my $filenames;
	my $do_tabulate = 0;
	my $para = $_;
	while ($para =~ /^\s+			# leading spaces
	                  \*			# star
			  \s+			# trailing star spaces
			  ([^(:]+?)		# Filenames
			  (?:			# Stop when we get to a
			     [(:]		# paren or a colon
			   |			#  or a...
			     \s			# space and a
			     \[			# left square bracket.
		          )
			/mxg)
	{
	    $filenames = $1;

	    $filenames =~ s/\n//g;		# nuke newlines
	    $filenames =~ s/\s+$//;		# remove trailing spaces

	    # Kill spaces after commas used in curly brace expansions.
            while ($filenames =~ s/({[^}]*),\s+/$1,/) {}

	    # Attempt to handle case in which filenames are (erroneously)
	    # not comma separated.  If there are no commas presently
	    # in the filename string and over half of the space
	    # separated "words" have a dot in the middle of them, they're
	    # considered a list of filenames.
	    if ($filenames !~ /,/) {
		my @spsplit = split /\s+/, $filenames;
		my @dotnames = grep /\.\w/, @spsplit;
		if (@spsplit && scalar(@dotnames) / scalar(@spsplit) >= 0.5) {
		    $filenames = join (', ', @spsplit);
		}
	    }

	    # Get list of file names.
	    my @filenames = map(expand_name($_), split( /,\s+/, $filenames));

	    # Discard names with spaces or other characters which
	    # aren't used in filenames in the GDB sources.
	    @filenames = grep !/[\s"'%]/, @filenames;

	    foreach my $fname (@filenames) {
		$cldat{"$dirprefix$fname"}{$year}++;
	    }
	}

    }

    if (eof) {
	$dirprefix = undef;
	close(ARGV);
    }
}


# Show only the names and dates if that's what the user requested
if ($show_only) {
    foreach my $fname (sort keys %cldat) {
	print "$fname: ", join (', ', (sort keys %{$cldat{$fname}})), "\n";
    }
    exit 0;
}


# Weed out and warn about the names that don't exist or that we've
# intentionally decided to exclude; build new ARGV vector from those
# that seem okay
@ARGV = ();
foreach my $fname (sort keys %cldat) {
    if (-e $fname) {
	push @ARGV, $fname	if (-f $fname && !$exclude_files{$fname});
    }
    else {
	print STDERR "Warning: File ``$fname'' does not exist.\n"
    }
}

# Fix the copyright notices in the remaining files

$INPLACE_EDIT = '';				# modify files in place
undef $/;					# slurp entire files

while (<>) {
    # Split buffer into two parts; the first fifteen lines had better
    # contain the copyright notice.
    my ($initial_lines, $remaining_lines) = m/\A((?:[^\n]*\n){0,15})(.*)\z/s;

    # See if the initial lines contain a copyright notice to fix
    if ($initial_lines =~ 
	    m/^					# beginning of a line
	      [^\n]*				# anything but a newline
	      \bCopyright\b
	      [^\n]*				# anything but newline
	      (?:\n[^\n]*){0,3}?		# up to three additional
	      					#  lines, non-greedy
	      \bFree\b
	      [^\n]*				# anything but newline
	      (?:\n[^\n]*?)??			# optional newline, plus
	      					#  portions of following line,
						#  non-greedy
	      \bSoftware\b
	      [^\n]*				# anything but newline
	      (?:\n[^\n]*?)??			# optional newline, plus
	      					#  following stuff, non-greedy
	      \bFoundation,?
	      (?:
	        [^\n]*				# anything but newline
	        (?:\n[^\n]*?)??			# optional newline, plus
	      					#  following stuff, non-greedy
	        \bInc\.
	      )?
	     /xsm)
    {
	# Now fix the copyright notice.
	$initial_lines =~ 
	    s{( ^				# beginning of line
	        [^\n]*				# anything but newline
		\bCopyright\b
		.*?				# anything, non-greedy
		\bFree\b
		.*?				# anything, non-greedy
		\bSoftware\b
		.*?
		\bFoundation,?
		(?:
		    .*?				# anything, non-greedy
		    \bInc\.
		)?				# Inc. portion optional
		[^\n]*				# anything but newline
		$				# end of line
		              )}
	     { fix_copyright($1, $ARGV) }xsme;
    }
    elsif ($initial_lines ne "") {
	# Warn about (possible) bad or missing copyright notice.
	print STDERR "Warning: Check $ARGV for missing or malformed copyright notice.\n";
    }
    # Write the buffer back out and go onto the next file.
    print $initial_lines, $remaining_lines;
}

# Given a "glob" name, expand it into a list of equivalent names.
sub expand_name {
    my ($name) = @_;

    my ($prefix, $expansion, $suffix);

    if (($prefix, $to_expand, $suffix) = 
         ($name =~ /^ 
	            ([^{]*]*)			# prefix
	            {				# left curly
		    ([^}]+)			# stuff to expand
                    }				# right curly
		    (.*)			# suffix
		    $/x))
    {
	return map(expand_name($prefix . $_ . $suffix),
	           split(/,\s*/, $to_expand));
    }
    elsif (($prefix, $to_expand, $suffix) =
            ($name =~ /^ 
	               ([^{]*]*)		# prefix
	               \[			# left bracket
		       ([^\]]+)			# stuff to expand
                       \]			# right bracket
		       (.*)			# suffix
		       $/x))
    {
	return map(expand_name($prefix . $_ . $suffix),
	           split(/\0*/, $to_expand));
    }
    else {
	return $name;
    }
}

# Construct a corrected/updated copyright notice
sub fix_copyright {
    my ($note, $fname) = @_;
    my ($prefix1, $prefix2, $years);

    ($prefix1, $years, $prefix2) = 
	$note =~ /^(.*)
	           Copyright
		   (.*?)
		   ([^0-9]*)
		   Free
		   \s+ (?:\1)? \s*
		   Software
		   \s+ (?:\1)? \s*
		   Foundation
		   /sx;
    # Return the original note unchanged if the above match failed.
    if (!defined($prefix1) || !defined($prefix2) || !defined($years)) {
	print STDERR "Warning: Unsuccessful match in fix_copyright for $fname\n";
        return $note;
    }

    # Remove anything from the year string that is not a comma, digit, or
    # hyphen
    $years =~ s/[^0-9,-]//g;

    # Figure out which dates are already in the copyright notice
    my %years = ();

    foreach my $yearspec (split /,/, $years) {
	if ($yearspec =~ /^(\d+)-(\d+)$/) {
	    my ($initial, $final) = ($1, $2);
	    foreach ($initial, $final) {
		$_ = "19" . $_ 		if length == 2;
	    }
	    if ($initial > $final) {
		($initial, $final) = ($final, $initial);
	    }
	    next if ($initial < 1980);
	    next if ($final > 2001);
	    my $year;
	    for ($year = $initial; $year <= $final; $year++) {
		$years{$year} = 1;
	    }
	}
	else {
	    $yearspec = "19" . $yearspec if length($yearspec) == 2;
	    next if $yearspec < 1980 || $yearspec > 2001;
	    $years{$yearspec} = 1;
	}
    }

    my @newyears = sort keys %{$cldat{$fname}};
    my @oldyears = sort keys %years;

    # Discard ChangeLog years that are older than the oldest year
    # in the original copyright notice.  The reason for this is
    # that if the file is rewritten, the notice may have been
    # updated by hand to reflect this fact.  Also, it's possible
    # for a file to have been deleted and then years later reconstructed.
    if (@oldyears) {
	@newyears = grep($_ >= $oldyears[0], @newyears);
    }

    # Discard original copyright years that are newer than
    # the oldest entry found in the ChangeLog.  This allows
    # us to construct a more accurate list.
    if (@newyears) {
	@oldyears = grep($_ < $newyears[0], @oldyears);
    }

    @newyears = (@oldyears, @newyears);

    my $newcopyright = '';

    # Handle cases where the Copyright notice doesn't start on
    # its own line in .h and .c files.
    if ($fname =~ /\.[hc]$/ && $prefix1 =~ /\S/ && length $prefix1 > 10) {
	$prefix1 =~ s/\s+$//;
	$newcopyright .= $prefix1;
	$prefix1 =~ s/^(\s*)\S.*/$1/
    }
    my $line = $prefix1 . "Copyright ";

    # If the prefix contains a C-style comment, then blank it out
    # for subsequent lines
    $prefix1 =~ s/\/\*/  /;

    foreach my $year (@newyears) {
	if (length $line > 70) {
	    $newcopyright .= "\n"	if $newcopyright;
	    $line =~ s/ $//;
	    $newcopyright .= $line;
	    $line = $prefix1;
	}
	$line .= "$year, ";
    }
    $line =~ s/, $//;
    my $fsfi = "Free Software Foundation, Inc.";
    $newcopyright .= "\n"	if $newcopyright;
    if ($prefix2 =~ /\n/ || length($line) + length($fsfi) > 76) {
	$newcopyright .= $line . "\n" . $prefix1 . $fsfi;
    }
    else {
	$newcopyright .= $line . " " . $fsfi;
    }

    # Now handle the case of some other notice that occurred prior
    # to finding "Free Software Foundation, Inc."
    $prefix2 =~ s/^\s+//;		# nuke leading spaces
    $prefix2 =~ s/^\s$//;		# nuke trailing spaces
    if (length($prefix2) > length($prefix1)) {
	$newcopyright .= "\n" . $prefix1 . $prefix2;
    }

    return $newcopyright;
}
--- end fixdates ---