#!/usr/bin/env perl
#
# mirror
#
# History: 
# (1) Started (chris Septem 25, 1997)
#
# Version: 0.0

use Getopt::Long;
use strict;

# ---------------------------------------------------------------------------
# Setup all the configuration information, and process the command line
# arguments to see what things the user wants to change.
# ---------------------------------------------------------------------------

$|++;

# Fix PATH
$ENV{PATH} = "/usr/molbio/perl:/usr/molbio/bin:/usr/local/bin:$ENV{PATH}";

$main::config_file   = "/home/dbmirror/etc/mirror.conf";
$main::debug         = 0;
@main::targets       = ();

# Get the user options and spit back a usage message if they do something silly

my %opt;
my @options = ( "help", "debug:i", "d:i", "config=s", "c=s" );

if( ! GetOptions( \%opt, @options ) ) { &usage(); }

# Override any default settings with arguments that the user has supplied

&usage()                    if defined $opt{'help'};

$main::config_file   = $opt{'config'}      if defined $opt{'config'};
$main::config_file   = $opt{'c'}           if defined $opt{'c'};
$main::debug         = $opt{'debug'}       if defined $opt{'debug'};
$main::debug         = $opt{'d'}           if defined $opt{'d'};


if( (defined( $opt{'debug'} ) || defined( $opt{'d'} )) && $main::debug == 0 ) {
   $main::debug = 1; }


# Dump the current configuration information if the user wants it...

&debug( 1, "-"x78 . "\n" );
&debug( 1, "Config File:   $main::config_file\n" );
&debug( 1, "Debug Level:   $main::debug\n" );
&debug( 1, "-"x78 . "\n" );
&debug( 1, "\n" );

# Determine host name
my $hostname = `uname -n`;
chop $hostname;
($hostname) = $hostname =~ /([^.]*)/;
$hostname = lc $hostname;
die "Can't determine hostname" unless $hostname ne "";

# Check that we are not still running (e.g., from last night...)
my $lockFile = "$ENV{HOME}/.mirror.$hostname.lock";
if (-f $lockFile) {
  print STDERR "A mirror process is still registered on $hostname: exiting\n";
  exit 0;
}
open CONF, ">$lockFile" or die "Can't create lock file $lockFile: $!";
close CONF;

# ---------------------------------------------------------------------------
# Read in the configuration file, and build target object based on each 
# stanza in the file.
# ---------------------------------------------------------------------------

open( CONF, $main::config_file ) || die "Can't read $main::config_file: $!";
my $cnt = 0;
my $got_target = 0;
my (%target_fields, $target);
while( <CONF> ) { 
   $cnt++;
   next if /^\#/ || /^\s*$/;
   
   if( /^(\S+)\s+(.*)$/ ) {
      if( $1 eq "name" && $got_target ) {
	 $target = Target->new( \%target_fields );
	 push( @main::targets, $target );
	 undef %target_fields;
	 $got_target = 0;
	 $target_fields{$1} = $2;
      } else {
	 $got_target = 1; $target_fields{$1} = $2;
      }
   } else {
      die "Invalid syntax in $main::config_file, line: $cnt\n";
   }
}
$target = Target->new( \%target_fields );  # Don't forget the last one.
push( @main::targets, $target );
close( CONF );


# ---------------------------------------------------------------------------
# Process the targets
# ---------------------------------------------------------------------------

foreach $target ( @main::targets ) {
    my( @fields, $found );

    &debug( 1, "\n" ); &debug( 1, "Target: ", $target->name(), "\n" );
    if ($target->match_host($hostname) && $target->needs_update) {
	if ($target->mirror != 0) {
	    print "Problem mirroring ", $target->name, "\n";
	}
	# Little check to verify that things were actually mirrored...
	if ($target->needs_update) {
	    print "Mirroring failed for ", $target->name, "\n";
	}
    }
}

unlink $lockFile;
exit(0);




# ---------------------------------------------------------------------------
# Utility functions belonging to the main package
# ---------------------------------------------------------------------------

sub debug { 
   my( $level, @stuff ) = @_;  print STDERR @stuff if $level <= $main::debug; }

sub usage {
   print STDERR <<"_USAGE_";
Usage: mirror [options]

Where options are one or more of the following:

   --config FILE           Use 'FILE' as the configuration file.
   --debug LEVEL           Output debugging information to STDERR.

This program is usually called by cron.
_USAGE_

   exit(1);
}


# ===========================================================================
# This class encapsulates a target URL that we want to pluck.  It holds the 
# data about the information that we want to get, as well as provide the
# functions that actually do the plucking...
# ===========================================================================

package Target;

# The constructor for the class, it takes a reference to a hash, and sets up
# the object to contain the data in that hash.

sub new {
   my( $class, $ref ) = @_;
   my( $key, $val );
   my $self = {};

   while( ($key, $val) = each( %$ref ) ) { $self->{$key} = $val; }
   $self->{'_out'}     = "";
   $self->{'_error'}     = "";

   bless $self;
   return $self;
}

# Lame versions of get and set methods... Some OO people will cringe here...

sub set { my( $self, $key, $val ) = @_; $self->{$key} = $val; }
sub get { my( $self, $key ) = @_;       return $self->{$key}; }

sub name { return $_[0]->{'name'}; }

# Check if the hostname matches

sub match_host {
    my( $self, $hostname ) = @_;
    my @h = split / /, $self->{'host'};
    my $host;
    for $host (@h) {
	$host = lc $host;
	if ($host eq $hostname) {
	    return 1;
	}
    }
    return 0;
}

# Check the dependency

sub needs_update {
    my( $self ) = @_;
    my $res = 0;
    my $source = $self->{'source'};
    my $target = $self->{'target'};
    if (! -f $source) {
	print STDERR "Warning: source file \"$source\" does not exist.\n";
	return 0;
    }
    $res = 1 unless -f $target;
    my @s_stat = stat $source;
    my @t_stat = stat $target;
    $res = 1 if $s_stat[9] > $t_stat[9];
    &main::debug( 1, "$source is ", $res ? "" : "not ",
		 "newer than $target.\n");
    return $res;
}

# Call the mirroring command.

sub mirror {
    use IPC::Open3;
    use Symbol;
    my( $self ) = @_;
    my $command = $self->{'command'};
    my( $pid, $SIN, $SOUT, $SERR );
    my $res = 0;
    $SIN = gensym();
    $SOUT = gensym();
    $SERR = gensym();
    print "Mirroring ", $self->{'name'}, "\n";
    &main::debug( 1, "Mirroring using ", $command, ".\n");
    $pid = open3($SIN, $SOUT, $SERR, $command);
    close($SIN);
    undef $/;
    $self->{'_out'} = <$SOUT>;
    $self->{'_error'} = <$SERR>;
    close($SOUT);
    close($SERR);
    waitpid $pid, 0;
    print $self->{'_out'}, "\n" if $self->{'_out'} ne "";
    print STDERR $self->{'_error'}, "\n" if $self->{'_error'} ne "";
    $res = 1 if $self->{'_error'} ne "";
    return $res;
}