#!/usr/bin/perl
$version = q$Id: distribrc,v 1.0 2013/01/19 04:03:47 eagle Exp $;
#
# distribrc -- Maintain configuration files in multiple locations.
#
# Copyright 1996, 1997, 2013 Russ Allbery <rra@stanford.edu>
#
# This program is free software; you can redistribute it and/or modify it
# under the same terms as Perl itself.

############################################################################
# Site configuration
############################################################################

# Directory in which all skeleton files will be located, as well as the
# database of files and times.
$root = $ENV{SKELDIR} || $ENV{HOME} . '/skel';

# The filename for the list of dotfiles, locations, and forwarding commands.
$files = '.files';

# The filename for the timestamps of the last time a given dotfile was
# forwarded to a given location.
$times = '.times.db';


############################################################################
# Modules and declarations
############################################################################

require 5.004;

use DB_File qw();
use Getopt::Long qw(GetOptions);

use strict;
use vars qw($root $files $times $version %files %times);


############################################################################
# Reading databases
############################################################################

# Read in the list of dotfiles and locations and build a hash that
# associates each location with a command to transfer files and a list of
# files to send.  Each file on the list to send is a pair of source
# filename and destination filename.
sub read_files {
    my (%locations, %sets);
    local $_;

    # Read in the file.  Entries take the form of either ">" followed by a
    # location name, a file set, and a command for transferring files,
    # or a label ending in a colon followed by a list of filename pairs
    # terminated by a blank line.
    open (FILES, "$root/$files") or die "$0: can't open $root/$files: $!\n";
    while (<FILES>) {
	next if /^\s*$/;
	if (/^>\s*(.*)/) {
	    my $line = $1;
	    my @location = split (' ', $line, 3);
	    $locations{$location[0]} = [ @location[1,2] ];
	} elsif (/^\s*(\S+):\s*$/) {
	    my $set = $1;
	    $sets{$set} = [];
	    while (<FILES>) {
		last if /^\s*$/;
		my @pair = split;
		push (@{$sets{$set}}, [ @pair ]);
	    }
	}
    }
    close FILES;

    # Now, build the %files hash, which contains a list of a command and
    # then a number of filename pairs for each separate location name.
    for (keys %locations) {
	$files{$_} = [ $locations{$_}[1], @{$sets{$locations{$_}[0]}} ];
    }
}


############################################################################
# Sending files
############################################################################

# Returns true if a given value is contained in an array, false otherwise.
sub contains (\@$) {
    my ($array, $value) = @_;
    for (@$array) {
	if ($value eq $_) { return 1 }
    }
    undef;
}

# Send a set of dotfiles to a remote location if they've been modified since
# they were last sent.  If the passed list of files is empty, send all files
# registered for that location.
sub send_files {
    my ($location, $testing, $force, @files) = @_;
    my @pairs = @{$files{$location}};
    my $template = shift @pairs;

    for my $pair (@pairs) {
	next if (@files and not contains (@files, $$pair[0]));
	my $source = $$pair[0];
	$source =~ s%~/%$ENV{HOME}/%;
	$source = $root . "/" . $source unless (index ($source, '/') == 0);
	if (!$force && $times{$location, $$pair[0]} >= (stat $source)[9]) {
	    next;
	}
	my $command = $template;
	$command =~ s%\*%$source%;
	$command =~ s%\*%$$pair[1]%;
	print "$command\n";
	unless ($testing) {
	    system split (' ', $command);
	    $times{$location, $$pair[0]} = time if ($? == 0);
	}
    }
}


############################################################################
# Main routine
############################################################################

# Trim extraneous garbage from the path.
my $fullpath = $0;
$0 =~ s%.*/%%;

# Get command line options.
my ($force, $help, $location, $testing, $print_version);
Getopt::Long::config ('bundling');
GetOptions ('force|f'      => \$force,
	    'help|h'       => \$help,
	    'location|l=s' => \$location,
	    'just-print|n' => \$testing,
	    'version|v'    => \$print_version);

# If they asked for our version number, abort and just print that.
if ($print_version) {
    my ($program, $ver) = (split (' ', $version))[1,2];
    $program =~ s/,v$//;
    die "$program $ver\n";
}

# If they asked for help, give them the documentation.
if ($help) {
    print "Feeding myself to perldoc, please wait....\n";
    exec ('perldoc', '-t', $fullpath) or die "$0: can't fork: $!\n";
}

# Open the times database and read in the files database.
read_files;
tie (%times, 'DB_File', "$root/$times")
    or die "$0: can't tie to $root/$times: $!\n";

# Actually run the commands.  Unless we're given a particular location name,
# we loop through all of the keys of %files, looking for either anything
# listed in @ARGV or just anything at all if @ARGV is empty that hasn't been
# sent out to a given location since it was last modified.
if ($location) {
    send_files ($location, $testing, $force, @ARGV);
} else {
    for (keys %files) {	send_files ($_, $testing, $force, @ARGV) }
}

END { untie %times if %times }
__END__


############################################################################
# Documentation
############################################################################

=head1 NAME

distribrc - Maintain configuration files in multiple locations

=head1 SYNOPSIS

B<distribrc> [B<-fhnv>] [B<-l> I<location>] [I<file> ...]

=head1 DESCRIPTION

B<distribrc> is intended to maintain a set of configuration files in a
wide variety of locations from a single source directory.  For example, I
use this program to maintain my dotfiles (F<.cshrc>, F<.xsession>, and the
like) so that I can automatically copy the new versions to all of my
accounts when they change.  It's designed so that you only have to make a
modification once in the source skeleton directory and then run
B<distribrc>, and the updated version will be copied into every additional
location.

B<distribrc> uses a database of locations, file sets, and copying commands
to determine which files to copy where and how, and a separate database of
times used to store the last time when a given file was copied to a given
location.  The former database consists of a line of the form:

    > location file_set command

for every different location, where I<location> is whatever name you want
to assign to the location (it can be arbitrary), I<file_set> is the name
of a file set to copy to that location (see below), and I<command> is the
command used to copy files there.  The first C<*> in I<file_set> will be
replaced by the path to the source file and the second C<*> will be
replaced by the path to the destination file.  So, for example, the
following would be a reasonable location definition:

    > cyclone build rcp * eagle@cyclone.Stanford.EDU:~/*

This would copy all files in the file set I<build> to the machine
cyclone.Stanford.EDU using rcp.

A file set is defined by a label, followed by a list of source and
destination file pairs, followed by a blank line.  So, for example, this
could be a file set:

    build:
        cshrc .cshrc
        emacs-small .emacs
        login .login

This would copy the file F<cshrc> in the skeleton directory to F<.cshrc>
at the location, F<emacs-small> to F<.emacs>, and so forth.

By default, all files are copied to all locations, unless a given file
hasn't been modified since it was last copied to a given location.  If
files are specifically listed on the command line, only those files will
be copied.  If you want to update one location only, see the B<-l> flag
below.

=head1 OPTIONS

=over 4

=item B<-h>, B<--help>

Print out this documentation (which is done simply by feeding the script
to C<perldoc -t>.

=item B<-v>, B<--version>

Print out the version of B<distribrc> and exit.

=item B<-f>, B<--force>

Ignore the stored timestamp information and copy all files regardless of
whether they were changed or not.  This is best used with a list of
configuration files on the command line or the B<-l> option below (or
both).

=item B<-l> I<location>, B<--location=>I<location>

Update only I<location> rather than updating all locations in the
database.

=item B<-n>, B<--just-print>

Print out the commands which would have been run but don't actually do
anything.  Think C<make -n>.

=back

=head1 ENVIRONMENT

=over 4

=item HOME

Used to locate the skeleton directory (which is F<$HOME/skel> by default)
and used to expand C<~> in source file names in the database.

=item SKELDIR

The directory to use as a skeleton directory, where the database and times
files are found and the default directory to search for configuration
files.  If not set, this defaults to F<$HOME/skel>.

=back

=head1 FILES

=over 4

=item F<.files>

Located in the skeleton directory, this is the database of locations and
file sets as described above.

=item F<.times.db>

A Berkeley DB file listing the last time a given configuration file was
copied to a given location.

=back

=head1 BUGS

Currently, if you want to change the default skeleton directory or the
names of the database and times files, you need to modify the beginning of
this script.

=head1 SEE ALSO

The current version of this script is available from Russ Allbery's script
page at L<http://www.eyrie.org/~eagle/software/scripts/>.

=head1 AUTHOR

Russ Allbery <rra@stanford.edu>

=head1 COPYRIGHT AND LICENSE

Copyright 1996, 1997, 2013 Russ Allbery <rra@stanford.edu>

This program is free software; you may redistribute it and/or modify it
under the same terms as Perl itself.

=cut