#!/usr/bin/env perl

use strict;
use warnings;
use Net::Ping;
use LWP::Simple qw($ua get getstore);
use Archive::Zip qw( :ERROR_CODES :CONSTANTS );
use Cwd;
use File::Copy qw(move);
use Tk::Dialog;

#*** Before we do anything else, check for the presence of an internet
#*** connection.  Exit quietly if no connection exists.  Two methods are
#*** coded below.  The first is clumbsy, but reliable.  The second is faster
#*** and more elegant but somewhat finiky.  Monitor this closely.

#$ua->timeout(20);
#unless( my $google_page = get('http://www.google.com/index.html') ) { exit; };

my $p = Net::Ping->new('tcp');
$p->port_number(80); 
unless( $p->ping('www.google.com',10) ) { exit; }

#*** We have an internet connection, so lets check for updates.

check_for_updates();

#------------------------------------------------------------------------------
# Routine to check for and apply updates
#------------------------------------------------------------------------------

sub check_for_updates {

  my ( $InstalledVersion, $LatestVersion );

  my $server = 'http://www.cora.nwra.com/~lund/ViperUpdate';
  my $ViperPath = cwd();

#*** Create a dummy mainwindow to hold the messageboxes created below.

  my $mw = MainWindow->new();
#  $mw->withdraw();
  $mw->geometry('50x50');

#*** Get the version number of the latest available update from the server.

  $ua->timeout(20);
  unless( $LatestVersion = get("$server/latest_version.txt") ) {
    $mw->messageBox(-title=>'Problem Checking For Updates', 
      -message=>"Could not fetch $server/latest_version.txt", 
      -type=>'OK', -icon=>'warning');
    exit;
  }
  chomp $LatestVersion;

#*** Get the version number of the installed copy.

  unless( open(FILE,"<$ViperPath/Updates/installed_version.txt") ) {
    $mw->messageBox(-title=>'Problem Checking For Updates', 
      -message=>"Could not open $ViperPath/Updates/installed_version.txt",
      -type=>'OK', -icon=>'warning');
    exit;
  }
  unless( defined($InstalledVersion = readline *FILE) ) {
    $mw->messageBox(-title=>'Problem Checking For Updates', 
      -message=>"Could not read $ViperPath/Updates/installed_version.txt",
      -type=>'OK', -icon=>'warning');
    exit;
  }
  chomp $InstalledVersion;
  close FILE;

#*** Exit now if the installed version is up to date.

  if( $InstalledVersion eq $LatestVersion ) {
    exit;
  }

#-------------------------------------------------------------------------
#*** If flow gets here then an update is needed.  If the installed copy is
#*** more than one version old, the intermediate updates will be applied 
#*** in sequential order.
#-------------------------------------------------------------------------

#*** Sleep for a few seconds to allow the main gui window to appear first
#*** (that way the update window will appear in front).

  sleep 2;

  my ($logFile, $answer, $version, $rest, $line, $start, $index, @versions);

#*** Ask the user if he wants to apply the updates now.

  $answer = $mw->Dialog(-title=>'Update Available',
    -text=>"An update is available to take you\n".
           "from version $InstalledVersion to $LatestVersion\n".
           "Should I apply the update now?",
#    -buttons=>['Yes', 'No, Remind Me Later'], 
    -buttons=>['Yes', "No,\nRemind Me\nLater"], 
    -default_button=>'Yes',
    -bitmap=>'question') -> Show();

  if( $answer ne 'Yes' ) { exit; }

#*** Get the revision log file from the server and parse it to obtain a list
#*** of revisions.

  $logFile = 'Updates/update_log.txt';

  $ua->timeout(30);
  unless( getstore("$server/update_log.txt", "$logFile" ) ) {
    $mw->messageBox(-title=>'Problem Checking For Updates', 
      -message=>"Could not fetch $server/update_log.txt",
      -type=>'OK', -icon=>'warning');
    exit;
  }

  unless( open(FILE,"<$logFile") ) {
    $mw->messageBox(-title=>'Problem Checking For Updates', 
      -message=>"Could not open $logFile for reading",
      -type=>'OK', -icon=>'warning');
    exit;
  }

  $index = 0;
  while (! eof (FILE) ) {
    unless( defined($line = readline *FILE) ) {
    $mw->messageBox(-title=>'Problem Checking For Updates', 
      -message=>"Could not read from $logFile",
      -type=>'OK', -icon=>'warning');
      exit;
    }
    chomp $line;
    if( $line =~ /^[0-9].[0-9].[0-9]/ ) { 
      $index++;
      ($version, $rest) = split ' ',$line;
      push( @versions, $version );
      if( $version eq $InstalledVersion ) { $start = $index; }
    }
  }

  close FILE;

#*** Now apply the outstanding updates in sequential order.

  for ( $index=$start; $index<@versions; $index++ ) {
    print "Applying update $versions[$index]\n\n";
    apply_update( $mw, $server, $versions[$index-1], $versions[$index] );
  }

  $mw->messageBox(-title=>'Update Success!',
   -message=>"Update to version $versions[$#versions] Succeeded",
    -type=>'OK');
}

#------------------------------------------------------------------------------
# subroutine to apply a single update
#------------------------------------------------------------------------------

sub apply_update {

  my ( $mw, $server, $current_version, $new_version ) = @_;

#*** Get the zip file containing the update from the server

  my $zipfile = "$new_version.zip";

  $ua->timeout(30);
  unless( getstore("$server/$zipfile", "$zipfile" ) ) {
    $mw->messageBox(-title=>'Problem Checking For Updates', 
      -message=>"Could not fetch $server/$zipfile",
      -type=>'OK', -icon=>'warning');
    exit;
  }

#*** Generate a list of the zipfile contents.

  my $zip_in = Archive::Zip->new();
  unless ( $zip_in->read( "$zipfile" ) == AZ_OK ) {
    $mw->messageBox(-title=>'Problem Checking For Updates', 
      -message=>"Could not read $zipfile",
      -type=>'OK', -icon=>'warning');
    exit;
  }
  my @zip_contents = $zip_in -> memberNames();

#*** Determine the subset of update files that already exist.  The existing
#*** files will be archived prior to the update just to be safe.

  my $zip_out = Archive::Zip->new();

  my $compile = 0;
  my $scripts_updated = 0;
  foreach my $file (@zip_contents) {
    if( -e $file && $file !~ '/$' ) { $zip_out -> addFile( $file ); }
    if( $file =~ 'Code' ) { $compile = 1; }
    if( $file eq 'ViperGui.pl' ) { $scripts_updated = 1; }
    if( $file eq 'ViperUpdate.pl' ) { $scripts_updated = 1; }
  }
  if( $compile == 1 && -e 'Code/run_viper.exe' ) { 
    $zip_out ->  addFile( 'Code/run_viper.exe' );
  }
  if( $compile == 1 && -e 'Code/run_viper' ) { 
    $zip_out ->  addFile( 'Code/run_viper' );
  }
  $zip_out -> addFile( 'Updates/installed_version.txt' );

#*** Archive the files to be replaced by the update.

  my $save_zip = "Updates/save_$current_version.zip";
  unless( $zip_out -> writeToFileNamed($save_zip) == AZ_OK ) {
    $mw->messageBox(-title=>'Problem Checking For Updates', 
      -message=>"Could not write $save_zip",
      -type=>'OK', -icon=>'warning');
    exit;
  }

#*** Unpack the update files.

  $zip_in -> extractTree();

#*** We need to touch the files in order to make their dates current.

  my $time_now = time();
  my $count = utime( $time_now, $time_now, @zip_contents );

#*** Check to see if the update came with an install script.  If so, run it.

  my $InstallScript = "install_$new_version.pl";
  if( -e $InstallScript ) {
    print "Calling $InstallScript to install $new_version\n";
    system( "$InstallScript" );
  }

#*** Build the run_viper program.

  if( $compile == 1 ) {
    chdir('Code') or die "$!";
    system( 'gmake run_viper' );
    chdir('..') or die "$!";
  }

#*** Update the installed_version.txt file

  unless( open(FILE,">Updates/installed_version.txt") ) {
    $mw->messageBox(-title=>'Problem Checking For Updates', 
      -message=>"Could not open Updates/installed_version.txt for writing",
      -type=>'OK', -icon=>'warning');
    exit;
  }
  print FILE "$new_version\n";
  close FILE;

#*** Remove the install files

  unlink( "$new_version.zip" );
  if( -e $InstallScript ) { unlink( "$InstallScript" ); }

  if( $scripts_updated == 1 ) {
    $mw->messageBox(-title=>'Update Success!',
      -message=>"Update to version $new_version succeeded.\n\n".
                "This particular update affected the\n".
                "perl scripts.  To avoid unexpected\n".
                "Behavior, please quit and then\n".
                "re-launch any instances of ViperGui",
       
      -type=>'OK', -icon=>'warning');
    exit;
  }

}
