: #-*- Perl -*-

### cvs-update --- front end to `cvs update'

## Copyright (C) 2001 Ben Wing.

## Author: Ben Wing <ben@xemacs.org>
## Based on: Earlier version by Martin Buchholz <martin@xemacs.org>
## Maintainer: Ben Wing <ben@xemacs.org>
## Current Version: 1.1, April 6, 2001

## This file is part of XEmacs.

## XEmacs is free software; you can redistribute it and/or modify it
## under the terms of the GNU General Public License as published by
## the Free Software Foundation; either version 2, or (at your option)
## any later version.

## XEmacs is distributed in the hope that it will be useful, but
## WITHOUT ANY WARRANTY; without even the implied warranty of
## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
## General Public License for more details.

## You should have received a copy of the GNU General Public License
## along with XEmacs; see the file COPYING.  If not, write to the Free
## Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
## 02111-1307, USA.

eval 'exec perl -w -S $0 ${1+"$@"}' # Portability kludge
    if 0;

use strict;
use File::stat;

(my $myName = $0) =~ s@.*/@@; my $usage="
Usage: $myName [cvs-update-args ...]

Front end to \`cvs update'.

Does the following in addition to a simple \`cvs update':

-- if the tree was checked out R/W using \`checkout -w', keep it that way.
-- if configure or configure.in are checked out, rerun autoconf (and
   lib-src/config.values.sh).
-- when updating ChangeLogs, automatically resolve conflicts.
-- output a list of deleted, merged, and conflicting files at the end.
";

die $usage if grep (/^--help$/, @ARGV);
my $debug = defined $ENV{VERBOSE} || defined $ENV{DEBUG};

die "Not a CVS directory tree.\n" unless -d "CVS";

# Check the read/writeness of the first plain file in the current directory.
opendir (DOT, ".") or die "opendir: $!";
my $rw;
while (my $file = readdir (DOT)) {
  if (-f $file) {
    $rw = -w $file ? "-w" : "-r";
    print "Using r/w flag $rw\n" if $debug;
    last;
  }
}
die "Can't find any regular files here!\n" if !defined $rw;

# this construct forks a subprocess, with the parent reading the
# child's output and the child executing the code within braces.

if (!open (CVS, "-|"))
  {
    open STDERR, ">&STDOUT";
    exec 'cvs', $rw, '-q', 'update', @ARGV;
  }

my @conflicts = ();
my @added = ();
my @deleted = ();
my @merged = ();
my @warnings = ();

while (<CVS>) {
  print;
  chomp;
  if (/^cvs server: warning: (.*) is not \(any longer\) pertinent$/) {
    push @deleted, $1;
  } elsif (/^cvs server: conflicts found in .*$/) {
  } elsif (/^(cvs .*)$/) {
    # such as:
    # cvs server: conflict: removed ... was modified by second party
    # cvs [update aborted]: cannot rename file ... to ...: ...
    push @warnings, $1;
  }
  if (/^(.*) already contains the differences between .* and .*$/) {
    push @merged, $1;
  }
  if (/^A (.*)$/) {
    push @added, $1;
  }
  my ($code, $file) = split(' ');
  next unless grep ($code eq $_, qw(U P M C));
  next unless -r $file;
  my ($dirname, $basename) = &ParsePath ($file);

  if ($basename eq 'ChangeLog' && $code eq 'C') {
    print "Automatically resolving conflict in $file\n";
    my $contents = &FileContents ($file);
    # Resolve conflicts in the obvious way...
    if ($contents =~
	s/^<{7} \S+\n((?:.*\n)*?)={7}\n((?:.*\n)*?)>{7} \S+\n/$1$2/mg) {
      open (FILE, "> $file") or die "$file: $!\n";
      # the following was `sleep 1', but i still occasionally saw
      # spurious "cvs server: file `lisp/ChangeLog' had a conflict and
      # has not been modified" errors
      sleep 2; # CVS will get confused if we resolve the conflict too `quickly'.
      print FILE $contents or die  "$file: $!\n";
      close FILE or die "$file: $!\n";
      next;
    } else {
      print "WARNING: Unexpected resolution error in $file\n";
    }
  }

  if ($code eq 'M') {
    push @merged, $file;
  }

  if ($code eq 'C') {
    push @conflicts, $file;
  }

  if ($rw eq '-w' && ($basename eq 'configure' ||
		      $basename eq 'configure.in')) {
    print "Automatically rerunning autoconf and config.values.sh\n";
    system "set +x; cd $dirname && autoconf && sh -c lib-src/config.values.sh";
  }
}

print "\n";

if (@added) {
  print "\nThe following files were added:\n\n  ";
  print (join "\n  ", @added);
  print "\n\n";
}

if (@deleted) {
  print "\nThe following files were deleted:\n\n  ";
  print (join "\n  ", @deleted);
  print "\n\n";
}

if (@merged) {
  print "\nThe following files were merged without conflicts:\n\n  ";
  print (join "\n  ", @merged);
  print "\n\n";
}

if (@conflicts) {
  print "\nThe following files had merge conflicts:\n\n  ";
  print (join "\n  ", @conflicts);
  print "\n\n";
}

if (@warnings) {
  print "\nThe following additional warnings were issued:\n\n";
  print (join "\n", @warnings);
  print "\n\n";
}

sub ParsePath {
  my $pos = rindex ($_[0], "/");
  return ($pos > 0 ? (substr ($_[0], 0, $pos), substr ($_[0], $pos+1)) :
          $pos == -1 ? ('.', $_[0]) :
          ("/", substr ($_[0], 1)));
}

sub FileContents {
  local $/ = undef;
  open (FILE, "< $_[0]") or die "$_[0]: $!";
  my $retval = scalar <FILE>;
  # must hack away CRLF junk.
  $retval =~ s/\r\n/\n/g;
  return $retval;
}