#!/usr/bin/perl -w

use strict;


# options
use Getopt::Std;

use vars qw/ $opt_f $opt_l $opt_r $opt_F $opt_c $opt_h $opt_0/;
if (!getopts('fFlcp:h0') || $opt_h) {
	print <<End;
usage: $0 [options] package ...
options:
  -f  list files in package which have changed
  -l  include relevant log entries (implies -f)
  -r  prefix for symbolic name (e.g. mi_5, sina_3_12_beta)
  -F  list files which have changed in a useable format  
  -c  include log entries, but factorise by description
  -0  exclude files that have not been built
End
	exit 1;
}

if ($opt_l || $opt_c) { $opt_l = 1; $opt_f = 1; $opt_F = 0; }

my $prefix = quotemeta($opt_r || '');



# stage 1 - parse the log

# step 1 - get log
my $log = `cvs -Q log @ARGV`;

# step 2: split log file into parts for different RCS files
my @log_parts = split (("="x77)."\n\n?", $log);

#print STDERR scalar(@log_parts). " files logged\n";

my @logs = ();

for my $part (@log_parts) {
	# step 3 - break up each part by heading
	if (my ($rcs_file, $working_file, $head, $branch, $locks,
		$access_list, $symbolic_names, $keyword_substitution,
		$total_revisions, $selected_revisions, $description) = $part =~ /
RCS\sfile:\s(.*)\n
Working\sfile:\s?(.*)\n
head:\s?(.*)\n
branch:\s?(.*)\n
locks:\s?(.*)\n
access\slist:\s?(.*)\n
symbolic\snames:\n
((?:.*\n)*?)keyword\ssubstitution:\s?(.*)\n
total\srevisions:\s(\d+);\tselected\srevisions:\s(\d+)\n
description:\n
((?:.*\n)*)$
/x) {
		my $attic = $rcs_file =~ m|/Attic/| && index($working_file, $rcs_file) == -1;

		# step 4 - break up the symbolic names
		my %revisions_by_symbolic_name = ();
		for (split /\n/, $symbolic_names) {
			if (my ($name, $revision) = /^\t(\S+): (\S+)$/) {
				$revisions_by_symbolic_name{$name} = $revision;
			} else {
				print "! symbolic name: $_\n";
			}
		}

		# step 5 - break up the description
		my @descriptions = ();
		for (split (("-"x28)."\n", $description)) {
			next if $_ eq '';
			if (my ($revision, $date, $author, $state, $lines_plus, $lines_minus, $desc) =
			    /^revision (\S+)\ndate: (\S+ \S+);  author: (\S+);  state: (\S+);(?:  lines: \+(\d+) \-(\d+))?\n((?:.*\n)*)$/) {
				push @descriptions, { revision => $revision,
						      date => $date,
						      author => $author,
						      state => $state,
						      lines_plus => $lines_plus,
						      lines_minus => $lines_minus,
						      description => $desc };
			} else {
				print "! description: $_\n";
			}
		}

		# step 6 - assemble the record for this file
		push @logs, { rcs_file => $rcs_file, attic => $attic, working_file => $working_file, head => $head, branch => $branch, locks => $locks,
			      access_list => $access_list, revisions_by_symbolic_name => \%revisions_by_symbolic_name, keyword_substitution => $keyword_substitution,
			      total_revisions => $total_revisions, selected_revisions => $selected_revisions,
			      descriptions => \@descriptions };

#		print STDERR "$working_file $head\n";
	} else {
		print "! log part\n";
	}
}


# stage 2 - determine which packages are out of date - assumes packages are not mixed

my $package = '';
my %files_by_desc = ();

use Data::Dumper;

for my $log (@logs) {
	my ($working_file, $attic, $head, $revisions_by_symbolic_name, $descriptions) = @$log{qw(working_file attic head revisions_by_symbolic_name descriptions)};
	next if $attic;

	my ($trimmed_head) = $head =~ /^(\d+\.\d+)/;
	next unless defined $trimmed_head;

	# get the symbolic name for the numerically highest revision, excluding branch numbers, etc.
	my $build_v = 0;
	my $build_r = 0;
	my $build_name = undef;
	while (my ($name, $revision) = each %$revisions_by_symbolic_name) {
		next unless $name =~ /^$prefix/;
		my ($trimmed_revision) = $revision =~ /^(\d+\.\d+)/;
	        my ($this_v, $this_r) = split /\./, $trimmed_revision;
		if ($build_v < $this_v || ($build_v == $this_v && $build_r < $this_r)) {
			$build_v = $this_v;
			$build_r = $this_r;
			$build_name = $name;
		}
	}

	my ($head_v, $head_r) = split /\./, $trimmed_head;

	if (( $build_v < $head_v || ($build_v == $head_v && $build_r < $head_r) ) && !($opt_0 && $build_v == 0 && $build_r == 0)) {
		# the latest version of this file has not been built
		my ($this_package) = $working_file =~ m|^([^/]+)/|;

		if ($this_package ne $package and ! $opt_F) {
			if ($opt_c && $package ne '') {
				print_by_desc(\%files_by_desc);
			}
			# first time we came across it
			$package = $this_package;
			%files_by_desc = ();
			print "$package\n";
		}

		if (($opt_f || $opt_F)) {
			if ($opt_f) {
				my $wf = substr($working_file, length($package)+1);
				print "\t".$wf." "x(70-length($wf)). "$build_v.$build_r < $trimmed_head\n";
			} elsif (! $opt_c) {
				print "$working_file $build_v.$build_r $trimmed_head\n";
			}
			if ($opt_l) {
				for my $description (@$descriptions) {
					my ($revision, $date, $author, $desc) = @$description{qw(revision date author description)};
					my ($this_v, $this_r) = split /\./, $revision;
					last if $build_v > $this_v || ($build_v == $this_v && $build_r >= $this_r);
					($desc = "\n".substr($desc, 0, -1)) =~ s/\n/\n\t\t\t/;
					$desc = "\t\t$revision  $date  $author$desc\n";
					if ($opt_c) {
						push @{$files_by_desc{$desc}}, {working_file => $working_file, revision => $revision};
					} else {
						print $desc;
					}
				}
			}
		}
	}
}

sub print_by_desc {
	my $files_by_desc = shift;

	for my $desc (map $_->[0], sort {$a->[1] <=> $b->[1]} map [$_, extract_date($_)], keys %$files_by_desc) {
		my $files = $files_by_desc->{desc};
		print "\t$desc\n";
		for my $file (@$files) {
			print "\t\t@$file\n";
		}
	}
}

sub extract_date {
	my ($desc) = @_;
	my ($date) = $desc =~ /^\t\t\S+  (\S+)/;
	# e.g. 2000/06/23 05:57:34
	$date = join '', split /\D/, $date;
	return $date;
}