(C) 1998-2005 for 5.1
Kevin Buettner
kevinb@cygnus.com
Wed Feb 28 00:27:00 GMT 2001
On Feb 27, 12:52pm, Andrew Cagney wrote:
> One of the things for 5.1 is to re-do my (incorrect) change that
> converted 98, 99, 2001 to 1998-2001 [sic]. It should have been changed
> to 1998, 1999, 2000, 2001 (even `sic'er :-)
>
> One stumbling block on this, was being certain that the above mistake
> didn't occure.
>
> So a question (and I guess a challenge for the script kiddles :-).
>
> Can gdb/ChangeLog* be used as a source for the correct copyright
> information? That is, if ChangeLog says that file (foo.c) was changed
> then ``foo.c'' should have the year of that ChangeLog entry. The other
> potential source of this information is Red Hat's old GDB CVS
> repository.
See the script ``fixdates'' appended at the bottom of this message.
This script must be supplied a directory name. It will recursively
scan for ChangeLog* files in that directory and construct a list
of all of the files mentioned by these ChangeLog files along with
the years that these files were touched.
After pruning out the garbage and the non-existent files from the
list, it visits each file and updates the copyright notice as
follows:
1) At a minimum, it will always use the dates (year) found
by scanning the ChangeLog files.
2) Any existing date information in the copyright notice which
predates the earliest year found in the ChangeLog is also
used in constructing the new notice. This accomodates
situations where a file has been moved or renamed or is
constructed largely from an existing file.
In addition, to making the above changes, it will print out
warnings regarding files mentioned in the ChangeLogs that couldn't
be found. There are a lot of these warnings and I doubt they're
very meaninful since a lot of code has come and gone over the years.
Some of these warnings are also due to reorganization.
The more serious warnings that it prints concern those files
with malformed or missing copyright notices. In some cases,
there *shouldn't* be any copyright, e.g, with example stub
files. In any case, I'll try to address the meaninful warnings
as a future activity.
The script may be given an optional flag ``--show-only''. If this
flag is given, the ChangeLog files are scanned and the file and date
information is printed, but no changes are made to any files in the
directory. This was used to help debug the script. It could also
be used to help generated the date information for missing or
malformed copyright notices. (For missing notices, I will likely
use a similar script.)
I will post a patch to gdb-patches shortly. I've proofread perhaps
a third of it and spot checked the rest and it looks reasonable.
--- fixdates ---
#!/usr/bin/perl -w
# Fix dates in copyright notices based upon ChangeLog entries
use Date::Manip;
use File::Basename;
use Getopt::Long;
use English;
use File::Find;
my $show_only;
GetOptions('show-only!' => \$show_only);
my ($root) = @ARGV;
if (!defined($root)) {
die "Usage: $0 root\n";
}
@ARGV = ();
# Find all ChangeLog files
find(
sub {
if ($_ eq 'testsuite' || $_ eq 'gdbserver' || (-d && /-share$/)) {
$File::Find::prune = 1;
} elsif (-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
\[ # right 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,/) {}
# 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 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; 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);
}
else {
print STDERR "Warning: File ``$fname'' does not exist.\n"
}
}
# Fix the copyright notices in the remaining files
$INPLACE_EDIT = '';
undef $/; # slurp entire files
while (<>) {
my ($initial_lines, $remaining_lines) = m/\A((?:[^\n]*\n){0,15})(.*)\z/s;
if ($initial_lines =~
m/^[^\n]*\bCopyright\b.*?\bFree\s+Software\s+Foundation[^\n]*$/xsm) {
$initial_lines =~
s{(^[^\n]*\bCopyright\b.*?\bFree\s+Software\s+Foundation[^\n]*$)}
{ fix_copyright($1, $ARGV) }xsme;
}
elsif ($initial_lines ne "") {
print STDERR "Warning: Check $ARGV for missing or malformed copyright notice.\n";
}
print $initial_lines, $remaining_lines;
}
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;
}
}
# Return an updated copyright notice
sub fix_copyright {
my ($note, $fname) = @_;
my ($prefix1, $prefix2, $years);
($prefix1, $years, $prefix2) =
$note =~ /^(.*)Copyright(.*?)([^0-9]*)Free\s+Software\s+Foundation/s;
# 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;
@oldyears = grep($_ < $newyears[0], @oldyears);
@newyears = (@oldyears, @newyears);
my $newcopyright = '';
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;
}
return $newcopyright;
}
--- end fixdates ---
More information about the Gdb
mailing list