#!/usr/bin/perl
# Rapture Client, version 0.6.0
# The primary distribution site
# 
#   is http://www.propensive.com/
#
# Copyright 2011 Propensive Ltd
#
# Licensed under the Apache License, Version 2.0 (the "License"); you may not use this file except
# in compliance with the License. You may obtain a copy of the License at
#
#   http://www.apache.org/licenses/LICENSE-2.0
#
# Unless required by applicable law or agreed to in writing, software distributed under the License
# is distributed on an "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express
# or implied. See the License for the specific language governing permissions and limitations under
# the License.

use MIME::Base64;
use Digest::MD5;

$version = "0.6.0";
$server = $ENV{"RAPTURE_SERVER"};
if(!defined($server)) {
  $server = "http://control.propensive.com/go";
}
$argNo = 0;
$baseuser = $ENV{"RAPTURE_USER"};
$args = "--data-urlencode config@.rapture -d 'version=$version' --data-urlencode 'baseuser=$baseuser'";
$questionNo = 0;
$silent = '-s';
$questionArgs = "";
foreach $arg (@ARGV) {
  $args .= " --data-urlencode 'arg" . $argNo . "=" . $arg . "'";
  $argNo += 1;
}
&handle(&curl("$server $args $questionArgs"));

sub handle {
  my @lines = reverse(@_);
  my $cmd = pop(@lines);
  if($cmd eq "STREAM") {
    &stream(@lines);
  } elsif($cmd eq "INTERACTIVE") {
    &interactive(@lines);
  } elsif($cmd eq "MONITOR") {
    &monitor(@lines);
  } elsif($cmd eq "ARGUMENTS") {
    &arguments(@lines);
  } elsif($cmd eq "FAIL") {
    &failMessage(@lines);
  } elsif($cmd eq "MESSAGE") {
    &message(@lines);
  } elsif($cmd eq "SYNC") {
    &sync(@lines);
  } elsif($cmd eq "SAVE") {
    &save(@lines)
  } else {
    print("Unexpected response from server.\n");
    foreach $ln (@lines) {
      print "$ln\n";
    }
    exit(1);
  }
}

sub stream { exec("curl $silent -N $server -d stream=1 $args $questionArgs"); }

sub message {
  foreach $line (reverse(@_)) {
    print $line;
    print "\n";
  }
}

sub failMessage {
  foreach $line (reverse(@_)) {
    print $line;
    print "\n";
  }
  exit(1);
}

sub interactive {
  my $question = pop(@_);
  $questionNo += 1;
  print "$question";
  foreach $line (@_) {
    print "\n";
    print $line;
  }
  my $answer = <STDIN>;
  $answer =~ s/\s+$//;
  $questionArgs .= " --data-urlencode 'question$questionNo=$question' --data-urlencode 'answer$questionNo=$answer'";
  &handle(&curl("$server $args $questionArgs"));
}

sub arguments {
  $fileArgs = "";
  my @tmpFiles = ();
  foreach $fileArg (split(/,/, $_[0])) {
    &base64($ARGV[$fileArg], $fileArg);
    $fileArgs .= "--data-urlencode 'file" . $fileArg . "@". ".tmp$fileArg" . "' ";
    push(@tmpFiles, $fileArg);
  }
  &handle(&curl("$server $args $fileArgs $questionArgs"));
  foreach $tmpFile (@tmpFiles) {
#    unlink(".tmp$tmpFile");
  }
}

sub save {
  my $output = pop(@_);
  $output =~ s/!!!!/\n/;
  open (CONFIG, ">.rapture");
  foreach $line (@_) {
    print CONFIG "$line\n";
  }
  close CONFIG;
  print "$output\n";
}

sub sync {
  print "Synchronizing with remote server...\n";
  my $syncArgs = "--data-urlencode 'synchronize=";
  foreach $f (&files) {
    $g = substr $f, 0, 32;
    $syncArgs .= $g;
    $syncArgs .= ":";
  }
  @rfs = &curl("$server $args $syncArgs'");
  shift(@rfs);
  my @rfs2 = split(/,/, pop(@rfs));
  my @fs = &files;
  my @uploads = ();
  foreach $f (@fs) {
    foreach $rf (@rfs2) {
      my $s = substr($f, 0, 32);
      if($s eq $rf) {
        push(@uploads, substr($f, 36));
      }
    }
  }
  my $n = 0;
  my $fileArgs = "";
  foreach $u (@uploads) {
    $fileArgs .= "--data-urlencode 'provide$n=$u' ";
    $fileArgs .= "--data-urlencode 'upload$n" . "@" . "$u' ";
    $n += 1;
  }
  $args .= " -d synchronized=1 ";
  
  # FIXME: Infinite recursion fails after a while.
  &handle(&curl("$server $args $fileArgs -d synchronized=1 "));
}

sub monitor {
  foreach $line (reverse(@_)) {
    print $line;
    print "\n";
  }
  my @fs = &files;
  while(1) {
    my @fs2 = &files;
    my @fs3 = &files;
    my @newfiles = ();
    my @deletedfiles = ();
    while(scalar(@fs) > 0 && scalar(@fs2) > 0) {
      $oldfile = pop(@fs);
      $newfile = pop(@fs2);
      if($oldfile gt $newfile) {
        push(@deletedfiles, substr($oldfile, 36));
        push(@fs2, $newfile);
      } elsif ($oldfile lt $newfile) {
        push(@newfiles, substr($newfile, 36));
        push(@fs, $oldfile);
      }
    }
    foreach $file (@fs) {
      push(@deletedfiles, substr($file, 36));
    }
    foreach $file (@fs2) {
      push(@newfiles, substr($file, 36));
    }
    if(scalar(@deletedfiles) > 0 || scalar(@newfiles) > 0) {
      print("\n");
      my $fileArgs = "";
      my $n = 0;
      foreach $deletion (@deletedfiles) {
        $fileArgs .= "--data-urlencode 'delete$n=$deletion' ";
        $n += 1;
      }
      foreach $addition (@newfiles) {
        $fileArgs .= "--data-urlencode 'provide$n=$addition' ";
        $fileArgs .= "--data-urlencode 'upload$n" . '@' . $addition . "' ";
        $n += 1;
      }
      &handle(&curl("$server $args $fileArgs $questionArgs"));
    }
    select(undef, undef, undef, 0.2);
    @fs = @fs3;
  }
}

sub base64 {
  if(-e $_[0]) {
    open (FILE, $_[0]) or die "$!";
    open (OUT, ">.tmp$_[1]") or die "$!";
    while(read(FILE, $buf, 60*57)) {
      print OUT encode_base64($buf);
    }
    close (OUT);
    close (FILE);
  } else {
    print("File not found: $_[0]\n");
    exit(1);
  }
}

sub curl {
  $out = `curl $silent $_[0]`;
  if($? > 0) {
    print "Unable to connect to the server.\n";
    exit(1);
  }
  split(/\n/, $out);
}

sub files {
  @fs = ();
  sub go {
    opendir(DIR, $_[0]);
    foreach $f (readdir(DIR)) {
      if(-f "$_[0]/$f") {
        if(substr($f, -6) eq ".scala") {
          push(@fs, "$_[0]/$f");
        }
      } else {
        if(substr($f, 0, 1) ne ".") {
          &go($_[0] . "/" . $f);
        }
      }
    }
  }

  &go(".");
  @digests = ();
  foreach $g (@fs) {
    $ctx = Digest::MD5->new;
    open(FILE, $g);
    $ctx->addfile(*FILE);
    $digest = $ctx->hexdigest;
    push(@digests, "$digest  $g");
  }
  sort(@digests);
}