#!/usr/bin/perl

use strict;
use warnings;

# TODO: catch errors such as the Timeout at Net::FTP.pm line 789

BEGIN { 
  if ((!-r 'tsh.pl') && -r '../tsh.pl') {
    chdir '..' or die;
    }
  }
use lib './lib/perl';
use File::Path;
use File::Spec;
use Net::FTP;
use Carp;
use TSH::Config;
use TSH::Tournament;
use TSH::Utility;

sub ConnectFTP ($);
sub CreateRemoteDirectory ($$);
sub DisconnectAllFTP ($);
sub DisconnectFTP ($);
sub Initialise ();
sub InitialiseTournament (@);
sub Main ();
sub MarkUpdated ($$);
sub NeedsUpdating ($$);
sub PutFile ($$$$);
sub UpdateBinary ($$$$);
sub UpdateConfigFiles ($);
sub UpdateDir ($$$$);
sub UpdateHTMLFiles ($);
sub UpdateTFiles ($);
sub UpdateText ($$$$);

Main;

sub CreateRemoteDirectory ($$) {
  my $ftp = shift;
  my $dir = shift;
  my $rv = $ftp->mkdir($dir);
  if ($rv || $ftp->code =~ /^(521|550)$/) {
    return 1;
    }
  else {
    return 0;
    }
  }

sub ConnectFTP ($) {
  my $ep = shift;
  return 1 if $ep->{'ftp'};
  my $config = $ep->{'tourney'}->Config();
  my $ftp_host = $config->Value('ftp_host');
  my $ftp_username = $config->Value('ftp_username');
  my $ftp_password = $config->Value('ftp_password');
  my $ftp = $ep->{'ftp'} = new Net::FTP(
    $ftp_host,
    Debug => 0,
    Passive => 1,
    BlockSize => 10240);
  unless ($ftp) {
    warn "Cannot connect to FTP host at $ftp_host: $!";
    return 0;
    }
  $ftp_username = '' unless defined $ftp_username;
  unless ($ftp->login(
    $ftp_username,
    $ftp_password,
    )) {
    die "Cannot login to FTP host as $ftp_username: " 
      . $ftp->message();
    }
  return 1;
  }

sub DisconnectAllFTP ($) {
  my $esp = shift;
  for my $ep (values %$esp) {
    DisconnectFTP $ep;
    }
  }

sub DisconnectFTP ($) {
  my $ep = shift;
  if ($ep->{'ftp'}) {
    $ep->{'ftp'}->quit();
    $ep->{'ftp'} = undef;
    }
  }

sub Initialise () {
  my %events;
  my $username;
  my $password;
  while (@::ARGV) {
    my $arg = shift @::ARGV;
    if ($arg eq '-u') {
      $username = shift @::ARGV if @::ARGV;
      }
    elsif ($arg eq '-p') {
      $password = shift @::ARGV if @::ARGV;
      }
    else {
      unshift @::ARGV, $arg;
      last;
      }
    }
  if (@::ARGV) {
    for my $tn (@::ARGV) {
      $events{$tn} = {
	'tourney' => InitialiseTournament(
	  'directory' => $tn, 'username' => $username, 'password' => $password),
        };
      }
    }
  else {
    my $tp = InitialiseTournament(
      'username' => $username, 'password' => $password);
    my $tn = $tp->Config()->RootDirectory();
    $events{$tn} = {
      'tourney' => $tp,
      };
    }
  return \%events;
  }

sub InitialiseTournament (@) {
  my (%argv) = @_;
  my $tn = $argv{'directory'};
  my $username = $argv{'username'};
  my $password = $argv{'password'};
  my $tp = new TSH::Tournament($tn) or die;
  eval { $tp->LoadConfiguration(); };
  die "Configuration error: $@\n" if $@;
  my $config = $tp->Config();
# for my $required (qw(ftp_host ftp_username ftp_password ftp_path)) {
  for my $required (qw(ftp_host ftp_path)) {
    unless (defined $config->Value($required)) {
      my $en = $tn;
      $en = $config->RootDirectory() unless defined $en;
      die "Event $en is missing required configuration parameter $required.\n";
      }
    }
  $config->Value('ftp_username', $username) if defined $username;
  my $s = $config->Value('ftp_username');
  unless ((defined $s) && length($s)) {
    local($|) = 1;
    print "Username: ";
    $s = scalar(<STDIN>);
    $config->Value('ftp_username', $s);
    }
  $config->Value('ftp_password', $password) if defined $password;
  $s = $config->Value('ftp_password');
  unless ((defined $s) && length($s)) {
    local($|) = 1;
    print "Password: ";
    $s = TSH::Utility::ReadPassword();
    $config->Value('ftp_password', $s);
    print "\n";
    }
  return $tp;
  }

sub Main () {
  my $lastchanged = 0;
  my $eventsp = Initialise;
  print "Sleeping.\n";
  while (1) {
    my $changed = 0;
    $changed = 1 if UpdateConfigFiles $eventsp;
    $changed = 1 if UpdateTFiles $eventsp;
    $changed = 1 if UpdateHTMLFiles $eventsp;
    if ($changed) {
      print "Updated, rechecking.\n";
      sleep 1;
      $lastchanged = 1;
      next;
      }
#   print "Not updated.\n";
    if ($lastchanged) {
      print "Sleeping.\n";
      $lastchanged = 0;
      }
    DisconnectAllFTP $eventsp;
    sleep 10;
    }
  }

sub MarkUpdated ($$) {
  my $flagfile = shift;
  my $localfile = shift;
  
  my ($volume, $directory, $file) = File::Spec->splitpath($flagfile);
  my $dirpath = File::Spec->catpath($volume, $directory, '');
# warn $dirpath;
  mkpath $dirpath;
  if (open my $fh, ">$flagfile") {
    my $mtime = (stat $localfile)[9];
    close $fh;
    unless (utime $mtime, $mtime, $flagfile) {
      warn "utime failed: $!";
      return 0;
      }
    warn "Updated: $localfile ($flagfile, ".scalar(localtime($mtime)).")\n";
    return 1;
    }
  else {
    warn "Can't update flag file $flagfile: $!";
    return 0;
    }
  }

sub NeedsUpdating ($$) {
  my $flagfile = shift;
  my $localfile = shift;

  my $needs = (!-f $flagfile) || -M $flagfile > -M $localfile;
# warn "NU: $localfile does " . ($needs ? '' : 'not ') . "need to be changed.";
  return $needs;
  }

sub PutFile ($$$$) {
  my $ep = shift;
  my $flagfile = shift;
  my $localfile = shift;
  my $remotefile = shift;
  
  my $ftp = $ep->{'ftp'};
  my $c_no_overwrite = $ep->{'tourney'}->Config()->Value('ftp_no_overwrite');
  my $tries = 1;
  my $tried_making_path = 0;
  my $remote_tmp = $remotefile;
  $remote_tmp =~ s/([^\/]+)+$/tsh.tmp/ 
    or die "$remotefile has no trailing file component";
# warn "Posting temporary file $remote_tmp";
  while ($tries <= 10) {
    $ftp->delete($remote_tmp) if $c_no_overwrite;
    if (my $rv = $ftp->put($localfile, $remote_tmp)) {
      $ftp->delete($remotefile) if $c_no_overwrite;
      $rv = $ftp->rename($remote_tmp, $remotefile);
      if ($rv) { 
	return MarkUpdated $flagfile, $localfile;
        }
      else { 
	my $code = $ftp->code();
	warn "Received code $code renaming $remote_tmp to $remotefile";
	return 0;
	}
      }
    my $code = $ftp->code();
    if (($code == 550 || $code == 553) && !$tried_making_path) { # bad path
      $tried_making_path++;
      $remotefile =~ s/^\/{2,}/\//;
      my @path_components = split(m!/!, $remotefile);
      pop @path_components;
#     while ($path_components[0] eq '') { shift @path_components; }
      for my $i (0..$#path_components) {
	my $prefix = join('/', @path_components[0..$i]);
	CreateRemoteDirectory $ftp, $prefix;
	}
      next;
      }
    elsif ($code == 426) { # connection reset by peer
      warn "Got a code 426 on try $tries during PUT $localfile $remotefile.\n";
      DisconnectFTP $ep;
      sleep 5;
      while (1) {
        ConnectFTP $ep && last;
	sleep 5;
        }
      }
# Should try reconnecting in this case
#    elsif ($code == 150) { # Opening connection - often means connection dropped
#      print ERROR "Got a code 150 on try $tries during PUT $origfile $vfile.\n";
#      sleep 6;
#      }
    else {
      warn "Unexpected error ($code) during PUT $localfile $remotefile: " . $ftp->message() . "\n";
      DisconnectFTP $ep;
      sleep 5;
      while (1) {
        ConnectFTP $ep && last;
	sleep 5;
        }
      return 0;
      }
    }
  continue { $tries++; }
  warn "Too many retries for PUT $localfile $remotefile.\n"; 
  return 0;
  }

sub UpdateBinary ($$$$) {
  my $ep = shift;
  my $flagfile = shift;
  my $localfile = shift;
  my $remotefile = shift;
  
  my $updated = 0;
# warn "UB1: $localfile";
  if (NeedsUpdating($flagfile, $localfile)) {
    while (1) {
      ConnectFTP $ep && last;
      sleep 5;
      }
    my $ftp = $ep->{'ftp'};
    $ftp->binary();
#   warn "UB2: $localfile";
    $updated = PutFile $ep, $flagfile, $localfile, $remotefile;
    }
  return $updated;
  }

=item UpdateTFiles;

Check all .t files to see if they need to be updated.
Return true if any files were successfully updated.

=cut

sub UpdateTFiles ($) {
  my $esp = shift;
  my $updated = 0;
  while (my ($en, $ep) = each %$esp) {
    mkdir "flags/$en";
    my $tp = $ep->{'tourney'};
    my $config = $tp->Config();
    my $ftp_path = $config->Value('ftp_path');
    for my $dp ($tp->Divisions()) {
      my $fname = $dp->File();
      my $dpath = $config->MakeRootPath($fname);
      my $u = UpdateText(
	$ep,
	File::Spec->catfile('flags', $dpath),
	File::Spec->catfile($dpath),
	"$ftp_path/" . $config->MakeRootPath($fname, '/'),
        );
      $updated ||= $u;
      }
    }
  return $updated;
  }

sub UpdateDir ($$$$) {
  my $ep = shift;
  my $flagdir = shift;
  my $localdir = shift;
  my $remotedir = shift;
  
  my $updated = 0;
# warn "UpdateDir($flagdir,$localdir,$remotedir)";
  opendir(my $dh, $localdir) or confess "Can't opendir($localdir): $!";
  for my $file (readdir($dh)) {
    next if $file =~ /^\./;
    my $path = File::Spec->catfile($localdir, $file);
#   warn $path;
    if (-f $path) {
      if ($file =~ /\.(?:css|html?|t|txt)$/) {
#     warn "...text";
	my $u = UpdateText(
	  $ep, 
	  File::Spec->catfile($flagdir, $file),
	  $path, 
	  "$remotedir/$file"
	  );
	$updated ||= $u;
        }
      else {
#     warn "UD: $path is binary";
	my $u = UpdateBinary(
	  $ep, 
	  File::Spec->catfile($flagdir, $file),
	  $path, 
	  "$remotedir/$file"
	  );
	$updated ||= $u;
        }
      }
    elsif (-d $path) {
#     warn "...directory";
      my $u = UpdateDir(
	$ep, 
	File::Spec->catfile($flagdir, $file),
	$path, 
	"$remotedir/$file"
	);
      $updated ||= $u;
      }
    else {
      warn "Skipping: $path";
      }
    }
  closedir($dh);
  return $updated;
  }

=item UpdateHTMLFiles;

Check all files in the HTML directory to see if they need to be updated.
Return true if any files were successfully updated.

=cut

sub UpdateHTMLFiles ($) {
  my $esp = shift;
  my $updated = 0;
  while (my ($en, $ep) = each %$esp) {
    my $config = $ep->{'tourney'}->Config();
    my $ftp_path = $config->Value('ftp_path');
    my $u = UpdateDir(
      $ep,
      File::Spec->catdir('flags', $en, 'html'),
      $config->MakeHTMLPath(undef),
      "$ftp_path/$en/html",
      );
    $updated ||= $u;
    }
  return $updated;
  }

sub UpdateText ($$$$) {
  my $ep = shift;
  my $flagfile = shift;
  my $localfile = shift;
  my $remotefile = shift;
  
# warn "UpdateText: $flagfile $localfile $remotefile";
  my $updated = 0;
  if (NeedsUpdating($flagfile, $localfile)) {
    while (1) {
      ConnectFTP $ep && last;
      sleep 5;
      }
    my $ftp = $ep->{'ftp'};
#   $ftp->ascii();
    $ftp->binary();
    $updated = PutFile $ep, $flagfile, $localfile, $remotefile;
    }
  return $updated;
  }

=item UpdateConfigFiles;

Check all .t files to see if they need to be updated.
Return true if any files were successfully updated.

=cut

sub UpdateConfigFiles ($) {
  my $esp = shift;
  my $updated = 0;
  while (my ($en, $ep) = each %$esp) {
    mkdir "flags/$en";
    my $config = $ep->{'tourney'}->Config();
    my $ftp_path = $config->Value('ftp_path');
    my $u = UpdateText(
      $ep,
      File::Spec->catfile('flags', $en, 'config.tsh'),
      File::Spec->catfile($en, 'config.tsh'),
      "$ftp_path/$en/config.tsh",
      );
    $updated ||= $u;
    }
  return $updated;
  }

