#!/tools/perl/current/bin/perl package Go; ####################################################################### ##### Author : Shuai Weng ##### Date : August 2000 ##### Description : This package contains all necessary methods for sgd ##### curators to display, update, insert or delete Go ##### related info in oracle database. ##### ####################################################################### use strict; use DBI; use CGI qw/:all/; use CGI::Carp qw(fatalsToBrowser); use lib "/share/daisy/www-data/lib/common"; use Login qw (ConnectToDatabase); use lib "/share/daisy/www-data/lib/SGD"; use FormatSGD qw (PrintPageTop Divider75 FooterReturnEmail); use CuratorCentral qw(:getInfo); use Feature qw (:getInfo); ####################################################################### #################### global variables ################################# ####################################################################### my $dbh; my $query; my $dblink; my $goCurationUrl; my %goEvidenceCode; my %goEvidenceNo; ####################################################################### sub new { ############ constructor ############################### ####################################################################### my ($self, %args) = @_; $self = {}; bless $self; $self->{'_database'} = $args{'database'}; $self->{'_help'} = defined($args{'help'}) ? $args{'help'} : "usingGO.html"; $self->{'_title'} = defined($args{'title'}) ? $args{'title'} : "GO Curation Page"; $self->{'_user'} = defined($args{'user'}) ? $args{'user'} : ""; $self->{'_feat'} = defined($args{'feat'}) ? $args{'feat'} : ""; $self->{'_type'} = defined($args{'type'}) ? $args{'type'} : ""; $dbh = &ConnectToDatabase($self->database); return $self; } sub help { $_[0]->{_help} } sub database { $_[0]->{_database} } sub title { $_[0]->{_title} } sub user { $_[0]->{_user} } ###################################################################### sub DESTROY { ############ destructor ############################## ###################################################################### if (defined $dbh) { $dbh->disconnect; } } ###################################################################### sub start{ ###################################################################### my ($self) = @_; if ($self->database eq "sgd") { $dblink = "SGD"; } else { $dblink = "SGDDEV"; } $goCurationUrl = "http://genome-www4.stanford.edu/cgi-bin/$dblink/curation/goCuration"; if (!$self->user) { print "location: http://genome-www4.stanford.edu/cgi-bin/$dblink/curatorLogin\n"; print "Content-type: text/html\n\n"; exit; } my $user = $self->user; $user = "\U$user"; my ($dbuser, $dbpasswd) = &getUsernamePassword($user); if (!$dbuser || !$dbpasswd) { print "location: http://genome-www4.stanford.edu/cgi-bin/$dblink/curatorLogin\n"; print "Content-type: text/html\n\n"; exit; } $query = new CGI; $self->{'_feat'} =~ s/^ *//; $self->{'_feat'} =~ s/ *$//; $self->{'_feat'} =~ s/[\t\r\f\n]+//g; if ($query->param('commit')) { $dbh->disconnect; $dbh = &ConnectToDatabase($self->database, $dbuser, $dbpasswd); $self->getEvidenceCode; $self->commitInfo; } elsif ($query->param('type')) { $self->getEvidenceCode; if (!$query->param('morerows')) { $self->checkQuery; $self->displayRowsFromDB; } else { $self->displayMoreRows; } } else { $self->printEntryForm; } } ####################################################################### sub printEntryForm { ####################################################################### my ($self) = shift; $self->printStartPage($self->database, $self->title, $self->help); my %typeLabels = ('Locus'=>'Locus or locus_no', 'Feature'=>'Feature or feature_no'); my @typeValues = qw/Locus Feature/; my $defaultType = 'Locus'; ########################## print startform({-method=>'POST', -action=>$goCurationUrl}), b("This form is for SGD curators to display, update, insert or delete GO related info in oracle database"),p, b(font({-size=>"+1"}, 'Enter ')), popup_menu(-name=>'type', -"values"=>\@typeValues, -default=>$defaultType, -labels=>\%typeLabels ), b(": "), textfield(-name=>'feat', -size=>30), p, hidden('user', "$self->user"), submit('Submit','Submit'), " ", reset, endform; $self->printEndPage; } ######################################################################## sub displayRowsFromDB { ######################################################################## my ($self) = shift; my $title; if ($query->param('type') =~ /Feature/i) { $title = $self->title." for ".$self->{'_featNm'}; } else { $title = $self->title." for ".$self->{'_locusNm'}; } $self->printStartPage($self->database, $title, $self->help); if ($query->param('type') =~ /Feature/i) { $self->printSubtitle($self->{'_featNm'}, "(feature_no=$self->{'_featNo'})"); } else { $self->printSubtitle($self->{'_locusNm'}, "(locus_no=$self->{'_locusNo'})"); } print startform({-method=>'POST', -action=>$goCurationUrl}); print "
You have to select ontology before press the Submit button. Please go back, make all necessary selection and try again.
"; exit; } my @goevCode = $query->param("goEvCode$i"); if ($#goevCode < 0) { print "
You have to select the go_evidence_code before press the Submit Button. Please go back, make any necessary selection and try again.
"; exit; } my $goAspectDB = $self->getGoAspectBYgoid($goid); my $goTermDB = $self->getGoTermBYgoid($goid); if ($goAspect ne $goAspectDB) { $goAspectDB =~ s/C/Cellular Component/; $goAspectDB =~ s/F/Function/; $goAspectDB =~ s/P/Process/; $goAspect =~ s/C/Cellular Component/; $goAspect =~ s/F/Function/; $goAspect =~ s/P/Process/; print "The GOID $goid is associated eith the go_term '$goTermDB' in the $goAspectDB ontology, not the $goAspect ontology. Please go back and make a correction.
"; exit; } if ($query->param("deleteAnnot$i") =~ /on/i) { $self->deleteAnnotation($goid, $locusORfeatNo, $paperObject, $type); print font({-color=>'red'},b("The annotation for goid=$goid, ${type}_no=$locusORfeatNo, and paperObject='$paperObject' has been deleted from database.")).p; next; } my @goevNoDB; if ($type =~ /locus/i) { @goevNoDB = $self->getGoevNoBYgoidLocusNoPaperObject( $goid, $locusORfeatNo, $paperObject); } else { @goevNoDB = $self->getGoevNoBYgoidFeatureNoPaperObject( $goid, $locusORfeatNo, $paperObject); } my %goevDB; foreach my $goevNo (@goevNoDB){ $goevDB{$goevNo}++; } my %goev; foreach my $goevCode (@goevCode) { my $goevNo = $goEvidenceNo{$goevCode}; if (!$goevDB{$goevNo}) { ### new one if ($type =~ /locus/i) { $self->insertGoLocusGoevEntry($goid, $locusORfeatNo, $goevNo); } else { $self->insertGoFeatGoevEntry($goid, $locusORfeatNo, $goevNo); } $self->insertAcelinkEntry($goid, $locusORfeatNo, $goevNo, $paperObject, $type); $update++; } else { $goev{$goevNo}++; } } foreach my $goevNo (@goevNoDB){ if (!$goev{$goevNo}) { ### unlink or delete it $self->deleteAcelinkEntry($goid, $locusORfeatNo, $goevNo, $paperObject, $type); $update++; } } ####### update locus list which share the same annotation my $locusListDB = $self->getLocusListBYgoidPaperGoevCode( $goid, $paperObject, \@goevCode); my @locusDB = split(/\|/,$locusListDB); my $locuslist = $query->param("locuslist$i"); my @locusNEW = split(/\|/, $locuslist); my %locusDB; my %locusNEW; foreach my $locus (@locusDB) { $locusDB{$locus}++; } foreach my $locus (@locusNEW) { $locus =~ s/^ *//; $locus =~ s/ *$//; $locus =~ s/[\r\t\f\n]//g; $locus = "\U$locus"; if (!$locusDB{$locus}) { ### new one $self->linkLocusToAnnotation($goid, $paperObject, \@goevCode, $locus); $update++; } else { $locusNEW{$locus}++;} } foreach my $locus (@locusDB) { if (!$locusNEW{$locus}) { $self->unlinkLocusFromAnnotation($goid, $paperObject, \@goevCode, $locus); $update++; } } ####### update feature list which share the same annotation my $featListDB = $self->getFeatureListBYgoidPaperGoevCode( $goid, $paperObject, \@goevCode); my $featList = $query->param("featlist$i"); my @featDB = split(/\|/, $featListDB); my @featNEW = split(/\|/, $featList); my %featDB; my %featNEW; foreach my $feature (@featDB) { $feature = "\U$feature"; $featDB{$feature}++; } foreach my $feature (@featNEW) { $feature =~ s/^ *//; $feature =~ s/ *$//; $feature =~ s/[\r\t\f\n]//g; $feature = "\U$feature"; if (!$featDB{$feature}) { ### new one $self->linkFeatureToAnnotation($goid, $paperObject, \@goevCode, $feature); $update++; } else { $featNEW{$feature}++;} } foreach my $feature (@featDB) { $feature = "\U$feature"; if (!$featNEW{$feature}) { $self->unlinkFeatureFromAnnotation($goid, $paperObject, \@goevCode, $feature); $update++; } } ############################################################## if ($update > 0) { print "The annotation for goid=$goid ${type}_no=$locusORfeatNo paperObject=$paperObject has been updated.
"; } ############################################################## } ################## if ($type =~ /locus/i) { my $locusNm = $query->param('locusNm'); print "
View locus $locusNm"; } elsif ($type =~ /feature/i) { my $featNm = $query->param('featNm'); print "
View feature $featNm"; } my $user = $self->user; print "
Return to SGD Curator Central
";
##################
##################
$self->printEndPage;
##################
}
########################################################################
sub checkQuery {
########################################################################
my ($self) = shift;
if (!$self->{'_feat'}) {
$self->err_report("You have to enter locus or feature name or number before press the Submit button. Please go back and try again.");
}
if ($self->{'_type'} =~ /Feature/i) {
if ($self->{'_feat'} =~ /^[0-9]+$/) {
$self->{'_featNo'} = $self->{'_feat'};
$self->{'_featNm'} = &getFeatureNmBYfeatureNo($dbh,
$self->{'_featNo'});
if (!$self->{'_featNm'}) {
$self->err_report("The feature_no you entered ($self->{'_featNo'}) is not found in database. Please go back, change the input and try again.");
}
}
else {
$self->{'_featNm'} = "\U$self->{'_feat'}";
$self->{'_featNo'} = &getFeatureNoBYfeatureNm($dbh,
$self->{'_featNm'});
if (!$self->{'_featNo'}) {
$self->err_report("The feature_name you entered ($self->{'_featNm'}) is not found in database. Please go back, change the input and try again.");
}
}
}
else {
if ($self->{'_feat'} =~ /^[0-9]+$/) {
$self->{'_locusNo'} = $self->{'_feat'};
$self->{'_locusNm'} = &getLocusNmBYlocusNo($dbh,
$self->{'_locusNo'});
if (!$self->{'_locusNm'}) {
$self->err_report("The locus_no you entered ($self->{'_locusNo'}) is not found in database. Please go back, change the input and try again.");
}
}
else {
$self->{'_locusNm'} = "\U$self->{'_feat'}";
$self->{'_locusNo'} = &getLocusNoBYlocusNm($dbh,
$self->{'_locusNm'});
if (!$self->{'_locusNo'}) {
$self->err_report("The locus_name you entered ($self->{'_locusNm'}) is not found in database. Please go back, change the input and try again.");
}
}
}
}
########################################################################
sub checkGoid {
########################################################################
my ($self, $goid) = @_;
my $sth = $dbh->prepare_cached("
SELECT go_term
FROM prod.go
WHERE goid = ?
");
$sth->execute($goid);
my $goTerm = $sth->fetchrow();
$sth->finish;
return $goTerm;
}
########################################################################
sub getGoidBYlocusNo {
########################################################################
my ($self, $locusNo) = @_;
my $sth = $dbh->prepare_cached("
SELECT unique goid
FROM prod.go_locus_goev
WHERE locus_no = ?
");
my @goid;
if ($sth->execute($locusNo)) {
while (my ($goid) = $sth->fetchrow()) {
push(@goid, $goid);
}
}
$sth->finish;
return @goid;
}
#######################################################################
sub getGoidBYfeatureNo {
#######################################################################
my ($self, $featNo) = @_;
my $sth = $dbh->prepare_cached("
SELECT unique goid
FROM prod.go_feat_goev
WHERE feature_no = ?
");
my @goid;
if ($sth->execute($featNo)) {
while (my ($goid) = $sth->fetchrow()) {
push(@goid, $goid);
}
}
$sth->finish;
return @goid;
}
#######################################################################
sub getGoevNoBYgoidLocusNoPaperObject {
#######################################################################
my ($self, $goid, $locusNo, $paperObject, $type) = @_;
my $sth = $dbh->prepare("
SELECT primary_key
FROM prod.acelink
WHERE primary_key like '${goid}::${locusNo}::%'
AND tab_name = 'GO_LOCUS_GOEV'
AND ace_object = '$paperObject'
AND ace_class = 'Paper'
");
my @goEvNo;
my @goEvCode;
if ($sth->execute) {
while(my ($prikey) = $sth->fetchrow()) {
if ($prikey =~ /^[0-9]+::[0-9]+::([0-9]+)$/) {
push(@goEvNo, $1);
push(@goEvCode, $goEvidenceCode{$1});
}
}
}
$sth->finish;
if ($type =~ /code/i) {
return @goEvCode;
}
else {
return @goEvNo;
}
}
#######################################################################
sub getGoevNoBYgoidFeatureNoPaperObject {
#######################################################################
my ($self, $goid, $featNo, $paperObject, $type) = @_;
$paperObject =~ s/\'/\'\'/g;
my $sth = $dbh->prepare("
SELECT primary_key
FROM prod.acelink
WHERE primary_key like '${goid}::${featNo}::%'
AND tab_name = 'GO_FEAT_GOEV'
AND ace_object = '$paperObject'
AND ace_class = 'Paper'
");
my @goEvNo;
my @goEvCode;
if ($sth->execute) {
while(my ($prikey) = $sth->fetchrow()) {
if ($prikey =~ /^[0-9]+::[0-9]+::([0-9]+)$/) {
push(@goEvNo, $1);
push(@goEvCode, $goEvidenceCode{$1});
}
}
}
$sth->finish;
if ($type =~ /code/i) {
return @goEvCode;
}
else {
return @goEvNo;
}
}
########################################################################
sub getGoAspectBYgoid {
########################################################################
my ($self, $goid) = @_;
my $sth = $dbh->prepare_cached("
SELECT go_aspect
FROM prod.go
WHERE goid = ?
");
$sth->execute($goid);
my $goAspect = $sth->fetchrow();
$sth->finish;
return $goAspect;
}
########################################################################
sub getGoTermBYgoid {
########################################################################
my ($self, $goid) = @_;
my $sth = $dbh->prepare_cached("
SELECT go_term
FROM prod.go
WHERE goid = ?
");
$sth->execute($goid);
my $goTerm = $sth->fetchrow();
$sth->finish;
return $goTerm;
}
########################################################################
sub getLocusListBYgoidPaperGoevCode {
########################################################################
my ($self, $goid, $paper, $goevCodeRef) = @_;
$paper =~ s/\'/\'\'/g;
my $sth = $dbh->prepare("
SELECT primary_key
FROM prod.acelink
WHERE ace_class = 'Paper'
AND ace_object = '$paper'
AND tab_name = 'GO_LOCUS_GOEV'
AND primary_key like '${goid}::%'
");
my @locusNo;
my $checkNo;
if ($query->param('locusNo')) {
$checkNo = $query->param('locusNo');
}
elsif ($self->{'_locusNo'}) {
$checkNo = $self->{'_locusNo'};
}
my $preLocusNo;
if ($sth->execute) {
while(my ($prikey) = $sth->fetchrow()) {
if ($prikey =~ /^[0-9]+::([0-9]+)::([0-9]+)$/) {
my $locusNo = $1;
if ($checkNo && $locusNo == $checkNo){ next;}
if ($preLocusNo == $locusNo) { next;}
push(@locusNo, $locusNo);
$preLocusNo = $locusNo;
}
}
}
$sth->finish;
my $locusList;
foreach my $locusNo (@locusNo) {
my @goevCode = $self->getGoevNoBYgoidLocusNoPaperObject($goid,
$locusNo, $paper, "code");
if ($self->cmpGoevs($goevCodeRef, \@goevCode) == 0) {
my $locusNm = &getLocusNmBYlocusNo($dbh, $locusNo);
$locusList .= "|$locusNm";
}
}
$locusList =~ s/^\|//;
return $locusList;
}
########################################################################
sub getFeatureListBYgoidPaperGoevCode {
########################################################################
my ($self, $goid, $paper, $goevCodeRef) = @_;
$paper =~ s/\'/\'\'/g;
my $sth = $dbh->prepare("
SELECT primary_key
FROM prod.acelink
WHERE ace_class = 'Paper'
AND ace_object = '$paper'
AND tab_name = 'GO_FEAT_GOEV'
AND primary_key like '${goid}::%'
");
my $checkNo;
if ($query->param('featNo')) {
$checkNo = $query->param('featNo');
}
elsif ($self->{'_featNo'}) {
$checkNo = $self->{'_featNo'};
}
my @featNo;
my $prefeatNo;
if ($sth->execute) {
while(my ($prikey) = $sth->fetchrow()) {
if ($prikey =~ /^[0-9]+::([0-9]+)::([0-9]+)$/) {
my $featNo = $1;
if ($checkNo && $featNo == $checkNo){ next;}
if ($prefeatNo == $featNo) { next;}
push(@featNo, $featNo);
$prefeatNo = $featNo;
}
}
}
$sth->finish;
my $featList;
foreach my $featNo (@featNo) {
my @goevCode = $self->getGoevNoBYgoidFeatureNoPaperObject($goid,
$featNo, $paper, "code");
if ($self->cmpGoevs($goevCodeRef, \@goevCode) == 0) {
my $featNm = &getFeatureNmBYfeatureNo($dbh, $featNo);
$featList .= "|$featNm";
}
}
$featList =~ s/^\|//;
return $featList;
}
########################################################################
sub getPaperObjectListBYgoidLocusNo {
########################################################################
my ($self, $goid, $locusNo) = @_;
my $sth = $dbh->prepare("
SELECT ace_object
FROM prod.acelink
WHERE primary_key like '${goid}::${locusNo}::%'
AND tab_name = 'GO_LOCUS_GOEV'
AND ace_class = 'Paper'
");
my @paperObject;
if ($sth->execute) {
while(my ($paperObject) = $sth->fetchrow()) {
push(@paperObject, $paperObject);
}
}
$sth->finish;
return @paperObject;
}
########################################################################
sub getPaperObjectListBYgoidFeatureNo {
########################################################################
my ($self, $goid, $featNo) = @_;
my $sth = $dbh->prepare("
SELECT ace_object
FROM prod.acelink
WHERE primary_key like '${goid}::${featNo}::%'
AND tab_name = 'GO_FEAT_GOEV'
AND ace_class = 'Paper'
");
my @paperObject;
if ($sth->execute) {
while(my ($paperObject) = $sth->fetchrow()) {
push(@paperObject, $paperObject);
}
}
$sth->finish;
return @paperObject;
}
########################################################################
sub getEvidenceCode {
########################################################################
my ($self) = shift;
my $sth = $dbh->prepare("
SELECT go_evidence_no, evidence_code
FROM prod.go_evidence
");
if ($sth->execute) {
while(my($goEvNo, $goEvCode) = $sth->fetchrow()) {
$goEvidenceCode{$goEvNo} = $goEvCode;
$goEvidenceNo{$goEvCode} = $goEvNo;
}
}
$sth->finish;
}
########################################################################
########################################################################
sub insertGoLocusGoevEntry {
########################################################################
my ($self, $goid, $locusNo, $goevNo) = @_;
$dbh->do("
INSERT INTO prod.go_locus_goev (goid, locus_no, go_evidence_no)
VALUES ($goid, $locusNo, $goevNo)
");
$dbh->commit;
}
########################################################################
sub insertGoFeatGoevEntry {
########################################################################
my ($self, $goid, $featNo, $goevNo) = @_;
$dbh->do("
INSERT INTO prod.go_feat_goev (goid, feature_no, go_evidence_no)
VALUES ($goid, $featNo, $goevNo)
");
$dbh->commit;
}
########################################################################
sub insertAcelinkEntry {
########################################################################
my ($self, $goid, $locusORfeatNo, $goevNo, $paperObject, $type) = @_;
my $prikey = "${goid}::${locusORfeatNo}::$goevNo";
$paperObject =~ s/\'/\'\'/g;
if ($type =~ /locus/i) {
$dbh->do("
INSERT INTO prod.acelink (acelink_no, tab_name, primary_key,
primary_key_col, ace_class, ace_object)
VALUES (prod.aceno_seq.nextval, 'GO_LOCUS_GOEV', '$prikey',
'LOCUS_NO', 'Paper', '$paperObject')
");
}
elsif ($type =~ /feature/i) {
$dbh->do("
INSERT INTO prod.acelink (acelink_no, tab_name, primary_key,
primary_key_col, ace_class, ace_object)
VALUES (prod.aceno_seq.nextval, 'GO_FEAT_GOEV', '$prikey',
'FEATURE_NO', 'Paper', '$paperObject')
");
}
$dbh->commit;
}
########################################################################
sub linkLocusToAnnotation {
########################################################################
my ($self, $goid, $paper, $goevCodeRef, $locus) = @_;
my $locusNo = &getLocusNoBYlocusNm($dbh, $locus);
foreach my $goevCode (@$goevCodeRef) {
my $goevNo = $goEvidenceNo{$goevCode};
my $prikey = "${goid}::${locusNo}::$goevNo";
my $tabNm = "GO_LOCUS_GOEV";
my $checkCode = $self->checkGoLocusGoevEntry($goid, $locusNo,
$goevNo);
if (!$checkCode) {
$self->insertGoLocusGoevEntry($goid, $locusNo, $goevNo);
}
$checkCode = $self->checkAcelinkEntry($prikey, $paper, $tabNm);
if (!$checkCode) {
$self->insertAcelinkEntry($goid, $locusNo, $goevNo, $paper,
"locus");
}
}
}
########################################################################
sub unlinkLocusFromAnnotation {
########################################################################
my ($self, $goid, $paper, $goevCodeRef, $locus) = @_;
my $locusNo = &getLocusNoBYlocusNm($dbh, $locus);
foreach my $goevCode (@$goevCodeRef) {
my $goevNo = $goEvidenceNo{$goevCode};
$self->deleteAcelinkEntry($goid, $locusNo, $goevNo, $paper,
"locus");
}
}
########################################################################
sub linkFeatureToAnnotation {
########################################################################
my ($self, $goid, $paper, $goevCodeRef, $feature) = @_;
my $featNo = &getFeatureNoBYfeatureNm($dbh, $feature);
foreach my $goevCode (@$goevCodeRef) {
my $goevNo = $goEvidenceNo{$goevCode};
my $prikey = "${goid}::${featNo}::$goevNo";
my $tabNm = "GO_FEAT_GOEV";
my $checkCode = $self->checkGoFeatGoevEntry($goid, $featNo,
$goevNo);
if (!$checkCode) {
$self->insertGoFeatGoevEntry($goid, $featNo, $goevNo);
}
$checkCode = $self->checkAcelinkEntry($prikey, $paper, $tabNm);
if (!$checkCode) {
$self->insertAcelinkEntry($goid, $featNo, $goevNo, $paper,
"feature");
}
}
}
########################################################################
sub unlinkFeatureFromAnnotation {
########################################################################
my ($self, $goid, $paper, $goevCodeRef, $feature) = @_;
my $featNo = &getFeatureNoBYfeatureNm($dbh, $feature);
foreach my $goevCode (@$goevCodeRef) {
my $goevNo = $goEvidenceNo{$goevCode};
$self->deleteAcelinkEntry($goid, $featNo, $goevNo, $paper,
"feature");
}
}
########################################################################
sub checkAcelinkEntry {
########################################################################
### if it exists, return acelink_no, else return undef
my ($self, $prikey, $paper, $tabNm) = @_;
$paper =~ s/\'/\'\'/g;
my $sth = $dbh->prepare("
SELECT acelink_no
FROM prod.acelink
WHERE tab_name = '$tabNm'
AND ace_class = 'Paper'
AND ace_object = '$paper'
AND primary_key like '$prikey'
");
$sth->execute;
my $acelink_no = $sth->fetchrow();
$sth->finish;
return $acelink_no;
}
########################################################################
sub checkGoLocusGoevEntry {
########################################################################
### if it exists, return goevNo, else return undef
my ($self, $goid, $locusNo, $goevNo) = @_;
my $sth = $dbh->prepare_cached("
SELECT go_evidence_no
FROM prod.go_locus_goev
WHERE goid = ?
AND locus_no = ?
AND go_evidence_no = ?
");
$sth->execute($goid, $locusNo, $goevNo);
my $num = $sth->fetchrow();
$sth->finish;
return $num;
}
########################################################################
sub checkGoFeatGoevEntry {
########################################################################
### if it exists, return goevNo, else return undef
my ($self, $goid, $featNo, $goevNo) = @_;
my $sth = $dbh->prepare_cached("
SELECT go_evidence_no
FROM prod.go_feat_goev
WHERE goid = ?
AND feature_no = ?
AND go_evidence_no = ?
");
$sth->execute($goid, $featNo, $goevNo);
my $num = $sth->fetchrow();
$sth->finish;
return $num;
}
########################################################################
########################################################################
sub deleteAcelinkEntry {
########################################################################
my ($self, $goid, $locusORfeatNo, $goevNo, $paperObject, $type) = @_;
$paperObject =~ s/\'/\'\'/g;
my $prikey = "${goid}::${locusORfeatNo}::${goevNo}";
if ($type =~ /locus/i) {
$dbh->do("
DELETE from prod.acelink
WHERE tab_name = 'GO_LOCUS_GOEV'
AND ace_class = 'Paper'
AND ace_object = '$paperObject'
AND primary_key like '$prikey'
");
$dbh->commit;
my $sth = $dbh->prepare("
SELECT ace_object
FROM prod.acelink
WHERE tab_name = 'GO_LOCUS_GOEV'
AND ace_class = 'Paper'
AND primary_key like '$prikey'
");
my $found;
if ($sth->execute) {
while(my ($acepaper) = $sth->fetchrow()) {
$found++;
}
}
$sth->finish;
if (!$found) {
$dbh->do("
DELETE from prod.go_locus_goev
WHERE goid = $goid
AND locus_no = $locusORfeatNo
AND go_evidence_no = $goevNo
");
$dbh->commit;
}
}
elsif ($type =~ /feature/i) {
$dbh->do("
DELETE from prod.acelink
WHERE tab_name = 'GO_FEAT_GOEV'
AND ace_class = 'Paper'
AND ace_object = '$paperObject'
AND primary_key like '$prikey'
");
$dbh->commit;
my $sth = $dbh->prepare("
SELECT ace_object
FROM prod.acelink
WHERE tab_name = 'GO_FEAT_GOEV'
AND ace_class = 'Paper'
AND primary_key like '$prikey'
");
my $found;
if ($sth->execute) {
while(my ($acepaper) = $sth->fetchrow()) {
$found++;
}
}
$sth->finish;
if (!$found) {
$dbh->do("
DELETE from prod.go_feat_goev
WHERE goid = $goid
AND feature_no = $locusORfeatNo
AND go_evidence_no = $goevNo
");
$dbh->commit;
}
}
}
########################################################################
sub deleteAnnotation {
########################################################################
my ($self, $goid, $locusORfeatNo, $paperObject, $type) = @_;
my @goevNo;
if ($type =~ /locus/i) {
@goevNo = $self->getGoevNoBYgoidLocusNoPaperObject(
$goid, $locusORfeatNo, $paperObject);
}
elsif ($type =~ /feature/i) {
@goevNo = $self->getGoevNoBYgoidFeatureNoPaperObject(
$goid, $locusORfeatNo, $paperObject);
}
foreach my $goevNo (@goevNo) {
$self->deleteAcelinkEntry($goid, $locusORfeatNo, $goevNo,
$paperObject, $type);
}
}
########################################################################
########################################################################
sub cmpGoevs {
########################################################################
my ($self, $goevRef1, $goevRef2) = @_;
##### return 0 if two array contains same codes,
##### otherwise return 1
my @sortedgoev1 = sort @$goevRef1;
my @sortedgoev2 = sort @$goevRef2;
my $tmp1 = join(':', @sortedgoev1);
my $tmp2 = join(':', @sortedgoev2);
if ($tmp1 eq $tmp2) {
return 0;
}
else {
return 1;
}
}
########################################################################
sub printSubtitle {
########################################################################
my ($self, $feature, $text) = @_;
print center(h2(a({-href=>"http://genome-www4.stanford.edu/cgi-bin/$dblink/locus.pl?locus=$feature",
-target=>"infowin"},
$feature).$text
));
print center(a({-href=>"http://genome-www4.stanford.edu/GO/main.html",
-target=>"infowin"},
"Open GO BROWSER")
);
}
########################################################################
sub printStartPage {
########################################################################
my ($self, $database, $title, $help) = @_;
print header;
print start_html(-title=>$title, -BGCOLOR=>"#FFFFFF");
&PrintPageTop($database, $title, $help);
}
########################################################################
sub printEndForm {
########################################################################
my ($self, $Nm, $No, $rowNo) = @_;
print
hidden('user', "$self->user"),
hidden('type', "$self->{'_type'}"),
hidden('rowNo', "$rowNo");
if ($query->param('type') =~ /feature/i) {
print
hidden('featNm', "$Nm"),
hidden('featNo', "$No");
}
else {
print
hidden('locusNm', "$Nm"),
hidden('locusNo', "$No");
}
print
submit('morerows','More Rows'), " ",
submit('commit','Submit'), " ",
endform;
}
########################################################################
sub printEndPage {
########################################################################
print
&Divider75,
&FooterReturnEmail,
end_html;
}
########################################################################
sub headerRow {
########################################################################
return Tr(td({-align=>'center'},
b(font({-size=>'-1'},
"Choose Ontology"))).
td({-align=>'center'},
b(font({-size=>'-1'},
"Enter GO ID number"))).
td({-align=>'center'},
font({-size=>'-1'},
b("Enter paper object").br.i("(if more than one, enter in another row)"))).
td({-align=>'center'},
b(font({-size=>'-1'},
"Choose Evidence code")))
);
}
########################################################################
sub ontologyField {
########################################################################
my ($self, $i, $ontology) = @_;
my %ontologyLabels = ('ontology'=>'-Ontology-',
'P'=>'Process',
'F'=>'Function',
'C'=>'Component');
my @ontologyValues = qw/ontology P F C/;
my $defaultOntology = "$ontology";
return popup_menu(-name=>"ontology$i",
-"values"=>\@ontologyValues,
-default=>$defaultOntology,
-labels=>\%ontologyLabels
);
}
########################################################################
sub goidField {
########################################################################
my ($self, $i, $goid, $goTerm) = @_;
return table(Tr(td({-align=>'left'},
b(font({-size=>'-1'},
"GO#:"))).
td({-align=>'left'},
textfield(-name=>"goid$i",
-value=>"$goid",
-size=>'7').br.
font({-size=>'-1'},
$goTerm))
));
}
########################################################################
sub goReferenceField {
########################################################################
my ($self, $i, $paperObject) = @_;
return table(Tr(td({-align=>'left'},
b(font({-size=>'-1'},
"Ref:"))).
td({-align=>'left'},
textfield(-name=>"reference$i",
-value=>"$paperObject",
-size=>'16'))
));
}
########################################################################
sub goEvidenceField {
########################################################################
my ($self, $i, $goevRef) = @_;
my @goevValues = qw/IMP IGI IPI ISS IDA IEP TAS NAS/;
return table(Tr(td(checkbox_group(-name=>"goEvCode$i",
-"values"=>\@goevValues,
-default=>\@$goevRef,
-rows=>'2')
)
));
}
########################################################################
sub locusList4goid {
########################################################################
my ($self, $i, $locusList) = @_;
return Tr(td({-colspan=>'2'},
font({-size=>'-1'},
"Enter loci that share this GO annotation; ".
"separate multiples by |")).
td({-colspan=>'2'},
textfield(-name=>"locuslist$i",
-value=>"$locusList",
-size=>'40'))
);
}
########################################################################
sub featureList4goid {
########################################################################
my ($self, $i, $featList) = @_;
return Tr(td({-colspan=>'2'},
font({-size=>'-1'},
"Enter features that share this GO annotation; ".
"separate multiples by |")).
td({-colspan=>'2'},
textfield(-name=>"featlist$i",
-value=>"$featList",
-size=>'40'))
);
}
########################################################################
sub printDeleteCB {
########################################################################
my ($self, $i, $deleteAnnot) = @_;
return Tr(td({-colspan=>'4'},
checkbox(-name=>"deleteAnnot$i",
-label=>" Delete this annotation")));
}
########################################################################
sub printMoreRows {
########################################################################
my ($self, $num) = @_;
my $beg = ++$num;
my $end;
if ($beg >= 5) {
$end = $beg + 1;
}
else {
$end = 7;
}
print $self->headerRow;
for (my $i = $beg; $i <= $end; $i++) {
print Tr(td($self->ontologyField($i)).
td($self->goidField($i)).
td($self->goReferenceField($i)).
td($self->goEvidenceField($i))),
$self->locusList4goid($i),
$self->featureList4goid($i),
$self->rowSeparator;
}
}
#######################################################################
sub printOneRow {
#######################################################################
my ($self, $i, $goAspect, $goid, $goTerm, $paper, $goevCodeRef,
$locusList, $featList, $deleteAnnot) = @_;
print
Tr(td($self->ontologyField($i, $goAspect)).
td($self->goidField($i, $goid, $goTerm)).
td($self->goReferenceField($i, $paper)).
td($self->goEvidenceField($i, $goevCodeRef))
),
$self->locusList4goid($i, $locusList),
$self->featureList4goid($i, $featList);
if (!$query->param('rowNo') || $i <= $query->param('rowNo')) {
print $self->printDeleteCB($i, $deleteAnnot);
}
print $self->rowSeparator;
}
########################################################################
sub rowSeparator {
########################################################################
return Tr(td({-colspan=>'4'},
hr));
}
########################################################################
sub err_report {
########################################################################
my ($self, $err) = @_;
print header;
print start_html(-title=>$self->title, -BGCOLOR=>"#FFFFFF");
&PrintPageTop($self->database, $self->title, $self->help);
print b($err);
print &Divider75,
&FooterReturnEmail,
end_html;
$dbh->disconnect;
exit;
}
########################################################################
1;
########################################################################