Allow user to add comments to a database via markup rule

[Christophe Caron]

Hi

In webace the clickable "[View graphic]" at the top of html
pages does not work correctly in some cases.


The idea is to use this "feature":) to add a new functionnality:
 Allow user to add comments to a database via markup rule


This is already used in graingenes database at NAL, and mirror site at
Jouy-en-Josas (France).


You could look at some graingenes sites :
http://probe.nalusda.gov:8300/cgi-bin/browse/graingenes
or 
http://grain.jouy.inra.fr/cgi-bin/webace?db=graingenes

by selecting an class/object and click  on _Submit comment/correction




There are 4 steps to add this:

1) Add this rule to your markup.pl, in your '$ACEDB/wspec' directory.

#
# add comment in webace
# 
{
#
'keys' => sub {my ($node, $root) = @_;
                return ($node->{db},$node->{cl},$node->{va});
             },
'urls'=>'edit'
},
#
#
#


2)Add to standard_urls , in 'acelib' directory.

edit:_Submit comment/correction:$main::baseURL/cgi-bin/comment?db=$keys[0]&class=$keys[1]&object=$keys[2]


3)Copy this 'comment' script to your cgi-bin directory
and adapt it (email address(in $send_to variable), perl path, url
path, hostname, database name....) to your site.

#!/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;
} 








4)Add the procedure prettyPrint2 to your Aceobj.pm:

sub prettyPrint2 { # SB-S 6 June 1997
    # returns an array of strings, with the object formatted nicely
    # NOT in .ace format
    my ($obj,$past_root) = @_;
    my ($nodeText, @output);
    unless ($past_root) {
        @output = ("$obj->{'cl'} : \"$obj->{'va'}\"");
        foreach $next ($obj->right) {
            push (@output, &prettyPrint2($next, 1));
        }
    } else {
        $nodeText = $obj->{'ti'} || $obj->{'va'};
        if ($obj->{'ty'} ne 'tg') { #new
            $nodeText =~ s/\"/\\"/g; # " #new
            $nodeText = "\"".$nodeText."\""; #new
        }
        if ($obj->right) {
            my ($already);
            foreach $next ($obj->right) {
                my ($line);
                foreach $line (&prettyPrint2($next, 1)) {
                    push (@output, $nodeText . ' ' . $line);
                    unless ($already) {
                        $nodeText =~ tr// /c;
                        $already = 1;
                    }
                }
            }
        } else {
            @output = ($nodeText);
        }
    }
    return @output;
}


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

And test it....



christophe

Thanks to Dave Matthews, Jon Krainak, Matthew Couchman, Thierry
Hotelier for their help on ACEDB/Webace.

=========================================================
= Christophe Caron	C.T.I.S.
= I.N.R.A.		Domaine de Vilvert		=
= 78352 Jouy-en-Josas	email : caron at jouy.inra.fr	=
=========================================================