#!/usr/bin/perl -w
#
# Copyright (c) 2005-2006 Simon L. Nielsen <simon@FreeBSD.org>
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions
# are met:
# 1. Redistributions of source code must retain the above copyright
#    notice, this list of conditions and the following disclaimer.
# 2. Redistributions in binary form must reproduce the above copyright
#    notice, this list of conditions and the following disclaimer in the
#    documentation and/or other materials provided with the distribution.
#
# THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
# ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
# OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
# SUCH DAMAGE.
#
# $Nitro: scripts/cvs_repo_copy.pl,v 1.12 2006/07/05 16:12:42 simon Exp $

# Script to make repo-copies in a CVS repository.
#
# Takes input on stdin or from a file of one or more lines like:
#
# <input file> ["arrow"] <output file|output dir>
#
# The arrow can be like "->", "=>" etc.  If an output dir is used it
# must end with a slash ('/'). The ",v" part of the file names is
# optional.
#
# Examples:
#
# src/foo/bar/baz src/foo2/bar2/baz2
# src/abc/def/gif -> src/bla2/bla/blu
#
# or
#
# src/foo/bar/baz,v > src/foo2/bar2/baz2,v
# src/abc/def/gif,v => src/bla2/bla/

use strict;
use File::Basename;
use File::Copy;
use Getopt::Std;

my $fixtags = "/r/alt_ncvs/Fixtags";
my %repomap = (
	       "src" => "/home/ncvs",
	       "doc" => "/home/dcvs",
	       "www" => "/home/dcvs",
	       "ports" => "/home/pcvs",
	       "projects" => "/home/projcvs");
# Note: $tmpdir must be on same partition as the repositories
my $tmpdir = "/home/alt_ncvs/".$ENV{"USER"};
my $infile = "-";
my $force = 0;
my $tmpfile_count = 0;
my $dry_run = 0;
my $quiet = 0;

my @files;

sub usage {
    print basename($0) . ": [-Fhnq] [-f <file>] [-t <dir>]\n";
    print "	-F 		Force; Do not ask for confirmation.\n";
    print "	-f <file>	Expect file list in <file> instead of stdin.\n";
    print "	-h 		This help.\n";
    print "	-n		Dry run; do not actually change anything.\n";
    print "	-q		Quiet mode.\n";
    print "	-t <dir>	Temporary directory.  Default: $tmpdir.\n";
    exit(64);
}

sub parse_opts {
    my %options = ();

    if (!getopts("f:Fhnqt:",\%options)) {
	print STDERR "Invalid command line arguments\n";
	&usage;
    }
    if (defined($options{f})) {
	$infile = $options{f};
    }
    if (defined($options{F})) {
	$force = 1;
    }
    if (defined($options{h})) {
	&usage;
    }
    if (defined($options{n})) {
	$dry_run = 1;
    }
    if (defined($options{q})) {
	$quiet = 1;
    }
    if (defined($options{t})) {
	$tmpdir = $options{t};
	$tmpdir =~ s%/$%%;
    }

    if (! -d $tmpdir) {
	mkdir($tmpdir, 0755) || die "Cannot mkdir tmpdir: $!";
    }

    if (! -x $fixtags) {
	die("Cannot find fixtags script $fixtags\n");
    }
}

# Get the complete absolute path for a file in one of the
# repositories.
sub get_full_file_path {
    my $f = shift;

    foreach my $key (keys(%repomap)) {
	if ($f =~ /^$key\//) {
	    return($repomap{$key} . "/$f");
	}
    }

    die("Could not map $f to a repository!\n");
}

# Perform the actual repository copy of all files.
sub repo_copy_files {
    for my $arr_ref (@files) {
	repo_copy_file(@$arr_ref[0], @$arr_ref[1]);
    }
}

# Perform repository copy of one file.
sub repo_copy_file {
    my $src = get_full_file_path(shift);
    my $dst = get_full_file_path(shift);
    my $tmpfile = "$tmpdir/repo_copy_${tmpfile_count}_".basename($src);
    $tmpfile_count++;

    if (!$quiet) {
	print "==> Doing repo-copy $src -> $dst\n";
    }

    if ($dry_run) {
	print "cp $src $tmpfile\n";
	print "$fixtags $tmpfile\n";
	print "mv $tmpfile $dst\n";
	return;
    }

    if (-e $tmpfile) {
	die("Temporary file $tmpfile in the way - please remove it\n");
    }

    copy($src, $tmpfile) or die "copy $src -> $tmpfile failed: $!\n";

    system($fixtags, $tmpfile);
    if ($? != 0) {
	unlink($tmpfile) || print("Could not unlink tmpfile $tmpfile\n");
	die("Fixtags ($fixtags) of $tmpfile failed!\n");
    }

    # We want to be _really_ sure this is atomic and that perl does
    # not play around.
    system("/bin/mv", $tmpfile, $dst);
    if ($? != 0) {
	unlink($tmpfile) || print("Could not unlink tmpfile $tmpfile\n");
	die("mv $tmpfile -> $dst failed!\n");
    }

    if (!$quiet) {
	print "==> Repo-copy done $src -> $dst\n";
    }
}

# Get the filelist from our input source.
sub get_file_list {
    open(INFILE, $infile);
    while(<INFILE>) {
	chomp;
	my $orig_line = $_;
	# Ignore empty lines
	if ($_ eq "" || /^\s+$/) {
	    next;
	}
	# Remote redundant white-space
	s/\s\s/ /g;
	my @arr = split;
	if (@arr != 2 && @arr != 3) {
	    die("Invalid input line '$orig_line'!\n");
	}
	if (@arr == 3) {
	    if ($arr[1] =~ /([-=]+)?>/) {
		$arr[1] = $arr[2];
		pop(@arr);
	    } else {
		die("Invalid input line  '$orig_line'!\n");
	    }
	}
	push(@files, [ @arr ] );
    }
    close(INFILE);

    if (@files == 0) {
	exit(0);
    }
}

# Fixup a single file so it is a complete ,v path
sub fixup_file {
    my $f = shift;

    if ( ! ($f =~ /,v$/)) {
	$f .= ",v";
    }

    $f =~ s/^\s+(\S+)\s+$/$1/;

    return $f;
}

# Fixup a destination file, including fixup_file()
sub fixup_dst_file {
    my $src = shift;
    my $dst = shift;

    if ($dst =~ /\/$/) {
	$dst .= basename($src);
    }
    $dst = fixup_file($dst);

    return $dst;
}

# Fixup our file list
sub fixup_file_list {
    my @tmpfiles;
    for my $arr_ref (@files) {
	my @arr;
	$arr[0] = fixup_file(@$arr_ref[0]);
	$arr[1] = fixup_dst_file(@$arr_ref[0], @$arr_ref[1]);
	push(@tmpfiles, [ @arr ] );
    }
    @files = @tmpfiles;
}

# (try to) check that our filelist is sane
sub check_file_list {
    for my $arr_ref (@files) {
	my $src = get_full_file_path(@$arr_ref[0]);
	my $dst = get_full_file_path(@$arr_ref[1]);

	if (! -e $src) {
	    die("Input file $src does not exist!\n");
	}
	if (-e $dst) {
	    die("Output file $dst does exist!\n");
	}
	my $attic_outfile = dirname($dst) . "/Attic/" . basename($dst);
	if (-e $attic_outfile) {
	    die("Output file $attic_outfile does exist in Attic!\n");
	}
	my $odir = dirname(get_full_file_path(@$arr_ref[1]));
	if (! -d ($odir)) {
	    # XXX, we could perhaps create it.... ?
	    die("Output dir $odir does not exist!\n");
	}

	my $found_self = 0;
	for my $arr_ref2 (@files) {
	    if (@$arr_ref[1] eq @$arr_ref2[1]) {
		if ($found_self) {
		    die("Duplicate output of @$arr_ref2[1]!\n");
		} else {
		    $found_self = 1;
		}
	    }
	}
    }
}

# Show the entire file list to the user
sub show_file_list {
    if ($quiet) {
	return;
    }
    print "==> Complete list for repo-copy:\n";
    for my $arr_ref (@files) {
	print "  " . @$arr_ref[0]." -> ".@$arr_ref[1]."\n";
    }
}

# Confirm that we should proceed
sub ask_yn {
    if ($force) {
	return;
    }

    my $on_a_tty = -t STDIN && -t STDOUT;
    if (!$on_a_tty) {
	# XXX, this should be able to be done better...?
	print "Proceed with actual repo-copy? (Hit ctrl-c within 5 seconds to abort)\n";
	sleep (5);
    } else {
	print "Proceed with actual repo-copy? (yes|no) ";
	my $line = <STDIN>;
	chomp($line);
	if (lc($line) ne "yes" && lc($line) ne "y") {
	    die("Not confirmed, aborting!\n");
	}
    }
}

&parse_opts;
&get_file_list;
&fixup_file_list;
&show_file_list;
&check_file_list;
&ask_yn;
&repo_copy_files;