#! /usr/bin/perl -w

use strict;
use Fcntl;

#  Tool based on Tim Hemel's <tim@n2it.net> code implements extra cvs target 'submit'.
#  It looks recursively for the changed files and commmits them in one operation.
#  Designed to be aliased to 'cvs'.

#  Vadim Belman <voland@lflat.org>
#  Anton Berezin <tobez@tobez.org>
#  Dmitry Karasik <dk@plab.ku.dk>

#############################################################################
# CVS settings

my $CVS_CMD='cvs';


#############################################################################
# scvs flags.

# This will be set to 1 if submit requested. Have to be left intact.
my $SCVS_SUBMITTING = 0;

# Specifies the default 'commit' behavior. This default corresponds to the
# cvs's one.
my $SCVS_RECURSIVE_SUBMIT = 1;

# List of files to submit. Have to be left intact.
my @SCVS_SUBMIT_LIST = ();

# Default message for submit.
my $SCVS_MESSAGE = '';

# Default editor for submit.
my $SCVS_EDITOR = $ENV{ EDITOR} || 'vi';

#############################################################################
# & parse_repository ({{rep}})
# . extracts the method, user, host, port and directory from {{rep}}.
# . There are four possibilities:
#   - /path/to/repository
#   - :method:/path/to/repository
#   - :user@hostname:/path/to/repository
#   - :method:user@hostname:/path/to/repository
#
# . This function is far from perfect and will produce strange results with
#   non-standard repositories. Has only been tested for :pserver: method.
#



#############################################################################
# & parse_cmdline ()
# . Parses the command line, extracts significant options, recognizes the
#   'submit' command.
sub parse_cmdline
{
    my $i;
    my $rep;
    my @SCVS_ARGV = @ARGV; 
    
# Parsing global options first.
    for ( $i = 0; $i < @ARGV; $i++) {
	last unless $ARGV[ $i] =~ /^\-/;
	if ( $ARGV[ $i] eq '-d') {
	    if ( $ARGV[ $i + 1] =~ /^\:/) {
		$rep=$ARGV[ $i + 1];
	    }
# Removing -d option for the command line.
	    splice @ARGV, $i, 2;
	    redo;
	}
	if ( $ARGV[ $i] eq '-e') {
	    $SCVS_EDITOR = $ARGV[ $i + 1];
	    splice @ARGV, $i, 2;
	    redo;
	}
    }
# Global options are over. Checking out the command.
    if ( ( $i < @ARGV)
	&& $ARGV[ $i] eq 'submit') {
# Submit requested, special considerations required.
	$ARGV[ $i++] = 'commit';
	$SCVS_SUBMITTING = 1;
	for ( ; $i < @ARGV; $i++) {
	    last unless $ARGV[ $i] =~ /^\-/;
	    if ( $ARGV[ $i] eq '-F') {
		local $/;
		open MSG_FILE, "<$ARGV[ $i + 1]" or die "Cannot read $ARGV[ $i + 1]: $!";
		$SCVS_MESSAGE = <MSG_FILE>;
		close MSG_FILE;
		splice @ARGV, $i, 2;
		redo;
	    }
	    if ( $ARGV[ $i] eq '-m') {
		$SCVS_MESSAGE = $ARGV[ $i + 1];
		splice @ARGV, $i, 2;
		redo;
	    }
	    if ( $ARGV[ $i] =~ /R/) {
		$SCVS_RECURSIVE_SUBMIT = 1;
	    }
	    if ( $ARGV[ $i] =~ /l/) {
		$SCVS_RECURSIVE_SUBMIT = 0;
	    }
	}
# Now we must remember which files to submit if there are any.
	@SCVS_SUBMIT_LIST = splice @ARGV, $i;
    }
    @ARGV = @SCVS_ARGV unless $SCVS_SUBMITTING;
}

#############################################################################
# main

# Parse the command line and extract the info we are interested in.
parse_cmdline;


# submit is considered OK if we aren't supposed to do it.
my $submit_ok = ! $SCVS_SUBMITTING;
# this will be unlinked later.
my $tmpname;
if ( $SCVS_SUBMITTING) {
    my ( $cvs_update_cmd, @update_output, @commit_msg);
# get the list of interesting (added, modified, removed) files first.
    $cvs_update_cmd = "$CVS_CMD -q -n update " . ( $SCVS_RECURSIVE_SUBMIT ? '-R ' : '-l ') .
		      join( ' ', @SCVS_SUBMIT_LIST);
    print "cvs_submit: Obtaining list of changes. This may take a while, please, wait...\n";
    @update_output = grep { /^[ARM] /} split /\n/, `$cvs_update_cmd`;
# submit failed if cvs returned non-zero exit code.
    $submit_ok = $? == 0;
    if ( $submit_ok && @update_output == 0) {
	print STDERR "cvs_submit: No files found to submit.\n";
	$submit_ok = 0;
    }
    if ( $submit_ok) {
# create a temporary file for editing.
	my $n = 0;
# presume failure unless the temporary file will be eventually created.
	$submit_ok = 0;
TMPFILE:
	while ( ! $submit_ok) {
	    $tmpname = sprintf "/tmp/tmp%04d.txt", $n++;
            next if -f $tmpname;
	    $submit_ok = sysopen MSG_FILE, $tmpname, O_CREAT | O_EXCL | O_WRONLY, 0600;
	    unless ( $submit_ok) {
		if ( ! $!{ EEXIST}) {
		    print STDERR "cvs_submit: Temporary file '$tmpname' creation failed: $!\n";
		    undef $tmpname;
		    last TMPFILE;
		}
	    }
	};
    }
    if ( $submit_ok) {
# succeed in creating temporary file, filling it with the form.
	print MSG_FILE $SCVS_MESSAGE, "\n";
# if a message template exists - add it just after the first empty line.
# NOTE! Never use \t in the template because it will confuse scvs.
	if ( -f 'CVS/Template') {
	    if ( open MSG_TEMPLATE, "<CVS/Template") {
		print MSG_FILE <MSG_TEMPLATE>;
		close MSG_TEMPLATE;
	    }
	    else {
		print STDERR "cvs_submit: Cannot read message template: $!\n";
	    }
	}
# creating actual list of files to submit.
	my %sources = (
	    A => [ "CVS: Added:\n"],
	    M => [ "CVS: Modified:\n"],
	    R => [ "CVS: Removed:\n"],
	);
	foreach my $src ( @update_output) {
	    $src =~ s/^([ARM]) //;
# \t used to distinguish lines with filenames from mere informative ones.
	    push @{ $sources{ $1}}, "CVS:\t$src\n";
	}
# and forming the rest of the file.
	print MSG_FILE "CVS: ----------------------------------------------------------------------\n" .
	               "CVS: Remove lines with filenames you don't want to commit.\n" .
		       "CVS: Remember not to put TAB just after 'CVS:' or the rest of the line\n" .
		       "CVS: will be treated as a filename to commit.\n" .
		       "CVS: \n";
	print MSG_FILE @{ $sources{ A}} > 1 ? @{ $sources{ A}} : '',
                       @{ $sources{ M}} > 1 ? @{ $sources{ M}} : '',
                       @{ $sources{ R}} > 1 ? @{ $sources{ R}} : '';
	print MSG_FILE "CVS: ----------------------------------------------------------------------\n";
	close MSG_FILE;
# let the user edit the message.
	$submit_ok = system( $SCVS_EDITOR, $tmpname) == 0;
    }
    if ( $submit_ok) {
	$submit_ok = open MSG_FILE, "<$tmpname";
	if ( ! $submit_ok) {
	    print STDERR "cvs_submit: Can't read `$tmpname': $!\n";
	}
    }
    if ( $submit_ok) {
	my $i;
# read the message file back and split it into a message and CVS data.
# Lines not beginning with 'CVS:\s' are treated as belonging to the message.
# All lines after the first line wich begins with this string a treated as CVS
# data.
	@commit_msg = map { chomp; $_} <MSG_FILE>;
	close MSG_FILE;
	my $msg_empty = 1;
	for ( $i = 0; $i < @commit_msg; $i++) {
	    last if $commit_msg[ $i] =~ /^CVS\:\s/;
	    if ( $commit_msg[ $i] !~ /^\s*$/) {
		$msg_empty = 0;
	    }
	}
# cut of the message.
	my @scvs_data = splice @commit_msg, $i;
	$submit_ok = ! $msg_empty;
	if ( ! $msg_empty) {
	    $SCVS_MESSAGE = join( "\n", @commit_msg) . "\n";
	}
	else {
	    print STDERR "cvs_submit: Empty message, doing nothing.\n";
	}
# message file is broken if any of the CVS data lines doesn't start with
# 'CVS:\s' or isn't just 'CVS:'.
	unless ( scalar( grep { ! /^CVS\:(?:$|\s+)/} @scvs_data) == 0) {
	    $submit_ok = 0;
	    print STDERR "cvs_submit: Message structure is wrong!\n";
	}
	else {
# filter out all informative lines and leave only filenames.
	    @SCVS_SUBMIT_LIST = map { s/^CVS\:\s+//; $_}
				grep { /^CVS:\t/}
				splice @scvs_data, 1, scalar( @scvs_data) - 2;
	}
    }
    if ( $submit_ok) {
# put the message and files back into the arguments.
	open MSG_FILE, ">$tmpname";
	print MSG_FILE $SCVS_MESSAGE;
	close MSG_FILE;
	push @ARGV, '-F', $tmpname;
	push @ARGV, @SCVS_SUBMIT_LIST;
    }
}

if ( $submit_ok) {
# Now we can call system to execute the cvs command.
    my $exitcode = system $CVS_CMD, @ARGV;
    if ($exitcode) { print STDERR "cvs_submit: CVS command has done with rc==$exitcode\n"; }
}

if ( $tmpname) {
# clean up.
    unlink $tmpname;
}