This is the mail archive of the
gdb-patches@sources.redhat.com
mailing list for the GDB project.
[SCRIPT] fixdates: script for updating copyright notices
- To: gdb-patches at sources dot redhat dot com
- Subject: [SCRIPT] fixdates: script for updating copyright notices
- From: Kevin Buettner <kevinb at cygnus dot com>
- Date: Tue, 6 Mar 2001 01:40:25 -0700
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 ---