#!/usr/bin/perl

use strict;
use CGI;
use Symbol;

my $q = CGI::new();
my $tmpPath = "<<<STAM.TEMP.PATH>>>";

my $problems = '';
		      
# collect data needed
my $referer    = $q->referer();
my $filestem   = $q->param('filenamestem');

# fix automount trouble when using different machines for server, WWW and analysis
# these lines are specific for the MPI-MG in Berlin
$filestem =~ s/\/amd\/morgan\/0\/project\/gene_expression/\/project\/gene_expression/;
$filestem =~ s/\/amd\/sanger\/www\/apache\/share\/compdiag/\/home\/cmb\/compdiag/;
$filestem =~ s/\/amd\/tarantula\/www\/users\/all\/lottaz/\/home\/web\/lottaz/;

my $datafile = $filestem;
$datafile =~ s/[^\/]+$/eval.RData/;
my $datapath = $filestem;
$datapath =~ s/[^\/]+$//;
my $aclass        = $q->param('aclass');

my $minspec       = $q->param('minspec');
my $minsens       = $q->param('minsens');
my $maxsens       = $q->param('maxsens');

my $f_red         = $q->param('f_red');
my $f_green       = $q->param('f_green');
my $f_blue        = $q->param('f_blue');
my $t_red         = $q->param('t_red');
my $t_green       = $q->param('t_green');
my $t_blue        = $q->param('t_blue');

my $bin_thresh    = $q->param('bin_thresh');
my $show_graph    = $q->param('show_graph');
my $sample_labels = $q->param('sample_labels');
my $lab_len       = $q->param('lab_len');

# verify consistency
my $startfile = $filestem . ".html";
if (!(-e $startfile)) { $problems .= $q->li("$startfile does not exist"); }
if (!(-e $datafile)) { $problems .= $q->li("$datafile does not exist"); }
$problems .= is_ok($minspec, "minspec");
$problems .= is_ok($minsens, "minsens");
$problems .= is_ok($maxsens, "maxsens");
$problems .= is_ok($f_red  , "f_red");
$problems .= is_ok($f_green, "f_green");
$problems .= is_ok($f_blue , "f_blue");
$problems .= is_ok($t_red  , "t_red");
$problems .= is_ok($t_green, "t_green");
$problems .= is_ok($t_blue , "t_blue");
if ($bin_thresh ne '-') { $problems .= is_ok($bin_thresh, "bin_thresh"); }
if (!(is_int($lab_len)))     { $problems .= $q->li("lab_len ($lab_len) is not integer");}
if ($minsens > $maxsens) { 
    $problems .= $q->li("minsens ($minsens) must be smaller then maxsens ($maxsens)");
}

# report problem if any
if ($problems ne "") {
    print $q->header("text/html");
    print $q->start_html({-title=>"Redraw Molecular Symptoms Image",
			  -style=>{'src'=>'/includes/style.css'}});
    print $q->h1("Redraw Molecular Symptoms Image");
    print($q->p("The following problem(s) have been encountered:"),
	  $q->ul($problems));

    print($q->p("The following parameters have been received:"));
    my @parameters = $q->param();
    print "<UL>";
    foreach (@parameters) {
	print $q->li($_, " : ", $q->param($_));
    }
    print "</UL>";
    print $q->ul($q->li("Referer: ", $q->referer()));
    print $q->end_html();
    exit(0);
}

# write the task table for the server
my $handle = gensym();
my $filename = $tmpPath . time() . ".tab";
$referer =~ s/\#[^\#]*$//;
open($handle, ">$filename");
print $handle <<EndOfTable;
action\t"redraw_pred_img"
data.path\t"$datapath"
aclass\t"$aclass"
show.graph\t"$show_graph"
lab.len\t"$lab_len"
sample.labels\t"$sample_labels"
f.red\t"$f_red"
f.green\t"$f_green"
f.blue\t"$f_blue"
t.red\t"$t_red"
t.green\t"$t_green"
t.blue\t"$t_blue"
minspec\t"$minspec"
minsens\t"$minsens"
maxsens\t"$maxsens"
bin.thresh\t"$bin_thresh"
to.URL\t"$referer\#pred_img"
EndOfTable
close($handle);

# redirect as soon as busy exists
while (!(-e "$datapath/busy.html")) { sleep(1); }
print($q->redirect("/cgi-bin/stam/busy.pl?datapath=$datapath"));
exit(0);

# auxiliaries

sub is_int {
    my($x) = @_;
    if ($x =~ m/^\d+$/) { return(1); }
    return(0);
}

sub is_ok {
    my($x,$name) = @_;
    if (($x !~ m/^\d+\.?\d*$/) && ($x !~ m/^\.?\d+$/)) {
	return($q->li("$name ($x) is not numeric"));
    }
    if (($x < 0) || ($x > 1)) {
	return($q->li("$name ($x) is not in [0.0, 1.0]"));
    }
    return("");
}

#
#   end of file
#


