#!/usr/local/public/perlace/bin/perl -I/usr/local/public/perlace/lib/perl5
#####################################################################
# comment - allows user to add comments to a database via markup rule
####################################################################

# use & require
use acelib::Acedb;
use acelib::AceWWW;
use CGI qw(:standard :cgi-lib);

print header;
$query = new CGI; # parse form input

$db = param('db');
$class = param('class');
$object = param('object');
param('remote',remote_host());
hidden('remote',param('remote')),"\n";

param('dbtitle',$dbinfo{$db}{'title'});

if (!param('sender email') || !param('sender') || param('sender email') !~ m/^[\w-]+\@[A-Za-z0-9]+(\.[\w-]+)*\.[A-Za-z0-9]+$/) {&opening;}
#elsif (param('correction') && param('sender email')) {&mailitoff;}
else {&mailitoff;}
print endform;
print end_html;
exit;

sub opening {
    print start_html(-title=>'Correction form for ' . param('dbtitle'),
			     -background=>'/icons/dnabak3.gif',
			     -text=>'#000000',
			     -link=>'#0000ff', 
			     -vlink=>'#551a8b',
			     -alink=>'#ff0000',
			     -bgcolor=>'#c0c0c0')."\n";
    print startform(-method => 'POST',"http://grain.jouy.inra.fr/cgi-bin/comment");
	print "<strong>Database:</strong> " . param('dbtitle');
	print hidden('dbtitle',param('dbtitle')),"\n";
	print hidden('db',param('db')),"\n";
	print "<br><strong>Class:</strong> " . param('class');
	print hidden('class',param('class')),"\n";
	print "<br><strong>Object Name:</strong> " . param('object');
	print hidden('object',param('object')),"\n";

    if (param('sender')) {print hidden('sender',param('sender')),"\n";}
    elsif (!param('sender')) {
	print "<br>", textfield(-name=>'sender', -size => 50)." <strong>Name and affiliation</strong>\n";
    }
    
    if (param('sender email') =~ m/^[\w-]+\@[A-Za-z0-9]+(\.[\w-]+)*\.[A-Za-z0-9]+$/) {print hidden('sender email',param('sender email')),"\n";}
    else {
	if (param('sender email') !~ m/^\s*$/) {print "<br><font color=red>E-mail address is <strong>invalid</strong> - please enter e-mail address again</font>\n";}
	print "<br>",textfield(-name=>'sender email', -size => 50)," <strong>E-mail address</strong> (required)\n";
    }
    if (param('edited')) {
	print hidden('edited',param('edited')),"\n";
	print hidden('saved acedump') if (param('saved acedump'));
    }
    elsif (!param('edited')) {

print "<p>Please edit the entry directly and add any comments to the Comments/References box.  <br>If
 you can supply a reference it will help us reconcile your information
 with the original data source.<br> Additional information on the
 fields available in this data class can be found at the bottom of
 this page.<br>";

	print "\n";
	$myobj = &acelib::Acedb::getObj($db,$class,$object);
	@outstrings = $myobj->prettyPrint2(1);
	$outstrings[0] =~ s/^( *\"[^\"]+\" +)(.+)$/$class:  $1\n     $2/; # "
	my ($actuallength) = length($1) - 5;
#	print "<h1>Actual length = $actuallength</h1>\n"; # test
	my $outstrings2 = @outstrings; # length of array
	for ($i=1; $i<$outstrings2; $i++) {
	    $outstrings[$i] =~ s/^ {$actuallength}//;
	}
	$fulloutput = join("\n", @outstrings);
	param('saved acedump',$fulloutput);
	print hidden('saved acedump',param('saved acedump'));
#	print param('saved acedump'),"<br>\n"; # test
	print textarea(-name=>'edited', -rows=>20, -columns=>60, -default=>$fulloutput),"\n";
    }
    if (param('references')) {
	print hidden('references',param('references')),"\n";
    }
    elsif (!param('references')) {
	print "<p><strong>Comments/References</strong><br>\n";
	print textarea(-name=>'references', -rows=>8, -columns=>60),"\n";
    }
    print submit('correction', 'Send corrections to ' . param('dbtitle') . ' curators'),"\n";
    print "<br>Thanks very much for your feedback!\n";
    print "<br> - The GrainGenes curators, Dave Matthews, Gerry Lazo, Olin Anderson\n";
    
    print "<hr>";
    if (param('model')) { print hidden('model'),"\n";}
    else {
	if ($class =~ /probe/i) {
	    print 'More information about how to edit data for this class can be found <a href="gopher://probe.nalusda.gov:7002/00/.administration/Template%20for%20Probe%20data">HERE</a>.';
	} elsif ($class =~ /locus|map_data/i) {
	    print 'More information about how to edit data for this class can be found <a href="gopher://probe.nalusda.gov:7002/00/.administration/Template%20for%20Map%20and%20Locus%20data">HERE</a>.';
	} elsif ($class =~ /2_Point_Data/i) {
	    print 'More information about how to edit data for this class can be found <a href="gopher://probe.nalusda.gov:7002/00/.administration/Template%20for%202_Point_Data">HERE</a>.';
	} elsif ($class =~ /QTL/i) {
	    print 'More information about how to edit data for this class can be found <a href="gopher://probe.nalusda.gov:7002/00/.administration/Template%20for%20QTL%20data">HERE</a>.';
	} elsif ($class =~ /Germplasm/i) {
	    print 'More information about how to edit data for this class can be found <a href="gopher://probe.nalusda.gov:7002/00/.administration/Template%20for%20Germplasm%20records">HERE</a>.';
	} elsif ($class =~ /reference/i) {
	    print 'More information about how to edit data for this class can be found <a href="gopher://probe.nalusda.gov:7002/00/.administration/Template%20for%20References">HERE</a>.';
	}
	$model = &acelib::Acedb::getCleanModel($db, $class);
	$acelib::AceWWW::dbURL = sub { my ($db, $class, $value) = @_;
				       $value =~ s/^[\?\#]//;
				       return "$main::baseURL/cgi-bin/model?db=$main::db&class=$value";
				   };
	print join("\n", &acelib::AceWWW::ace2html($model));
	param('model',' ');
	print hidden('model',param('model')),"\n";
    }
}

sub mailitoff {
    print start_html(-title=>'Correction form for ' . param('dbtitle'),
			     -background=>'/icons/dnabak3.gif',
			     -text=>'#000000',
			     -link=>'#0000ff', 
			     -vlink=>'#551a8b',
			     -alink=>'#ff0000',
			     -bgcolor=>'#c0c0c0')."\n";
    print startform(-method => 'POST',"http://grain.jouy.inra.fr/cgi-bin/comment");

    $sendmail = "/usr/lib/sendmail";

    $send_to =  "tthews\@greengenes.cit.cornel.edu zo\@pw.usd.gov ndersn\@pw.usd.gov";
    $send_from = param('sender email');
    
    open(MAILIT, "| $sendmail \"$send_to\"");
    print MAILIT <<ENDOFHEADERINFO;
From: $send_from
To: $send_to
Subject: ***GrainGenes Correction Alert***
  
ENDOFHEADERINFO
    print "Your corrections/comments have been mailed to the ", param('dbtitle'), " curator.\n";
    print   MAILIT "Sender: ",param('sender'), "\n";
    print  "<p>Sender: ",param('sender'),"\n";
    print "<br>Remote machine: ",param('remote'),"\n";
    print MAILIT "Remote machine: ",param('remote'),"\n";
    print   MAILIT "Senders E-mail: ",param('sender email'), "\n\n";
    print  "<br>Senders E-mail: ",param('sender email'),"\n";
    my $myedited = param('edited');
    print  "<p>CORRECTED OBJECT:<br><pre>",$myedited,"</pre>\n";
    $myedited =~ s/\r//g; #gets rid of \r which DOS machines combine with \n to make a ^M, which causes problems
    print   MAILIT "CORRECTED OBJECT:\n\n",$myedited, "\n";
my $myacedump = param('saved acedump');
    print  "<p>ORIGINAL OBJECT in ace format:<p><pre>", $myacedump,"</pre>\n";
$myacedump  =~ s/\r/\n/g; #gets rid of \r which DOS machines combine with \n to make a ^M, which causes problems
  print  MAILIT "\n\nORIGINAL OBJECT in ace format:\n\n", $myacedump,"\n\n";
    if (param('references')) {
my $myreferences = param('references');
	print  "<p>COMMENTS/REFERENCES:<br><pre>",$myreferences,"</pre>\n";
$myreferences  	=~ s/\r//g; #gets rid of \r which DOS machines combine with \n to make a ^M, which causes problems
print   MAILIT "COMMENTS/REFERENCES:\n\n",$myreferences, "\n";
    }
    close  MAILIT;
}