#!/usr/bin/perl -wT

use CGI;
$CGI::DISABLE_UPLOADS = 1;
$CGI::POST_MAX = 10 * 1024; ## why a submission would be 10K, I don't know...
undef $ENV{DEBUG};

use CGI::Carp::DebugScreen (debug => 0, modules => 1, raw => 1, );
#use CGI::Carp qw(fatalsToBrowser);
use Net::SMTP;
use HTML::Template;
use Data::Dumper;
use strict;

my $query = new CGI;
my $template = HTML::Template->new(
	path => [ '../html/' ],
#	path => [ '/Users/gwg/go/www/' ],
	filename => 'GO.tools.add-tool.tmpl',
	);

## die if we have no results
if (! $query->Vars() || scalar keys %{$query->Vars()} == 0)
{	## show the add tool page
	print STDERR "No keys found!\n" if $ENV{DEBUG};
	$template->param("title" => 'GO Tool Submission Form');
	$template->param("include_form" => 1);
	$template->param("opensource.no" => 1);
	$template->param("update_frequency.no_fixed" => 1);
	print "Content-Type: text/html\n\n";
	print $template->output();
	exit;
}

$template->param("title" => 'Tool Submission Results');

my $results;

my $t_info = {
	toolname => { name => 'tool name', order => 1 },
	toolurl => { name => 'tool URL', order => 2 },
	organization => { name => 'organization', order => 3 },
	organizationurl => { name => 'organization URL', order => 4 },
	contactname => { name => 'contact name', order => 5 },
	contactemail => { name => 'contact e-mail address', regexp_test => qr/^[\w-]+(\.[\w-]+)*@([\w-]+\.)+[a-zA-Z]{2,7}$/ , order => 6 },
	tool_type => { name => 'tool type or features', multi => 1, values => [ "browser", "search", "visualization", "editor", "database", "software", "statistical", "term_enrichment", "text_mining", "slimmer", "other_analysis" ], opt => 1, order => 7 },
	tool_type_other => { name => 'other tool feature(s)', opt => 1, order => 8 },
	description => { name => 'tool description', order => 9 },
	free => { name => 'tool cost', values => ['true'], opt => 1, order => 10 },
	opensource => { name => 'open source status', values => ['yes', 'no'], order => 11 },
	platform => { name => 'compatible platforms', multi => 1, values => [ qw( web win mac unix linux ) ], order => 12 },
	publications => { name => 'publications', opt => 1, order => 13 },
	go_data => { name => 'GO data used', multi => 1, values => [ qw( term def syn xref rel gp ev_code ref qual taxon subset ) ], opt => 1, order => 14 },
	go_data_other => { name => 'other GO data used', opt => 1, order => 15 },
	go_data_src => { name => 'GO data source', multi => 1, values => [ qw( obo gaf db owl xml other na ) ], opt => 1, order => 16 },
	go_data_src_other => { name => 'other GO data used', opt => 1, order => 17 },
	update_frequency => { name => 'data update frequency', values => [ qw( daily weekly monthly quarterly no_fixed na ) ], order => 18 },
	comments => { name => 'comments', opt => 1, order => 19 },
};

my $req_one = [
	[ qw( go_data go_data_other ) ],
	[ qw( go_data_src go_data_src_other ) ],
	[ qw(tool_type tool_type_other) ],
];

my $fail;

foreach my $k (keys %$t_info)
{	print STDERR "param $k\n" if $ENV{DEBUG};
	if (! $query->param($k) )
	{	# not optional: mark as missing
		if (! $t_info->{$k}{opt})
		{	$results->{missing}{$k} = 1;
			$fail++;
		}
		next;
	}

	# multiple answers OK
	if ($t_info->{$k}{multi})
	{	my @p_set = $query->param($k);
		foreach my $p (@p_set)
		{	if (! grep { $p eq $_ } @{$t_info->{$k}{values}})
			{	push @{$results->{invalid}{$k}}, $p;
			}
			else
			{	push @{$results->{valid}{$k}}, $p;
				$template->param( $k . "." . $p => 1 );
			}
		}
	}
	elsif ($t_info->{$k}{values}) ## one value of several allowed
	{	if (! grep { $query->param($k) eq $_ } @{$t_info->{$k}{values}})
		{	$results->{invalid}{$k} = $query->param($k);
		}
		else
		{	$results->{valid}{$k} = $query->param($k);
			$template->param( $k . "." . $query->param($k) => 1 );
		}
	}
	else
	{	if ($t_info->{$k}{regexp_test})
		{	if ($query->param($k) =~ /$t_info->{$k}{regexp_test}/)
			{	$results->{valid}{$k} = $query->param($k);
				$template->param( $k => $query->param($k) );
			}
			else
			{	$results->{invalid}{$k} = $query->param($k);
			}
		}
		else
		{	if ($query->param($k) =~ /\S+/)
			{	$results->{valid}{$k} = $query->param($k);
				$template->param( $k => $query->param($k) );
			}
			else
			{	$results->{invalid}{$k} = $query->param($k);
			}
		}
	}
	## no valid results and param is not optional
	$fail++ if (! $results->{valid}{$k} && ! $t_info->{$k}{opt});

	# required params
	if (! $results->{valid}{$k})
	{	# maybe there are no valid results
		next if $results->{invalid}{$k};
		# OK, it's just not there
		$results->{missing}{$k} = 1;
		$fail++;
	}
}

REQ_ONE:
foreach my $x (@$req_one)
{	#print STDERR "looking at " . join(", ", @$x) . "\n" if $ENV{DEBUG};
	foreach (@$x)
	{	next REQ_ONE if $results->{valid} && $results->{valid}{$_};
	}
	#print STDERR "got to here with " . join(", ", @$x) . "\n";
	$results->{missing}{$x->[0]}++;
	$fail++;
}

if ($fail)
{
	my @strs;
	if ($results->{missing})
	{	push @strs, { type => "Missing values", fields => join(", ", map { $t_info->{$_}{name} } sort { $t_info->{$a}{order} <=> $t_info->{$b}{order} } keys %{$results->{missing}}) };

		foreach (keys %{$results->{missing}})
		{	$template->param($_ . "_err" => 1);
		}
		print STDERR "missing keys: " . $strs[$#strs] . "\n\n" if $ENV{DEBUG};

	}
	if ($results->{invalid})
	{	push @strs, { type => "Dodgy values", fields => join(", ", map { $t_info->{$_}{name} } sort { $t_info->{$a}{order} <=> $t_info->{$b}{order} } keys %{$results->{invalid}} )};

		foreach (keys %{$results->{invalid}})
		{	$template->param( $_ . "_err" => 1 );
		}

		print STDERR "dodgy values: "  . $strs[$#strs] . "\n\n" if $ENV{DEBUG};
	}

	$template->param("err_list" => \@strs);
	$template->param("message_h2" => "Error!");
	$template->param("message" => "Your submission could not be processed as the following errors were found.");
	$template->param("include_form" => 1);
	print "Content-Type: text/html\n\n";
	print $template->output();
	exit;
}

if ($ENV{DEBUG})
{	print STDERR "All data looks fine!\n";
}

my $msg;

map {
	if ($results->{valid}{$_})
	{	if (! ref $results->{valid}{$_})
		{	$msg .= "$_: " . $results->{valid}{$_} . "\n";
		}
		else
		{	$msg .= "$_: " . join(", ", @{$results->{valid}{$_}}) . "\n";
		}
	}
} sort { $t_info->{$a}{order} <=> $t_info->{$b}{order} } keys %$t_info;

$msg .= "submission_date: " . localtime . "\n";

print STDERR "msg: $msg\n" if $ENV{DEBUG};

sendmail($results->{valid}{toolname}, $msg);

$template->param("message_h2" => 'Success!');
$template->param("success" => 1);
print "Content-Type: text/html\n\n";
print $template->output();
exit;

##################################################################

sub sendmail
{
	my ($toolname, $text) = @_;

	$ENV{PATH} = "/usr/lib";
	open (MAIL, "| /bin/mail -s 'Tool submission' gohelp\@geneontology.org -- -f go_tools_form\@geneontology.org") or die "Could not open mailer\n";
	print MAIL $toolname . " Tool submission\n\n"
	#reprint the data from the form
	. $text . "\n";
	close(MAIL);

	# send separate message to the user
#	open (MAILUSER , "| /bin/mailx -s 'Tool submission' " . $valid->{contactemail} . " -- -f " . $valid->{contactemail}) || die "Could not open mailer\n";
#	print MAILUSER $valid->{toolname} . " Tool submission\n\n"
#	reprint the data from the form
#	. $msg . "\n";
#	close(MAILUSER);
}