#!/usr/bin/perl -w
#-*-perl-*-

# $Id: rcsedit,v 1.1 2007/06/18 02:43:40 root Exp $

=head1 NAME

 rcsedit - edit file held under rcs control 

=head1 VERSION

 Version 2.0

=head1 SYNOPSIS

 rcsedit filetitle

 rcsedit ./file/name

=head1 DESCRIPTION

Allow users to edit config files, while maintaining an RCS revision
tree for the file, and ensuring any post-processing operations are
performed correctly.

Operations:

=over 4

=item 1

read config file to determine which config file to update.  If the
"file" parameter to rcsedit matches a record in the config file, the
corresponding file will be edited, otherwise the "file" parameter is
itself treated as a filename.  If the file does not exist (and no RCS
source for it exists) create it.

=item 2

RCS checkout (with lock) the file, unless someone else has it checked
out.  Report who has it checked out.  If the file is not under RCS
control, continue editing it anyway.

=item 3

Invoke the appropriate editor on the file.

=item 4

RCS checkin the file, providing an appropriate log message.  If the
file is not under RCS control, create an RCS file for it.

=item 5

invoke any postcommand defined in the config file.

=back

Config file format is as follows:

  filetitle:filename:postcommand

  e.g.

  httpd:/etc/httpd/httpd.conf:/usr/local/libexec/httpd/restart

Return status values are:

    0 : operation sucessfull.
    1 : Cannot check out file: already checked out.

=cut

##############################################################
#
# Start of code
#
##############################################################
use Rcs;
use File::Basename;

# Change this if your users want something else
my $DEFAULTEDITOR = '/usr/bin/jed';

# where the RCS commands live
Rcs->bindir('/usr/bin');

# rcsedit config file  
my $config = '/etc/rcseditrc';

# strip the pathname from the output
$0 =~ s!.*/!!;
die "Usage: $0 <filename>\n" unless $#ARGV == 0;

my $details = readconfig($ARGV[0]);
my $editfile = $details->[0];
my $postcommand = $details->[1];

my $basename = basename ($editfile, '');
my $dirname = dirname ($editfile);

# change to the working file directory
chdir ($dirname) or die "Can't chdir to '$dirname'\n";

# Initialise the RCS structures
my $obj = Rcs->new;
$obj->file($basename);

my $rcsfile = $obj->rcsdir . '/' . $obj->arcfile;

# if the RCS directory doesn't exist, make it 
mkdir ( $obj->rcsdir) unless ( -d $obj->rcsdir );

# move existing RCS file into an RCS directory
if ( -e $obj->arcfile ) {
    rename ($obj->arcfile, $rcsfile);
}

unless ( -e $rcsfile ) {
    # we need an RCS file from somewhere
    $obj->rcs('-i', "-t-Created using '$0'");
    # if the working file exists check it in
    if ( -e $basename ) {
	print "Checking in '$basename'\n";
	$obj->ci('-u', "-mChecked in using '$0'");
    }
}

# check to see if the working file has been changed
if ( -e $basename ) {
    my $changed = $obj->rcsdiff;
    if ($changed) {
	die "'$editfile' is out of sync with its latest RCS version.\nUse 'rcs -l $editfile; ci -u $editfile'\n";
    }
}

# Check the file out locked
$obj->co('-l');

# if the editor crashes, restore the original file
$SIG{QUIT} = save_me;
$SIG{TERM} = save_me;

# Edit the file
edit ($obj->file);

# Check it back in
$obj->ci('-u', "-mModified using '$0'");

if (defined($postcommand)) {
    system($postcommand . " " . $editfile);
}

# Our work here is done
exit(0);

sub edit {
    my $editfile = shift;
    my $editor = $ENV{'EDITOR'} ||= $DEFAULTEDITOR;
    my $editresult;
    
    $editresult = system $editor, $editfile;
    if ($editresult) {
        save_me("[Child killed]");
    }
    return ($editresult == 0);
}

sub save_me {
    # Signal handler: only installed after checking out a file,
    # to try and check the file back in.
    print("Abandoning changes and reverting to previous version\n");
    my($result) = $obj->co('-u', '-f');
    exit(1);
}

sub readconfig {
    my $title = shift;
    my %config;

    if( open(CONFIG,$config) ) {
	while (<CONFIG>) {
	    next if (/^\s*\#/);
    	    next if (/^$/);
	    chop;
	    my($filetitle, $file, $postcommand) = split(/:/);
	    next unless (-e $file);
	    my ($ddev,$dino,$mode)=(stat $file)[0,1,2];
	    my ($dir,$item)=("/",".");
	    unless ($mode & 040000) {      
		($dir,$item) = ($file=~m!(.*)/(.*)!);
		($ddev,$dino,$mode)=(stat $dir)[0,1,2];
	    }    
	    $config{$ddev,$dino}{$item}=[$file,$postcommand];
	    
	    # Check to see if we have a match
	    if ($filetitle eq $title) {
		close(CONFIG);
		# return a ref to an array of the results
		return [$file, $postcommand];
	    }
	}
	# <PJA> 18-Dec-1997
	# not found as a file title, so see whether the "title" is 
	# in fact a filename that's nominated in the file.
	my $maybe = "./".$title;
	$maybe =~ s!.*?//!/!;
	while (-l $maybe) {
	    $maybe =~ s![^/]*$!readlink($maybe)!e;
	    $maybe =~ s!.*?//!/!;    
	}
	my ($mdir,$mitem)=($maybe=~m!(.*)/(.*)!);
	my ($mdev,$mino)=(stat $mdir)[0,1];
	
	if (defined $mdev) {
	    my $ref = $config{$mdev,$mino}{$mitem};
	    if (!defined $ref) {
		$ref = $config{$mdev,$mino}{"."};
		if (defined $ref) {
		    $ref->[0] .= "/$mitem";
		}
	    } 
	    return $ref if defined $ref;
	}
    }
    warn "$title not found in config file $config\n";
    return [$title,undef];
}