#!/usr/bin/perl -w
#
# mods: Show CVS status more nicely.
#
# 2006-??: Written as shell fn by Steven J. DeRose, sderoses@acm.org.
# 2007-05-21 sjd: Change to script.
# 2007-06-11f sjd: Rewrite to read and process, instead of just pipe. That
#    makes it much easier to combine the File and Repository lines so we
#    can show the path when doing recursive. Add -sort
# 2007-06-19 sjd: Add -all, -non.
# 2007-07-16 sjd: Start adding checks for whether newer rev exists.
# 2007-10-16 sjd: Add -nb, use strict.
# 2007-11-07 sjd: Flip -nb to -b. Getopt.
# 2010-09-12 sjd: Clean up.
#
# To do:
#

use strict;
use Getopt::Long;

my $version = "2010-09-12";

my $all            = 0;
my $maxfile        = 30; # max length of filenames (else puts on own line)
my $quiet          = 0;
my $recursive      = 0;
my $reportBranches = 0;
my $sort           = 0;
my $verbose        = 0;


# Process options
#
Getopt::Long::Configure ("ignore_case");
my $result = GetOptions(
    "a|all"              => \$all,
    "b"                  => \$reportBranches,
	"h|help|?"           => sub { system "perldoc mods"; exit; },
	"q|quiet!"           => \$quiet,
    "r"                  => \$recursive,
    "s|sort"             => \$sort,
	"v|verbose+"         => \$verbose,
    "version"            => sub {
		die "Version of $version, by Steven J. DeRose.\n";
	}
	);

($result) || die "Bad options.\n";

($recursive && !$quiet) && warn "(-r may take several seconds)\n";


###############################################################################
# If this happens, we get all sorts of spurious mismatches if we go on.
#
if (!(-d "CVS")) {
    die "This does not appear to be a CVS directory. Ending.\n";
}

# Get 'cvs status,' and trim output down to one line per file
my $tfile = "/tmp/mods_" . int(rand(100000));
my $tfile2 = "$tfile" . "_2";
# Can't currently catch 'Unknown' files, because they don't have a following
# 'repository revision' line, and that confuses the scan below.
my $cmd = "cvs status " .
    (($recursive) ? "-R":"-l") .
    " 2>/dev/null";

# For recursive, we need to keep the revision lines to get the paths.
$cmd .= " | grep -P --exclude '*[#~]' '^File:|Repository revision:'";
$cmd .= " > $tfile";

($verbose) && warn "Command to run: '$cmd'\n";
system "$cmd";

# File should have alternating File: and Respository revision: lines.
# Go through and count by status, combining path with status line.
my %counts;
open T, "<$tfile";
open OUT, ">$tfile2";

# ($verbose) && warn "Tempfiles: $tfile, $tfile2.\n";
my $branched = 0;
while (my $l1 = <T>) {
    my $l2 = <T>;
    chomp $l1; chomp $l2;

    if ($l1 !~ /^File: /) {
		system "rm $tfile $tfile2";
        warn "mods: 'File:' not found where expected in temp file '$tfile':\n";
		die "    Rec: '$l1'\n";
	}
    if ($l2 !~ /Repository revision:/) {
		system "rm $tfile $tfile2";
        warn "mods: 'Repository revision' not found where expected " .
            "in temp file '$tfile':\n";

		die "    Rec: '$l2'\n";
	}
    (my $file = $l1) =~ s/^.*File:\s*//;
    $file =~ s/\s+Status:.*$//;
    (my $stat = $l1) =~ s/^.*Status:\s*//;
    (my $path = $l2) =~ s|^.*vault.[^/]*/||;
    (my $rev  = $l2) =~ s|^.*revision:\s*||;
	$rev =~ s/\s.*$//;
    $path =~ s/,v$//;
    
    $counts{$stat}++;
    if ($stat eq "Up-to-date") {
		if (!$recursive) {
            my $cvslogRev = `cvs log $file | grep '^revision ' | head -n 1`;
            chomp $cvslogRev;
            $cvslogRev =~ s/^.*revision\s*//;
			if ($rev =~ m/^$cvslogRev\./) {
				$branched++;
				if ($reportBranches) {
					system "colorstring -m '$file\t is up to date"
						. " but branched: "
						. "cvs status $rev vs. cvs log $cvslogRev.' yellow";
				}
            }
            elsif ($rev ne $cvslogRev) {				
				$branched++;
				if ($reportBranches) {
                    system "colorstring -m '$file\t is mismatched: "
                        ."cvs status has $rev but cvs log has $cvslogRev.' red";
				}
            }
		}
		if (!$all) { next;}
	}

    print OUT pad($file,$maxfile) . " " . pad($stat,20);
    if ($recursive) { print OUT "$path"; }
    print OUT "\n";
	
} # while not EOF
close OUT;


###############################################################################
# Issue the main report
#
$cmd = "hilite --cvsstatus $tfile2";
if ($sort) { $cmd .= " | sort +52"; }
system "$cmd";

# Summarize number of files by status (not colorized)
#
if (!$quiet) {
	my $clear = `colorstring bg_default`;
    print "$clear\nCounts by status:\n";
	my $totalShown = 0;
    for my $k (sort keys %counts) {
		$totalShown += $counts{$k};
        print lpad($counts{$k}) . "  $k";
		if ($k eq "Up-to-date") {
			# print " ($branched branched)";
		}
		print "\n";
    }
}

# Report any ".\#" files from failed updates
my $x = `ls \.\#* 2>/dev/null`;
if ($x ne "") {
    print "\n";
    system "colorstring -m"
        . " 'NOTE: There are hidden files from CVS merges:' red";
    system "ls -F -h --color=auto \.\#*";
}

system "rm $tfile $tfile2";

exit;


###############################################################################
#
sub pad {
    my $s = $_[0];
    my $len = $_[1];
    if ($len <= 2) { $len = 8; }
    my $needed = $len - length($s);
    if ($needed > 0) {
        $s .= (" " x $needed);
    }
    return($s);
}

sub lpad {
    my $s = $_[0];
    my $len = (defined $_[1]) ? $_[1]:0;
    if ($len <= 2) { $len = 8; }
    my $needed = $len - length($s);
    if ($needed > 0) {
        $s = (" " x $needed) . $s;
    }
    return($s);
}


###############################################################################
#
sub showUsage {
    print "

=head1 Usage

mods [options]

Lists files in current directory that differ from CVS copy,
color-coded by their CVS status (up-to-date files are not listed).
Will also print the total number of files with each CVS status,
and mention if there are any hidden '.\#' files.
Also, only when not using -r or -R, will check whether each file 
is based on other than the newest revision.


=head1 Options

=over

=item * B<-a>          Show even the up-to-date files.

=item * B<-b>          Also report files that are merely branched.

=item * B<-q>          Suppress most messages.

=item * B<-r> or B<-R> Include all nested directories, print repository paths).

=item * B<-s> or B<-sort> Sort output by color (status) then path.

=item * B<-v>          Add more detailed messages, including path to each file.

=item * B<-version>    Display version info and exit.

=back


=head1 Known bugs and limitations

Reporting of branched files may not be complete yet.

Warning: If a file was copied in, but never actually updated,
it will not show up!


=head1 Related commands

    'cvs status'


=head1 Ownership

This work by Steven J. DeRose is licensed under a Creative Commons 
Attribution-Share Alike 3.0 Unported License. For further information on
this license, see http://creativecommons.org/licenses/by-sa/3.0/.

The author's present email is sderose at acm.org.

For the most recent version, see http://www.derose.net/steve/utilities/.

=cut
";
}