#!/usr/bin/perl -wT -I..

use strict;
use CGI;
use Tinderbox3::DB;
use Tinderbox3::XML;
use Tinderbox3::Log;
use File::Temp qw(tempfile);

my $p = new CGI();
my $dbh = get_dbh();

$SIG{__DIE__} = sub { die_xml_error($p, $dbh, $_[0]); };

my $tree = $p->param('tree') || "";
if (!$tree) {
  die_xml_error($p, $dbh, "Must specify tree!");
}
my $machine_id = $p->param('machine_id') || "";
if (!$machine_id) {
  die_xml_error($p, $dbh, "Must specify a machine name!");
}
if ($machine_id =~ /(\d+)/) {
  $machine_id = $1;
} else {
  $machine_id = "";
}
my $status = $p->param('status');
if (!defined($status) || $status !~ /^\d+$/) {
  die_xml_error($p, $dbh, "You really need to define a status.");
}
my $log_chunk_fh = $p->upload('log');

#
# Get data for response
#

#
# Insert the machine into the machines table if it is not there
#
my $machine_info = $dbh->selectrow_arrayref("SELECT machine_name, commands FROM tbox_machine WHERE tree_name = ? AND machine_id = ?", undef, $tree, $machine_id);
if (!defined($machine_info)) {
  die_xml_error($p, $dbh, "No such machine!");
}
my ($machine_name, $commands) = @{$machine_info};
$commands ||= "";

#
# Update build info
#
my $build_info = $dbh->selectrow_arrayref("SELECT build_time, log FROM tbox_build WHERE machine_id = ? ORDER BY build_time DESC LIMIT 1", undef, $machine_id);
if (!defined($build_info)) {
  die_xml_error("No build time");
}
my ($build_time, $log) = @{$build_info};

$dbh->do("UPDATE tbox_build SET status_time = current_timestamp(), status = ? WHERE machine_id = ? AND build_time = ?", undef, $status, $machine_id, $build_time);

#
# Update fields
#
my $insert_sth = $dbh->prepare("INSERT INTO tbox_build_field (machine_id, build_time, name, value) VALUES (?, ?, ?, ?)");
foreach my $param ($p->param()) {
  if ($param =~ /^field_(\d+)$/) {
    my $field = $p->param("field_$1");
    my $field_val = $p->param("field_$1_val");
    $insert_sth->execute($machine_id, $build_time, $field, $field_val);
  }
}

#
# Clear commands
#
if ($commands) {
  $dbh->do("UPDATE tbox_machine SET commands = '' WHERE machine_id = ?", undef, $machine_id);
}

$dbh->commit;

#
# Update logfile
#
if ($log_chunk_fh) {
  my $log_in_fh;
  if ($p->param('log_compressed')) {
    # XXX this is a very roundabout way of uncompressing the incoming logfile
    my ($fh, $filename) = tempfile(SUFFIX => '.gz');
    while (<$log_chunk_fh>) {
      print $fh $_;
    }
    close $fh;
    system("gzip", "-d", $filename);
    $filename =~ s/\.gz$//g;
    open $log_in_fh, $filename;
  } else {
    $log_in_fh = $log_chunk_fh;
  }

  if (!$log) {
    die_xml_error($p, $dbh, "No log exists!");
  }
  my $log_fh = get_log_fh($machine_id, $log, ">>");
  while (<$log_in_fh>) {
    print $log_fh $_;
  }
  close $log_in_fh;
  close $log_fh;
}

#
# Print response
#
print $p->header("text/xml");
print "<response>\n";
print "<machine id='$machine_id'>\n";
print "<commands>", $p->escapeHTML($commands), "</commands>\n";
print "</machine>\n";
print "</response>\n";

$dbh->disconnect;