#!/usr/bin/perl

# Generate a ChangeLog file from a CVS log.
# Written by Robert Krawitz <rlk@alum.mit.edu>
# This code is in the public domain and may be used
# for any purpose.

use Getopt::Long;
Getopt::Long::Configure("bundling", "no_ignore_case", "pass_through");

use strict;

# Configuration options.
my $emailsuffix;
my $symbolic_name_regexp;
my (@ignoreprefix);
my $reverse = 0;
my $use_rcs_filename = 0;
my $print_each_file = 0;
my $print_time = 0;

GetOptions("e:s" => \$emailsuffix,
	   "X=s" => \@ignoreprefix,
	   "r!"  => \$reverse,
	   "R!"  => \$use_rcs_filename,
	   "v!"  => \$print_each_file,
	   "t!"  => \$print_time,
	   "s:s" => \$symbolic_name_regexp);

my %logmsgs = ();			# Index by date, time, and author
my %fileversions = ();
my $skipme = 0;
my %basenames = ();
my %plus = ();
my %minus = ();

my @cvsdirs=`find . -type d -name CVS -print`;
@cvsdirs = map { chomp; s,^\./,, } @cvsdirs;
foreach my $d (@cvsdirs) {
    if (open ENTRIES, "$d/Entries") {
	my ($rootdir) = $d;
	$rootdir =~ s/CVS$//;
	while (<ENTRIES>) {
	    my ($type, $file, $version, @junk) = split /\//;
	    if ($type eq "") {
		$basenames{"$file"} = "1";
		$file = "$rootdir$file";
		$fileversions{$file} = $version;
	    }
	}
	close ENTRIES;
    }
}

sub compare_versions($$)
{
    # vw: version of the working file
    # vl: version from the log
    # The idea is that we want versions on the current branch, on branches
    # leading to the current branch, and on the root prior to the current
    # branch.
    #
    # Example: the current file is 1.5.12.2.4.3
    #
    # We want versions:
    # 1.1
    # 1.2
    # 1.3
    # 1.4
    # 1.5
    # 1.5.12.1
    # 1.5.12.2
    # 1.5.12.2.4.1
    # 1.5.12.2.4.2
    # 1.5.12.2.4.3
    #
    # We look at the numbers in pairs.  The first number in each pair is
    # the branch number; the second number is the version on the branch.
    # The pairs are of the form (B, V).
    #
    # If the number of components in the log version is greater than the
    # number of components in the working version, we aren't interested.
    # This file cannot be a predecessor of the working version; it is
    # either a branch off the working version, or it is an entirely different
    # branch.
    #
    # We next iterate over all pairs in the log version.  The following must
    # be true for all pairs:
    #
    # Bw = Bl
    # Vw >= Vl
    #
    # Note that there's no problem if the number of components in the
    # working version exceeds the number of components in the log version.
    #
    # There is a special case: If the working version doesn't exist at all,
    # we return true if the log version is on the mainline.  This lets us
    # see log messages from files that have been deleted.
    #
    # Return value:
    #
    # 4 if there is no working version and the log version is at top level
    # 
    # 2 if there is no working version and the log version is not at top
    #   level
    #
    # 3 if the number of components in the log version exceeds the number
    #   of components in the working version
    #
    # 0 if the log version is later than or on a different branch from
    #   the working version
    #
    # 1 otherwise (if the log version is a predecessor of the working version)

    my ($vw, $vl) = @_;

    my (@vvl) = split(/\./, $vl);

    if ($vw eq "") {
	if ($#vvl < 2) {
	    return 2;
	} else {
	    return 4;
	}
    }

    my (@vvw) = split(/\./, $vw);
    if ($#vvl > $#vvw) {
	return 3;
    }

    my ($i);
    for ($i = 0; $i < $#vvl; $i += 2) {
	my ($bl) = $vvl[$i];
	my ($vl) = $vvl[$i + 1];
	my ($bw) = $vvw[$i];
	my ($vw) = $vvw[$i + 1];
	if ($bw != $bl || $vw < $vl) {
	    return 0;
	}
    }
    return 1;
}

my ($in_header) = 0;
my ($has_rcs_file) = 0;
my (%symbols);
my $revision;
my $ignore;
my ($skipfile);
my $currentfile;
my $currentbasefile;
my %symbols_printed = ();

while (<>) {
    if (/^RCS file: /) {
	next if (! $use_rcs_filename);
	$in_header = 1;
	$has_rcs_file = 1;
	chomp;
	$currentfile = $_;
	$currentfile =~ s,/RCS/,/,;
	$currentfile =~ s,^RCS file: *\./,,;
	$currentfile =~ s/,v$//;
	$currentfile =~ s/\s/\000/g;
	if (grep { $currentfile =~ /^$_/ } @ignoreprefix) {
	    $skipfile = 1;
	} else {
	    $skipfile = 0;
	}
	$symbols{$currentfile} = {};
	next;
    } elsif (/^Working file: /) {
	if ($has_rcs_file) {
	    $has_rcs_file = 0;
	    next;
	}
	$in_header = 1;
	chomp;
	($ignore, $ignore, $currentfile) = split(/\s+/, $_, 3);
	$currentfile =~ s/\s/\000/g;
	if (grep { $currentfile =~ /^$_/ } @ignoreprefix) {
	    $skipfile = 1;
	} else {
	    $skipfile = 0;
	}
	$symbols{$currentfile} = {};
	next;
    } elsif ($in_header && $_ =~ /^symbolic names:/) {
	while (<>) {
	    if (/^\s/) {
		my ($name, $revision) = split;
		$name =~ s/:$//;
		next if (! ($name =~ /$symbolic_name_regexp/));
		if (! defined $symbols{$currentfile}{$revision}) {
		    $symbols{$currentfile}{$revision} = ();
		}
		push @{$symbols{$currentfile}{$revision}}, $name;
	    } else {
		last;
	    }
	}
    } elsif ($_ =~ /^----------------------------$/) {
	$in_header = 0;
	next;
    } elsif (! $in_header && $_ =~ /^revision /) {
	($ignore, $revision) = split;
	($currentbasefile) = $currentfile;
	$currentbasefile =~ s;.*/([^/]+);\1;;
	my ($check) = compare_versions($fileversions{$currentfile}, $revision);
	#
	# Special case -- if a file is not in the current sandbox, but it
	# has the same base name as a file in the sandbox, log it;
	# otherwise if it is not in the current sandbox, don't log it.
	# 
	if (($check == 2 && (1 || (
	     ($basenames{$currentbasefile} || !($currentfile =~ /\//)) &&
	     ($currentfile =~ /\.[chly]$/)))) ||
	    $check == 1) {
	    $skipme = 0;
	} else {
	    # We don't want to print out any symbolic names associated with
	    # skipped versions.
	    map {
		$symbols_printed{$_} = 1;
	    } @{$symbols{$currentfile}{$revision}};
	    $skipme = 1;
	}
    } elsif (! $in_header && $_ =~ /^date: /) {
	my (@stuff) = split;
	my ($date, $time, $author, $state, $plus, $minus);
	if ($stuff[3] =~ /^[-+][0-9][0-9][0-9][0-9]/) {
	    $date = $stuff[1];
	    $time = $stuff[2];
	    $author = $stuff[5];
	    $state = $stuff[7];
	    $plus = $stuff[9];
	    $minus = $stuff[10];
	} else {
	    $date = $stuff[1];
	    $time = $stuff[2];
	    $author = $stuff[4];
	    $state = $stuff[6];
	    $plus = $stuff[8];
	    $minus = $stuff[9];
	}
#	$time =~ s/[0-9]:[0-9][0-9];$//;
#	$time =~ s/[0-9][0-9];$//;
	$time =~ s/;$//;
	$author =~ s/;$//;
	$plus =~ s/;$//;
	$minus =~ s/;$//;
	my $body = "";
	my $firstline = 1;
	while (<>) {
	    if ($_ =~ /^----------------------------$/) {
		last;
	    } elsif ($_ =~ /^=============================================================================$/) {
		last;
	    } elsif ($firstline && $_ =~ /^branches:([ \t]+[0-9]+(\.[0-9]+)+;)+$/) {
		next;
	    } else {
		$body .= $_;
		$firstline = 0;
	    }
	}
	my $junkbody = $body;
	$junkbody =~ s/\s//g;
	$junkbody .= "x";
	my $symbols;
	if (defined $symbols{$currentfile}{$revision}) {
	    $symbols = join " ", @{$symbols{$currentfile}{$revision}};
	}
	my $datetimeauthor = "$date $time $author $junkbody $currentfile $revision $symbols";
	if ($skipfile == 0 && $skipme == 0) {
	    $logmsgs{$datetimeauthor} = $body;
	    if ($plus eq "") {
		$plus{$datetimeauthor} = "added";
	    } elsif ($state eq "dead;") {
		$plus{$datetimeauthor} = "removed";
	    } else {
		$plus{$datetimeauthor} = $plus;
		$minus{$datetimeauthor} = $minus;
	    }
	}
    }				# Other junk we ignore
}

my $prevmsg="";
my $prevdate="";
my $prevtime="";
my $prevauthor="";
my $header="";
my %deltainfo = ();
my %revinfo = ();

my @chlog = $reverse ? sort keys %logmsgs : reverse sort keys %logmsgs;
my %filenames_printed = ();
my ($date, $time, $author, $junk, $file, $revision, @symbols);
my $filestuff;

sub printmsg($$$$$\%\%)
{
    my ($date, $time, $author, $emailsuffix, $prevmsg, $revinfo, $deltainfo) = @_;
    if ($print_time) {
	$time = " $time";
    } else {
	$time = "";
    }
    print "$date$time\t<$author$emailsuffix>\n\n";
    my $filestuff = join "", (map { "\t\t$_ ($$revinfo{$_}) ($$deltainfo{$_})\n" } sort keys %revinfo);
    $filestuff =~ s/\000/ /g;
    $filestuff =~ s/\t/\tFiles:/;
    print "$filestuff\n";
    $prevmsg =~ s/^/\t/g;
    $prevmsg =~ s/\n/\n\t/g;
    $prevmsg =~ s/[ \t]+\n/\n/g;
    $prevmsg =~ s/[ \t]+$//g;
    print "$prevmsg\n";
}

sub printsyms(@) {
    my (@symbols_to_print) = @_;
    print "===============================================================================\n";
    map {
	print "Name: $_\n";
    } @symbols_to_print;
    print "\n";
}

foreach (@chlog) {
    ($date, $time, $author, $junk, $file, $revision, @symbols) = split;
    $date =~ s,/,-,g;
    my $msg = $logmsgs{$_};
    my $delta;
    if (! $minus{$_}) {
	$delta = "$plus{$_}";
    } else {
	$delta = "$plus{$_} $minus{$_}";
    }
    if (! $print_each_file && $prevmsg eq $msg && !$filenames_printed{$file}) {
	$deltainfo{$file} = $delta;
	$revinfo{$file} = $revision;
    } else {
	if ($prevmsg ne "" || keys %deltainfo > 0) {
	    printmsg($prevdate, $prevtime, $prevauthor, $emailsuffix, $prevmsg, %revinfo, %deltainfo);
	    %filenames_printed = ();
	}
	$header = "$date\t<$author$emailsuffix>\n\n";
	$prevmsg = $msg;
	$prevdate = $date;
	$prevauthor = $author;
	$prevtime = $time;
	%deltainfo = ();
	%revinfo = ();
	$deltainfo{$file} = $delta;
	$revinfo{$file} = $revision;
	$filenames_printed{$file} = 1;
    }
    my (@symbols_to_print);
    foreach my $s (@symbols) {
	if (! $symbols_printed{$s}) {
	    push @symbols_to_print, $s;
	    $symbols_printed{$s} = 1;
	}
    }
    if (@symbols_to_print) {
	printsyms(@symbols_to_print);
    }
}

if ($prevmsg ne "" || keys %deltainfo > 0) {
    printmsg($prevdate, $prevtime, $prevauthor, $emailsuffix, $prevmsg, %revinfo, %deltainfo);
}