#!/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 $aclass           = $q->param('aclass');
my $delta            = $q->param('delta');
my $collapse_scnodes = $q->param('collapse_scnodes');

my $datafile = $filestem;
$datafile =~ s/[^\/]+$/eval.RData/;
my $datapath = $filestem;
$datapath =~ s/[^\/]+$//;

# verify consistency
if (!(-e "$filestem\.html")) { $problems .= $q->li("$filestem\.html does not exist"); }
if (!(-e "$datafile")) { $problems .= $q->li("$datafile does not exist"); }
$problems .= is_numeric($delta, "delta");

# report problem if any
if ($problems ne "") {
    print $q->header("text/html");
    print $q->start_html({-title=>"Refit model",
			  -style=>{'src'=>'/includes/style.css'}});
    print $q->h1("Refit model");
    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"refit_model"
data.path\t"$datapath"
aclass\t"$aclass"
delta\t"$delta"
collapse_scnodes\t"$collapse_scnodes"
to.URL\t"$referer\#refit"
EndOfTable
close($handle);

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

# auxiliaries

sub is_numeric {
    my($x,$name) = @_;
    if (($x !~ m/^\d+\.?\d*$/) && ($x !~ m/^\.?\d+$/)) {
	return($q->li("$name ($x) is not numeric"));
    }
    return("");
}

#
#   end of file
#


