#!/usr/bin/perl
package sdevLocusCurationPage;

#######################################################################
##### Author :	Shuai Weng
##### Date   :  August 2000
##### Update :  July 2001
##### Description : This package contains all necessary methods for dictyBase
#####               curators to display, update, insert or delete Locus 
#####               related info in oracle database. 
#####              
#######################################################################
use strict;
use DBI;
use CGI qw/:all :html3/;
use CGI::Carp qw(fatalsToBrowser);
use lib "/usr/local/dicty/www_dictybase/db/lib/common";
use Login qw (ConnectToDatabase);
use TextUtil qw (DeleteUnwantedChar);
use lib "/usr/local/dicty/www_dictybase/db/lib/dictyBase";
use dictyBaseCentralMod qw(:formatPage :getInfo);
use lib "/usr/local/dicty/www_dictybase/db/lib/dictyBase/curation";
use sdevprintFeatureMod qw(:printInfo);
use lib "/usr/local/dicty/www_dictybase/db/lib/dictyBase/Objects";
use Gene_reservation;
use ConfigURLdictyBase;
use Gene_product;
use Curator_note;
use Locus_alias;
use Delete_log;
use Update_log;
use Locus_gp;
use Feature;
use Feature_type;
use Locus;
use Feat_cn;
use Feat_gene_info;
use Feat_pheno;
use Go_feat_goev;
use dictyBaseid;
use Alias;
use Reflink;

#######################################################################
#################### global variables #################################
#######################################################################

my $dbh;
my $dblink; 
my $configUrl;

#######################################################################
sub new {      ############ constructor ###############################
#######################################################################
       
	my ($self, %args) = @_;

	$self = {};
	bless $self;

      	$self->{'_database'} = $args{'database'};
	$self->{'_help'}     = $args{'help'};
	$self->{'_title'}    = defined($args{'title'}) ? 
	                       $args{'title'} : "Locus Curation Page";
	$self->{'_user'}     = $args{'user'};
	
	$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) = @_;
       $configUrl = ConfigURLdictyBase->new;	
       $dblink = $configUrl->dblink($self->database);
       if (!$self->user) {
	    print "location: ", $configUrl->dictyBaseCGIRoot, "$dblink/curatorLogin\n";
	    print "Content-type: text/html\n\n";
	    exit;
	}
	my ($dbuser, $dbpasswd) = &getUsernamePassword(uc($self->user), 
						       $self->database);
	if (!$dbuser || !$dbpasswd) {
	    print "location: ", $configUrl->dictyBaseCGIRoot, "$dblink/curatorLogin\n";
	    print "Content-type: text/html\n\n";
	    exit;
	}
	
	if (param('commit') && param('locusNm')) {
	    $dbh->disconnect;
	    $dbh = &ConnectToDatabase($self->database, 
				      $dbuser, $dbpasswd);
	    $self->commitInfo;
	}
	elsif (param('locus')) {
	    $self->displayInfo;
	}
	else {
	    $self->displayEntryForm;
	}
}

#######################################################################
sub displayEntryForm {
#######################################################################
    my ($self) = shift;

    &printStartPage($self->database, $self->title, $self->help);

    ##########################
    print 
    table(Tr(td(
		    startform,
		    b("This form is for dictyBase curators to display, update, insert or delete locus related info in oracle database."),p,
		    b(font({-size=>"+1"}, 'Enter Locus Name or Locus_no :')),
		         
		    textfield(-name=>'locus', -size=>30),
		    hidden('user', $self->user),   
		    submit('Submit','Submit'),
		    reset,

		    endform)));
    &printEndPage;
}


########################################################################
sub displayInfo {
########################################################################
    my ($self) = @_;
    my $locusObj = $self->createLocusObject;
    &printStartPage($self->database, $self->title, $self->help);
    my($chrnum, $featNmList, $aliasList, $aliasArrayRef, 
       $uniformAliasList, $nonUniformAliasList, $proteinNameAliasList, $name_desc, $desc, 
       $geneProductList, $phenotype, $noteArrayRef, $geneticPos, $geneReservationInfo, $collInfo);
    print startform,
          hidden('commit', "1"),
          hidden('user', $self->user);
    if (!$locusObj) {
	print b("The locus_name ".font({-color=>'red'}, $self->{'_locusNm'})." you entered is not found in database. You may enter info for this new locus or go back, correct the name and try again."),hr;
	&printAssigndictyBaseidBox;
    }
    else {
	print center(h2(a({-href=>$configUrl->dictyBaseCGIRoot."gene_page.pl?gene_name=".$self->{'_locusNm'},
			   -target=>"infowin"}, 
			  $self->{'_locusNm'}).
			" (locus_no=".$self->{'_locusNo'}.")"));
	$chrnum = $locusObj->chromosome;
	$featNmList = $locusObj->featureNameList;
        #all aliases - Uniform, Non-uniform, and Protein name aliases
	$aliasList = $locusObj->aliasNameList;
	#get alias names and alias no
	$aliasArrayRef = $locusObj->locusAliasArrayRef;
        #Uniform aliases 
	$uniformAliasList = $locusObj->uniformAliasNameList; 
        #Non-uniform aliases 
	$nonUniformAliasList = $locusObj->nonUniformAliasNameList; 
        #Protein name aliases 
	$proteinNameAliasList = $locusObj->proteinNameAliasNameList; 
	$name_desc = $locusObj->name_description;
	$desc = $locusObj->description;
	$geneProductList = $locusObj->gene_product;
	$noteArrayRef = $locusObj->curatorNoteInfoArrayRef;
	$geneticPos = $locusObj->genetic_position;
	$geneReservationInfo = $locusObj->geneReservationInfo;
	$collInfo = $locusObj->colleagueNmNo;
    }
   
    ######## delete locus_name from database
    if ($self->{'_locusNo'}) {
	print hidden('locusNo', $self->{'_locusNo'});
	&printDeleteLocusBox();
    }
    ######## reservation and colleague contact info
    if ($geneReservationInfo) {
	&printSubTitle("Reservation Info (table(s)=gene_reservation,colleague");
	&printGeneReservationInfo($geneReservationInfo, $collInfo);
	&printAddContact();
    }
    else {
	&printSubTitle("Colleague Contact Info");
	&printAddContact("add");
    }
    ######## feature and alias
    &printSubTitle("Name/Feature/Alias");
    print font({-color=>'red', -size=>-1}, 
	       "NOTE: To delete an alias permanently from the database, 
    select the check box for deleting that alias and also remove it from the 
    text field."), br;
    print font({-color=>'red', -size=>-1}, 
	       "When an alias is associated with more than one locus, you may not want to 
    permanently delete that alias from the database."), br;
    print font({-color=>'red', -size=>-1}, 
	       "In this situation, do not check the delete box but remove it from the 
                text field."), br;
    print br;
    &printUpdateLocusBox($self->{'_locusNm'});
    print br;
    &printUpdateFeatureBox($featNmList);
    print br;
    &printUpdateUniformAliasBox($uniformAliasList);
    print br;
    &printUpdateNonUniformAliasBox($nonUniformAliasList);
    print br;
    &printUpdateProteinNameAliasBox($proteinNameAliasList);
    print br;
    &printDeleteAliasBox($aliasList);
    print br;

    #make a hash of alias_name with alias_type as the value
    my %alias_name_alias_no;

    foreach my $rowRef(@$aliasArrayRef) {
		my ($alias_no, $alias_name) = @$rowRef;
		$alias_name_alias_no{$alias_name} = $alias_no;
	    }    

    if ($aliasList) {
	my @aliases = split(/\|/, $aliasList);
	foreach my $alias (@aliases) {
	    my $alias_no = $alias_name_alias_no{$alias};
	    my $aliasObj = Alias->new(dbh=>$dbh,
				      alias_no=>$alias_no);
	    my $locusNoList = $aliasObj->getLocusNoList;
	    if ($locusNoList !~ /:/) { next;}
	    my @locusNos = split(/:/, $locusNoList);
	    foreach my $otherLocusNo (@locusNos) {
		if ($otherLocusNo == $self->{'_locusNo'}) { next;}
		print font({-color=>'red'}, "The ".b($alias)." alias is used by locus_no $otherLocusNo. ").a({-href=>$configUrl->dictyBaseCGIRoot."$dblink/curation/locusCuration?user=".$self->user."&locus=$otherLocusNo",
													      -target=>"infowin"}, "View this locus"), br;
 	    }   
	}
    }

    if ($featNmList) {
	my @feature = split(/\|/, $featNmList);
	foreach my $featNm (@feature) {
	    print a({-href=>$configUrl->dictyBaseCGIRoot."$dblink/curation/featureCuration?user=".$self->user."&feature=$featNm", 
		     -target=>"infowin"},
		    "Edit feature $featNm details"), br;
	}
    }

    ####### name description
    &printSubTitle("Name Description");
    &printNameDesc($name_desc);

    if ($self->{'_locusNo'}) {
	&printSubTitle("GO");
	print "GO not yet curated: ".a({-href=>$configUrl->dictyBaseCGIRoot."$dblink/curation/goCuration?user=".$self->user."&type=locus&feat=".$self->{'_locusNm'}, 
					-target=>"infowin"}, 
				       "curate GO"), br;
    }

    ####### description
    &printSubTitle("Description");
    &printLocusDesc($desc);

    ####### gene product
    &printSubTitle("Gene Product (table(s)=gene_product)");
    print a({-href=>$configUrl->dictyBaseCGIRoot."$dblink/curation/dbSearch?type=gene_product", 
	     -target=>"infowin"},
	    "Search existing gene products"), br;
    
    &printGeneProduct($geneProductList);
    my @gpList = split(/\t/, $geneProductList);
    foreach my $gp (@gpList) {
	my $gpObj = Gene_product->new(dbh=>$dbh,
				      gene_product=>$gp);
	my $locusNoList = $gpObj->getLocusNoList;
	my $gpNo = $gpObj->gene_product_no;
	if ($locusNoList !~ /:/) { next; }
	print font({-color=>'red'}, "Warning: This gene product '$gp' is used by other loci/features in the database. ").
	    a({-href=>$configUrl->dictyBaseCGIRoot."$dblink/curation/dbSearch?id=$gpNo&type=gene_product", 
	       -target=>"infowin"}, "View Them"), br;
    }
    
    ####### phenotype
    &printSubTitle("Phenotype");
    if ($self->{'_locusNo'}) {
	print a({-href=>$configUrl->dictyBaseCGIRoot."$dblink/curation/phenotypeCuration?user=".$self->user."&type=locus&feat=".$self->{'_locusNm'},
		 -target=>"infowin"}, 
		"Curate Oracle phenotype"), br;
    }
#    if ($phenotype) { 
#	print hidden(-name=>'phenotypeDB', 
#		     -value=>$phenotype); 
#    }
#   &printPhenoType($phenotype);
    &printSubTitle("Genetic Position (table(s)=locus)");
    &printGeneticPosition($chrnum, $geneticPos);

    &printSubTitle("Curator Notes (table(s)=curator_note)");
    if ($self->{'_locusNo'}) {
	print a({-href=>$configUrl->dictyBaseCGIRoot."$dblink/locusHistory.pl?locus=".$self->{'_locusNm'}, 
		 -target=>"infowin"}, "View Locus History"), br;
    }
    
    my $i = 0;
    foreach my $rowRef (@$noteArrayRef, '') {
	my($noteNo, $note, $isPublic);
	if ($rowRef){($noteNo, $note, $isPublic) = @$rowRef;}
	my $idList;
	if ($noteNo) {
	    $i++;
	    my $noteObj = Curator_note->new(dbh=>$dbh,
					    curator_note_no=>$noteNo);
	    $idList = $noteObj->getTableNmPrikeyList;
	    $isPublic =~ s/Y/for public/;
	    $isPublic =~ s/N/for private/;
	    print font({-color=>'red'}, "Note $i:"), br, "$note (".font({-color=>'red'}, $isPublic.")");
	    if ($idList =~ / /) {
		print " (".font({-color=>'red'}, "shared by $idList"), br;
	    }
	    print a({-href=>$configUrl->dictyBaseCGIRoot."$dblink/curation/curatorNote?curatorNoteNo=$noteNo&user=".$self->user, 
		     -target=>"infowin"}, "Update this note"), p;
	    next;
	}
	if ($i >= 0) {
	    print font({-color=>'red'}, "Enter \"Locus History\" information here: 
Please be sure to answer \"Yes\" if you want it displayed publicly on the Locus 
History page."), br;
	}
	&printCuratorNote($dbh, $note, $isPublic);
    }

    ######################
    ######################
    print submit('submit', "Commit"),
          reset,
          endform;
    &printEndPage;
}


########################################################################
sub commitInfo {
########################################################################
    my ($self) = @_;

    ######## handle 'delete locus from database'
    if (param('locusDelCB')) {
	# $self->deleteLocus;
	$self->deleteConfirmationPage;
	exit;
    }
    if (param('confirm')) {
	$self->transferDeletePage;
	exit;
    }
    &printStartPage($self->database, $self->title, $self->help);

    ######## handle deleting stuff 
    if (param('locusNo')) {
	my $locusNo = param('locusNo');
	my $locusObj = Locus->new(dbh=>$dbh,
                              locus_no=>$locusNo);
	my $aliasArrayRef = $locusObj->locusAliasArrayRef;
	#make a hash of alias_name with alias_no as the value
	my %alias_name_alias_no;
	foreach my $rowRef(@$aliasArrayRef) {
		my ($alias_no, $alias_name) = @$rowRef;
		$alias_name_alias_no{$alias_name} = $alias_no;
	    }
	####### handle 'delete alias and gene_product from database'
	for (my $i = 1; $i <= 5; $i++) {
	    ##### delete alias
	    if (param("aliasDelCB$i") =~ /on/i) {
		my $aliasName = param("alias$i");
		my $aliasNo = $alias_name_alias_no{$aliasName};
		$self->deleteAlias($aliasNo, param("aliasDelLog$i"));
	    }
	    
	    ##### delete gene_product
	    if (param("gpDelCB$i") =~ /on/i) {
		$self->deleteGeneProduct(param("gp$i"),param("gpDelLog$i"));
	    }
	}
	
    }

    ######## check feature(s) to see if they are in database
    my (@featNo, @featNm);
    $self->checkFeatures(\@featNo, \@featNm);

    ######## update or insert into locus table
    my $locusObj;
    if (param('locusNo')) {   ### update locus table
	$locusObj = $self->updateLocusTable;
    }
    else { ### insert new locus entry
	$locusObj = $self->insertLocusEntry;
    }
    
    if (!$locusObj) { 
	&printEndPage;
	exit;
    }
	
    my $locusNo = $locusObj->locus_no;

    ######## update feature table
    $self->updateFeatureTable($locusObj);
    
    ######## update alias and locus_alias tables
    $self->updateAliasTable($locusObj);

    ######## update gene_product and locus_gp tables
    $self->updateGeneProductTable($locusObj);

    ####### update curator_note
    $self->updateCuratorNoteTable($locusObj);

    ####### make std gene name and update expiration_date here
    $self->makeStdNmANDupdateExpirationDate($locusObj); 

    ####### add new contact here
    $self->addColleagueContact($locusObj); 

    ####### assign dictyBaseid 
    $self->assigndictyBaseid4newLocus($locusObj);

    #################
    &printEndPage;
}

########################################################################
sub transferDeletePage {
########################################################################
    my ($self) = @_;
    &printStartPage($self->database, $self->title, $self->help);

    my $locusNo = param('locusNo');

    my $locusObj = Locus->new(dbh=>$dbh,
			      locus_no=>$locusNo);
    if (!$locusObj) {
	print "The locus_no = ".param('locusNo')." is not found in database.",br;
	&printEndPage;
	exit;
    }
    my $transaction = 'okay';
    if (param('confirm') =~ /^transfer/i) {
	eval { $self->transferLocusInfoToFeature($locusObj); };
	if ($@) { 
	    print "An error occurred when transfering data to feature.:$@", br;
	    print "The database will be rollback.",br;

	    $dbh->rollback;
	    $transaction = 'fail';
	}
	else { $dbh->commit; }
    }
    ##### delete locus
    if ($transaction eq "okay") {
	eval { $locusObj->delete; };
	if ($@) {
	    print "An error occurred when deleting locus entry for locus_no = ".param('locusNo')." from database.:$@",br;
	    $dbh->rollback;
	    $transaction = "fail";
	}
	else {
	    print "The locus entry for locus_no = ".param('locusNo')." has been deleted from database.", br;
	    $dbh->commit;
	}
    }
    if ($transaction eq "okay" && $locusObj->dictyBaseid) {
	my $dictyBaseid = $locusObj->dictyBaseid;
	$self->setdictyBaseid2Deleted($dictyBaseid);
	$self->updateCuratorNoteTable($locusObj, $dictyBaseid);
    }
    &printEndPage;
}

########################################################################
sub setdictyBaseid2Deleted {
########################################################################
    my ($self, $dictyBaseid) = @_;
    #### set its dictyBaseid_type to "Deleted' in dictyBaseid table
    my $dictyBaseidObj = dictyBaseid->new(dbh=>$dbh,
			      dictyBaseid=>$dictyBaseid);
    $dictyBaseidObj->updatedictyBaseid_type('Deleted');
    eval { $dictyBaseidObj->enterUpdates; };
    if ($@) {
	print "An error occurred when updating dictyBaseid_type to 'Deleted' for locus_no = ".param('locusNo'),br;
	$dbh->rollback;
    }
    else {
	print "The dictyBaseid_type has been updated to 'Deleted' for locus_no = ".param('locusNo'),br;
	$dbh->commit;
    }   
}

########################################################################
sub transferLocusInfoToFeature {
########################################################################
    my ($self, $locusObj) = @_;
   
    my @featNm = split(/\|/, $locusObj->featureNameList);
    my $locusNo = $locusObj->locus_no;
    foreach my $featNm (@featNm) {
	my $featObj = Feature->new(dbh=>$dbh,
				   feature_name=>$featNm);
	my $featNo = $featObj->feature_no;
	if (!$featObj) { next; }
	##### transfer to feat_gene_info table
	foreach my $rowRef (@{$locusObj->locusGeneInfoArrayRef}) { 
	    my ($refNo, $topic) = @$rowRef;
	    Feat_gene_info->Insert(dbh=>$dbh,
				   binds=>{feature_no=>$featNo,
				       reference_no=>$refNo,
				       literature_topic=>$topic});	  
	    print "The feat_gene_info entry for feature_no = $featNo, reference_no = $refNo, and topic = '$topic' has been inserted into database.", br;
	}
	##### transfer to go_feat_goev table
	foreach my $rowRef (@{$locusObj->goLocusGoevArrayRef}) { 
	    my ($goid, $goEvidenceNo, $isNot) = @$rowRef;
	    Go_feat_goev->Insert(dbh=>$dbh,
				 binds=>{goid=>$goid,
					 feature_no=>$featNo,
					 go_evidence_no=>$goEvidenceNo,
					 is_not=>$isNot});
	    print "The go_feat_goev entry for goid = $goid, feature_no = $featNo, go_evidence_no = $goEvidenceNo, and is_not = '$isNot' has been inserted into database.", br;

	    my $tabNm = 'GO_LOCUS_GOEV';
	    my $prikey = $goid.'::'.$locusObj->locus_no.'::'.$goEvidenceNo.'::'.$isNot;
	    my $prikeyCol = 'GOID::LOCUS_NO::GO_EVIDENCE_NO::IS_NOT';

	    my $refNolist 
		= Reflink->GetRefNoListBYtabNmPrikeyPrikeycol(dbh=>$dbh,
				       tab_name=>$tabNm,
		                       primary_key=>$prikey,
		                       primary_key_col=>$prikeyCol);

	    my @refNo = split(/\:/, $refNolist);
	    foreach my $refNo (@refNo) {
		my $reflinkObj = Reflink->new(dbh=>$dbh,
					      reference_no=>$refNo,
					      tab_name=>$tabNm,
					      primary_key=>$prikey,
					      primary_key_col=>$prikeyCol);
		$reflinkObj->updateTab_name('GO_FEAT_GOEV');
		$reflinkObj->updatePrimary_key($goid.'::'.$featNo.'::'.$goEvidenceNo.'::'.$isNot);
		$reflinkObj->updatePrimary_key_col('GOID::FEATURE_NO::GO_EVIDENCE_NO::IS_NOT');
		$reflinkObj->enterUpdates;
		
		print "The reflink entry for reference_no = $refNo, tab_name = 'GO_LOCUS_GOEV', primary_key = '$prikey' and primary_key_col = '$prikeyCol' has been transfered to feature_no = $featNo.", br;

	    }				  
	}
	##### transfer to feat_cn table
	foreach my $rowRef (@{$locusObj->curatorNoteInfoArrayRef}) { 
	    my ($noteNo, $note, $isPublic) = @$rowRef;
	    Feat_cn->Insert(dbh=>$dbh,
			    binds=>{feature_no=>$featNo,
				    curator_note_no=>$noteNo});
	    print "The feat_cn entry for feature_no = $featNo and curator_note_no = $noteNo has been inserted into database.", br;
	}

	##### transfer to alias table
	foreach my $rowRef (@{$locusObj->locusAliasArrayRef}) { 
	    my ($aliasNo, $aliasNm) = @$rowRef;
	    my $aliasObj = Alias->new(dbh=>$dbh,
				      alias_no=>$aliasNo);
	    if (!$aliasObj) { next; }
	    $aliasObj->updateFeature_no($featNo);
	    $aliasObj->enterUpdates; 
	    print "The alias entry for alias_no = $aliasNo has been updated.", br;
	}

	##### transfer to feat_pheno table
	foreach my $rowRef (@{$locusObj->phenotypeInfoArrayRef}) { 
	    my ($phenotype_no, $phenotype, $phenotype_type,$sentence) 
		= @$rowRef;
	    Feat_pheno->Insert(dbh=>$dbh,
			       binds=>{feature_no=>$featNo,
				       phenotype_no=>$phenotype_no,
				       phenotype_type=>$phenotype_type,
				       sentence=>$sentence});
	    print "The feat_pheno entry for feature_no = $featNo, phenotype_no = $phenotype_no, phenotype_type = '$phenotype_type', and sentence = '$sentence' has been inserted into database.", br;

	    my $tabNm = 'LOCUS_PHENO';
	    my $prikey = $locusObj->locus_no.'::'.$phenotype_no.'::'.$phenotype_type;
	    my $prikeyCol = 'LOCUS_NO::PHENOTYPE_NO::PHENOTYPE_TYPE';

	    my $refNolist 
		= Reflink->GetRefNoListBYtabNmPrikeyPrikeycol(dbh=>$dbh,
				       tab_name=>$tabNm,
		                       primary_key=>$prikey,
		                       primary_key_col=>$prikeyCol);

	    my @refNo = split(/\:/, $refNolist);
	    foreach my $refNo (@refNo) {
		my $reflinkObj = Reflink->new(dbh=>$dbh,
					      reference_no=>$refNo,
					      tab_name=>$tabNm,
					      primary_key=>$prikey,
					      primary_key_col=>$prikeyCol);
		$reflinkObj->updateTab_name('FEAT_PHENO');
		$reflinkObj->updatePrimary_key($featNo.'::'.$phenotype_no.'::'.$phenotype_type);
		$reflinkObj->updatePrimary_key_col('FEATURE_NO::PHENOTYPE_NO::PHENOTYPE_TYPE');
		$reflinkObj->enterUpdates;
		
		print "The reflink entry for reference_no = $refNo, tab_name = 'LOCUS_PHENO', primary_key = '$prikey' and primary_key_col = '$prikeyCol' has been transfered to feature_no = $featNo.", br;

	    }

	}
	
    }
}

########################################################################
sub deleteConfirmationPage {
########################################################################
    my ($self) = @_;
    &printStartPage($self->database, $self->title, $self->help);
    my $locusObj = Locus->new(dbh=>$dbh,
			      locus_no=>param('locusNo'));
    if (!$locusObj) {
	print "The locus_no = ".param('locusNo')." is not found in database.", br;
	&printEndPage;
	exit;
    }
    print b(font({-color=>'red'}, "Are you sure you want to delete locus ".$locusObj->locus_name."?")),p;
    print startform;
    if ($locusObj->featureNameList) {  ### with feature(s)
	print "This will delete the row in the locus table. The feature(s) ".b(font({-color=>'red'}, $locusObj->featureNameList))." will remain in the database.",p;
    }
    else {   ### without a feature
	print "This will delete the row in the locus table. ".$locusObj->locus_name."'s dictyBaseid (".$locusObj->dictyBaseidList.") will remain in dictyBaseid table but its dictyBaseid_type will be updated to 'Deleted'",p;

	&printSubTitle("Curator Notes (table(s)=curator_note)");

	&printCuratorNote();

    }
    #### list associated items here
    my $associatedItems = $self->getAssociatedItems($locusObj);
    if ($associatedItems) {
	print $locusObj->locus_name." is associated with the following data in the database:",p;
	print $associatedItems;
    }
    
    if ($locusObj->featureNameList) { 
	print table(Tr(td(hidden('user', $self->user).
		    hidden('locusNo', param('locusNo')).
                    hidden('locusNm', param('locusNm')).
		    hidden('confirm', 'transfer').
		    b(submit('commit','Delete and transfer these data to the feature')))));
	print table(Tr(td(hidden('user', $self->user).
		    hidden('locusNo', param('locusNo')).
		    hidden('locusNm', param('locusNm')).
		    hidden('confirm', 'delete').
		    b(submit('commit','Delete and do not transfer these data to the feature')))));
    }
    else {
	print table(Tr(td(hidden('user', $self->user).
		    hidden('locusNo', param('locusNo')).
		    hidden('locusNm', param('locusNm')).
		    hidden('confirm', 'delete').
		    b(submit('commit','Delete this locus')))));
    }
    print endform;
    &printEndPage;
}

########################################################################
sub getAssociatedItems {
########################################################################
    my ($self, $locusObj) = @_;
    my $associatedItems;
    my $list;
    ##### locus_gene_info table
    foreach my $rowRef (@{$locusObj->locusGeneInfoArrayRef}) { 
	my ($refNo, $topic) = @$rowRef;
	$list .= li("locus_no = ".$locusObj->locus_no.", reference_no = $refNo, literature_topic = '$topic'");
    } 
    if ($list) {
	$associatedItems = b("locus_gene_info:").p.ul($list).p;
	undef $list;
    }
    ##### go_locus_goev table
    foreach my $rowRef (@{$locusObj->goLocusGoevArrayRef}) { 
	my ($goid, $goEvidenceNo, $isNot) = @$rowRef;
	$list .= li("locus_no = ".$locusObj->locus_no.", goid = $goid, go_evidence_no = $goEvidenceNo, is_not = '$isNot'");
    }
    if ($list) {
	$associatedItems .= b("go_locus_goev:").p.ul($list).p;
	undef $list;
    }
    ##### reflink table
    my $refNoList = Reflink->GetRefNoBYlocusNo(dbh=>$dbh,
					   locus_no=>$locusObj->locus_no);
    my @refNo = split(/:/, $refNoList);
    foreach my $refNo (@refNo) {
	$list .= li("locus_no = ".$locusObj->locus_no.", reference_no = $refNo");
    }
    if ($list) {
	$associatedItems .= b("reflink:").p.ul($list).p;
	undef $list;
    }
    ##### locus_cn
    foreach my $rowRef (@{$locusObj->curatorNoteInfoArrayRef}) { 
	my ($noteNo, $note, $isPublic) = @$rowRef;
	$list .= li("locus_no = ".$locusObj->locus_no.", curator_note_no = $noteNo, curator_note = '$note'");
    }
    if ($list) {
	$associatedItems .= b("locus_cn:").p.ul($list).p;
	undef $list;
    }
    ##### locus_alias
    foreach my $rowRef (@{$locusObj->locusAliasArrayRef}) { 
	my ($aliasNo, $aliasNm) = @$rowRef;
	$list .= li("locus_no = ".$locusObj->locus_no.", alias_no = $aliasNo, alias_name = '$aliasNm'");
    }
    if ($list) {
	$associatedItems .= b("locus_alias:").p.ul($list).p;
	undef $list;
    }
    ##### locus_gp
    foreach my $rowRef (@{$locusObj->locusGpArrayRef}) { 
	my ($gpNo, $gp) = @$rowRef;
	$list .= li("locus_no = ".$locusObj->locus_no.", gene_product_no = $gpNo, gene_product = '$gp'");
    }
    if ($list) {
	$associatedItems .= b("locus_gp:").p.ul($list).p;
	undef $list;
    }
    ##### locus_pheno
    foreach my $rowRef (@{$locusObj->phenotypeInfoArrayRef}) { 
	my ($phenotype_no, $phenotype, $phenotype_type,$sentence) 
	    = @$rowRef;
	$list .= li("locus_no = ".$locusObj->locus_no.", phenotype_no = $phenotype_no, phenotype = '$phenotype'");
    }
    if ($list) {
	$associatedItems .= b("locus_pheno:").p.ul($list).p;
	undef $list;
    }
    
    return $associatedItems;
}

########################################################################
sub createLocusObject {
########################################################################
    my ($self) = @_;
    my $locus = param('locus');
    &DeleteUnwantedChar(\$locus);
    my ($locusObj, $locusNm, $locusNo);
    if ($locus =~ /^[0-9]+$/) {
	$locusObj = Locus->new(dbh=>$dbh,
			       locus_no=>$locus);
	if ($locusObj) {
	    $self->{'_locusNm'} = $locusObj->locus_name;
	    $self->{'_locusNo'} = $locus;
	}
	else {
	    $self->err_report("The locus_no ".font({-color=>'red'}, $locus)." you entered is not found in the database. Please go back, correct it and try again. Thanks.");
	}    
    }
    else {
	$locusObj = Locus->new(dbh=>$dbh,
			       locus_name=>$locus);
	if ($locusObj) {
	    $self->{'_locusNo'} = $locusObj->locus_no;
	    $self->{'_locusNm'} = $locusObj->locus_name;
	}   
	else {
	    $self->{'_locusNm'} = $locus;
	}
    }
    $self->{'_title'} .= " for ".$self->{'_locusNm'};
    return $locusObj;
}

########################################################################
sub assigndictyBaseid4newLocus {
########################################################################
    my ($self, $locusObj) = @_;
    if (param('assigndictyBaseidCB') !~ /on/i) {  return; }
    my $sth = $dbh->prepare("
         SELECT CGM_DDB.dictyBaseidno_seq.nextval
         FROM   dual
    ");
    $sth->execute;
    my $dictyBaseidNo = $sth->fetchrow;
    my $dictyBaseid = $dictyBaseidNo;
    for (my $i = 0; $i < 7-length($dictyBaseidNo); $i++) {
	$dictyBaseid = "0".$dictyBaseid;
    }
    $dictyBaseid = "S".$dictyBaseid;
    eval {
	dictyBaseid->Insert(dbh=>$dbh,
		      literals=>{dictyBaseid_no=>'CGM_DDB.dictyBaseidno_seq.currval'},
		      binds=>{dictyBaseid=>$dictyBaseid,
			      dictyBaseid_type=>'Primary',
			      tab_name=>'LOCUS',
			      primary_key=>$locusObj->locus_no});
    };
    if ($@) {
	print "An error occurred when inserting new dictyBaseid entry for locus_no = ".$locusObj->locus_no." into database:$@", br;
	$dbh->rollback;
    }
    else {
	print "The new dictyBaseid entry for locus_no = ".$locusObj->locus_no." has been inserted into database.", br;
	$dbh->commit;
    }
}

########################################################################
sub addColleagueContact {
########################################################################
    my ($self, $locusObj) = @_;
    my $collNo = param('colleagueNo');
    if ($collNo) { &DeleteUnwantedChar(\$collNo); }
    if (!$collNo) { return; }
    eval {
	Locus->AddColleagueContact(dbh=>$dbh,
				   colleague_no=>$collNo,
				   locus_no=>$locusObj->locus_no);
    };
    if ($@) {
	print "An error occurred when inserting new coll_locus entry for colleague_no = $collNo and locus_no = ".$locusObj->locus_no." into database:$@", br;
	$dbh->rollback;
    }
    else {
	print "The new coll_locus entry for colleague_no = $collNo and locus_no = ".$locusObj->locus_no." has been inserted into database.", br;
	$dbh->commit;
    }
} 


########################################################################
sub makeStdNmANDupdateExpirationDate {
########################################################################
    my ($self, $locusObj) = @_; 
   
    if (param('makeStdNmCB') !~ /on/i && !param('expirationDate')) {
	return;
    }

    ###### update feature_type for the associated ORF

    my $featList = $locusObj->featureNameList;

    my @featNm = split(/\|/, $featList);

    foreach my $featNm (@featNm) {

	my $featObj = Feature->new(dbh=>$dbh,
				   feature_name=>$featNm);

	if (!$featObj) { next; }

	my $featNo = $featObj->feature_no;

	my $featTypeObj = Feature_type->new(dbh=>$dbh,
					    feature_no=>$featNo,
					    feature_type=>'Uncharacterized');
	if (!$featTypeObj) {

	    $featTypeObj = Feature_type->new(dbh=>$dbh,
					     feature_no=>$featNo,
					     feature_type=>'Dubious');
	}

	if ($featTypeObj) { 
	    
	    eval { $featTypeObj->delete; };

	    if ($@) {

		print "Error occurred when deleting entry from feature_type table for feature_no = $featNo and feature_type = 'Uncharacterized/Dubious'.",br;

	    }
	    else {

		$dbh->commit;
	       
	    }

	}
	eval { 

	    Feature_type->Insert(dbh=>$dbh,
				 binds=>{feature_no=>$featNo,
					 feature_type=>'Verified'});

	};
	if ($@) {

	    print "The error occurred when inserting info into feature_type table for feature_no = $featNo and feature_type = 'Verified'.", br;

	}
	else {

	    $dbh->commit;

	    print "The feature_type for feature_name = $featNm has been updated to 'Verified'.",p;

	    
	}

    }

    my $geneReservationInfo = $locusObj->geneReservationInfo;
    my ($reservationNo, $Rdate, $Edate, $Sdate, $isStd) 
	         = split(/:/, $geneReservationInfo);
    if (!$reservationNo) { return;}
    if (param('makeStdNmCB') =~ /on/i) {
	eval { $locusObj->makeStdName; };
	if ($@) {
	    print "An error occurred when updating gene_reservation entry for locus ".$locusObj->locus_name." from database:$@", br;
	    $dbh->rollback;
	}
	else {
	    print "The gene_reservation entry for locus ".$locusObj->locus_name." has been updated in database.", br;
	    $dbh->commit;
	}
	return;
    }
    my $expirationDate = param('expirationDate');
    &DeleteUnwantedChar(\$expirationDate);
    if ($expirationDate) {
	if ($expirationDate !~ /^[0-9]{4}-[0-9]{2}-[0-9]{2}$/) {
	    print "The expiration_date can't be updated since the new expiration_date format is not correct. The required format is : YYYY-MM-DD",br;
	    return;
	}
	my $geneResObj = Gene_reservation->new(dbh=>$dbh,
					  reservation_no=>$reservationNo);
	$geneResObj->updateExpiration_date($expirationDate);
	eval { $geneResObj->enterUpdates; };
	if ($@) {
	    print "An error occurred when updating expiration_date for locus_no = ".$locusObj->locus_no." in gene_reservation table:$@", br;
	    $dbh->rollback;
	}
	else {
	    print "The expiration_date for locus_no = ".$locusObj->locus_no." in gene_reservation table has been updated.", br;
	    $dbh->commit;
	    if (param('expirationUpdLog')) {
		my $ulog = Update_log->new(dbh=>$dbh,
					   tab_name=>'GENE_RESERVATION',
					   col_name=>'EXPIRATION_DATE',
					   primary_key=>$reservationNo,
					   old_value=>$Edate,
					   new_value=>$expirationDate);
		$ulog->updateDescription(param('expirationUpdLog'));
		eval { $ulog->enterUpdates($self->user); };
		if (@$) {
		    print "An error occurred when updating description column in update_log table for expiration_date update log:$@", br;
		    $dbh->rollback;
		}
		else {
		    print "The description column in update_log table for expiration_date update log has been updated.". br;
		    $dbh->commit;
		}
	    }
	}
    }
}


########################################################################
sub updateCuratorNoteTable {
########################################################################
    my ($self, $locusObj, $dictyBaseid) = @_;
    my $note = param('note');
    if (!$note) { return; }
    my $idList = param('idList');
    my $isPublic = param('isPublic');
    if ($isPublic =~ /^Y/) { $isPublic = "Y"; }
    else { $isPublic = "N"; }
    &DeleteUnwantedChar(\$note);
    &DeleteUnwantedChar(\$idList);
    $idList =~ s/ +/ /g;
    $idList =~ s/, */\,/g;
    if ($dictyBaseid) {
	my $dictyBaseidObj = dictyBaseid->new(dbh=>$dbh,
				  dictyBaseid=>$dictyBaseid);
	if (!$dictyBaseidObj) { return; }
	my $dictyBaseidNo = $dictyBaseidObj->dictyBaseid_no;
	if ($idList !~ /dictyBaseid,${dictyBaseidNo}/i) {
	   $idList .= " dictyBaseid,$dictyBaseidNo";
        }
    }
    else {
	my $locusNo = $locusObj->locus_no;
	if ($idList !~ /Locus,${locusNo}/i) {
           $idList .= " Locus,$locusNo";
        }
    }
    $idList =~ s/^ //;
    my $noteObj = Curator_note->new(dbh=>$dbh,
				    note=>$note,
				    is_public=>$isPublic);
    if (!$noteObj) {
	eval {
	    Curator_note->Insert(dbh=>$dbh,
				 literals=>{curator_note_no=>'CGM_DDB.cnno_seq.nextval'},
				 binds=>{note=>$note,
					 is_public=>$isPublic});
	};
	if ($@) {
	    print "An error occurred when inserting new curator_note '$note' into database:$@", br;
	    $dbh->rollback;
	    return;
	}
	else {
	    print "The new curator_note '$note' has been inserted into database.", br;
	    $dbh->commit;
	    $noteObj = Curator_note->new(dbh=>$dbh,
					 note=>$note,
					 is_public=>$isPublic);
	}
    }
    eval {
        Curator_note->InsertCuratorNoteLinkInfo(dbh=>$dbh,
			  idList=>$idList,
			  curator_note_no=>$noteObj->curator_note_no);
    };
    if ($@) {
	print "An error occurred when inserting info into curator_note link table:$@", br;
	$dbh->rollback;
    }
    else {
	print "The curator note info has been inserted into linking table(s).", br;
	$dbh->commit;
    }
}

########################################################################
sub updateGeneProductTable {
########################################################################
    my ($self, $locusObj) = @_;
    for (my $i = 1; $i <= 5; $i++) {
	my $gpDB = param("gp$i");
	my $gp = param("NEWgp$i");
	&DeleteUnwantedChar(\$gp);
	if (!$gp && !$gpDB) { next; } 
	if ($gp =~ /^[0-9]+$/) {
	    my $gpNo = $gp;
	    my $gpObj = Gene_product->new(dbh=>$dbh,
					  gene_product_no=>$gpNo);
	    if (!$gpObj) {
		print "The gene_product_no you entered (".font({-color=>'red'}, $gpNo).") is not found in database.", br;
		next;
	    }
	    $gp = $gpObj->gene_product; 
	}
	if ($gp ne $gpDB) {
	    if (!$gpDB) {
		########### handle $gp ###############
		### new one
		### insert into gene_product table 
		###     if it does not exist
		### insert a new entry into locus_gp table 
		my $gpObj = Gene_product->new(dbh=>$dbh,
					      gene_product=>$gp);
		if (!$gpObj) {
		    $gpObj = $self->insertIntoGeneProductTable($gp);
		    if (!$gpObj) { next; }
		}
		$self->insertIntoLocusGP($locusObj->locus_no,
					 $gpObj->gene_product_no);
	    }
	    elsif (!$gp) {
		########### handle $gpDB ##############
		### delete from locus_gp table
	        ### at moment, do not delete it 
		###     from gene_product table. Other part in
		###         this program will handle this
		my $gpObj = Gene_product->new(dbh=>$dbh,
					      gene_product=>$gpDB);
		$self->deleteFromLocusGP($locusObj->locus_no, 
					 $gpObj->gene_product_no,
					 param("gpUpdLog$i"));
       	    }
	    else {
		### update this entry
		my $gpObjDB = Gene_product->new(dbh=>$dbh,
						gene_product=>$gpDB);
		my $gpObj = Gene_product->new(dbh=>$dbh,
						gene_product=>$gp);
		if (!$gpObj) {
		    $gpObj = $self->insertIntoGeneProductTable($gp);
		    if (!$gpObj) { next; }
		}
		if ($gpObjDB) {
		    $self->deleteFromLocusGP($locusObj->locus_no, 
					     $gpObjDB->gene_product_no,
					     param("gpUpdLog$i"));
		}
		$self->insertIntoLocusGP($locusObj->locus_no,
					 $gpObj->gene_product_no);   
	    }
	}
    }
}

########################################################################
sub insertIntoGeneProductTable {
########################################################################
    my ($self, $gp) = @_;
    eval {
	Gene_product->Insert(dbh=>$dbh,
			     literals=>{gene_product_no=>'CGM_DDB.gpno_seq.nextval'},
			     binds=>{gene_product=>$gp});
    };
    if ($@) {
	print "An error occurred when inserting new gene_product '$gp' into database:$@", br;
	$dbh->rollback;
	return;
    }
    else {
	print "The new gene_product '$gp' has been inserted into database.", br; 
	$dbh->commit;
	my $gpObj = Gene_product->new(dbh=>$dbh,
				      gene_product=>$gp);
	return $gpObj;
    }
}

########################################################################
sub insertIntoLocusGP {
########################################################################
    my ($self, $locusNo, $gpNo) = @_;
    eval {
	Locus_gp->Insert(dbh=>$dbh,
			 binds=>{locus_no=>$locusNo,
				 gene_product_no=>$gpNo});
    };
    if ($@) {
	print "An error occurred when inserting new locus_gp entry for locus_no = $locusNo and gene_product_no = $gpNo into database:$@", br;
	$dbh->rollback;
    }
    else {
	print "The new locus_gp entry for locus_no = $locusNo and gene_product_no = $gpNo has been inserted into database.", br;
	$dbh->commit;
    }
}

########################################################################
sub deleteFromLocusGP {
########################################################################
    my ($self, $locusNo, $gpNo, $log) = @_;
    my $locusGpObj = Locus_gp->new(dbh=>$dbh,
				   locus_no=>$locusNo,
				   gene_product_no=>$gpNo);
    my $deletedRow;
    if ($log) { $deletedRow = $locusGpObj->getRow; }
    eval { $locusGpObj->delete; };
    if ($@) {
	print "An error occurred when deleting locus_gp entry for locus_no = $locusNo and gene_product_no = $gpNo:$@", br;
	$dbh->rollback;
    }
    else {
	print "The locus_gp entry for locus_no = $locusNo and gene_product_no = $gpNo has been deleted from database.", br;
	$dbh->commit;
	if ($log) {
	    my $dlog = Delete_log->new(dbh=>$dbh,
				       tab_name=>'LOCUS_GP',
				       deleted_row=>$deletedRow);
	    $dlog->updateDescription($log);
	    eval { $dlog->enterUpdates($self->user); };
	    if ($@) {
		print "An error occurred when updating delete_log for gene_product update log:$@", br;
		$dbh->rollback;
	    }
	    else {
		print "The gene_product update log has been inserted into delete_log table.",br;
		$dbh->commit;
	    }
	}
    }
}

########################################################################
sub updateAliasTable {
########################################################################
    my ($self, $locusObj) = @_;
    
    my ($aliasList, $uniform_aliasList, $non_uniform_aliasList, 
	$protein_name_aliasList);
    $uniform_aliasList = param('uniform_alias');
    $non_uniform_aliasList = param('non_uniform_alias');
    $protein_name_aliasList = param('protein_name_alias');

    $uniform_aliasList =~ s/ //g; 
    ####don't want to remove spaces, if any, 
    ####in non_uniform and protein name aliases
    
    if ($uniform_aliasList) {
	$aliasList .= $uniform_aliasList . '|';
    }

    if ($non_uniform_aliasList) {
	$aliasList .= $non_uniform_aliasList . '|';
    }

    if ($protein_name_aliasList) {
	$aliasList .= $protein_name_aliasList;
    }

    my @aliasNm = split(/\|/, $aliasList);
    my @uniform_aliasNm = split(/\|/, $uniform_aliasList);
    my @non_uniform_aliasNm = split(/\|/, $non_uniform_aliasList);
    my @protein_name_aliasNm = split(/\|/, $protein_name_aliasList);

    my $aliasListDB = $locusObj->aliasNameList;
    my @aliasNmDB = split(/\|/, $aliasListDB);

    my %alias_type;
    foreach my $aliasNm (@uniform_aliasNm) {
	if ($aliasNm =~ /^\w{3}\d+$/i){
	    $alias_type{"$aliasNm"} = 'Uniform';
	}
	else {
	    $alias_type{"$aliasNm"} = 'Non-uniform';
	}
    }
    
    foreach my $aliasNm (@non_uniform_aliasNm) {
	if (! exists $alias_type{"$aliasNm"}) {
	    $alias_type{"$aliasNm"} = 'Non-uniform';
	}
    }

    foreach my $aliasNm (@protein_name_aliasNm) {
	if (! exists $alias_type{"$aliasNm"}) {
	    $alias_type{"$aliasNm"} = 'Protein name';
	}
    }

    my $aliasArrayRef = $locusObj->locusAliasArrayRef;
    #make a hash of alias_name with alias_no as the value
    my %alias_name_alias_no;
	foreach my $rowRef(@$aliasArrayRef) {
		my ($alias_no, $alias_name) = @$rowRef;
		$alias_name_alias_no{$alias_name} = $alias_no;
	    }

    my (%foundAlias, %foundAliasDB);
    foreach my $aliasNm (@aliasNm) {
	$foundAlias{"\U$aliasNm"}++;
    }
    foreach my $aliasNm (@aliasNmDB) {
	$foundAliasDB{"\U$aliasNm"}++;
	if ($foundAlias{"\U$aliasNm"}) {
	    my $aliasNo  = $alias_name_alias_no{$aliasNm};
	    my $aliasObj = Alias->new(dbh=>$dbh,
				      alias_no=>$aliasNo);
	    my $aliasTypeDB = $aliasObj->getAliasType;
	    my $aliasTypeNew = $alias_type{$aliasNm};
	
	    if ($aliasTypeDB eq $aliasTypeNew) {
		next;
	    }
	    else {
		$self->deleteFromLocusAliasTable($locusObj->locus_no, 
						 $aliasObj->alias_no);
	    }
	}
	else {
	#### it is not found in the new alias list
	#### delete it from locus_alias table
	my $aliasNo = $alias_name_alias_no{$aliasNm};
	my $aliasObj = Alias->new(dbh=>$dbh,
				  alias_no=>$aliasNo);
        $self->deleteFromLocusAliasTable($locusObj->locus_no, 
					 $aliasObj->alias_no);
        }
    }
    
    foreach my $aliasNm (@aliasNm) {
	if ($foundAliasDB{"\U$aliasNm"}) { 
	    my $aliasTypeNew = $alias_type{$aliasNm};
       	    my $aliasNo  = $alias_name_alias_no{$aliasNm};
	    my $aliasObj = Alias->new(dbh=>$dbh,
				      alias_no=>$aliasNo);
	    my $aliasTypeDB = $aliasObj->getAliasType;
	    if ($aliasTypeNew eq $aliasTypeDB) {
		next;
	    }
	    else {
		my $type = $alias_type{"$aliasNm"};

		if ($aliasNm =~ /^\w{3}\d+$/i){
		     $aliasNm = uc($aliasNm);
		    }		
		my $aliasObj = Alias->new(dbh=>$dbh,
                                  alias_name=>$aliasNm,
				  alias_type=>$type);
		if (!$aliasObj) {
		    $aliasObj = $self->insertIntoAliasTable($aliasNm, $type);
		    if (!$aliasObj) { next;}
		}
		$self->insertIntoLocusAliasTable($locusObj->locus_no, 
						 $aliasObj->alias_no);
	    }
	}        
	else {
		#### it is not found in the alias list for this locus 
		#### from database
		#### add this alias into alias table if it not exist yet
		#### add it to locus_alias table
		my $type;
		if ($aliasNm =~ /^\w{3}\d+$/i){
		    $type = $alias_type{"$aliasNm"};
		}
		else {
		    $type = $alias_type{"$aliasNm"};
		}
		if ($aliasNm =~ /^\w{3}\d+$/i){
		     $aliasNm = uc($aliasNm);
		 }
 		my $aliasObj = Alias->new(dbh=>$dbh,
					  alias_name=>$aliasNm,
					  alias_type=>$type);
		if (!$aliasObj) {
		    $aliasObj = $self->insertIntoAliasTable($aliasNm, $type);
		    if (!$aliasObj) { next;}
		}
		$self->insertIntoLocusAliasTable($locusObj->locus_no, 
						 $aliasObj->alias_no);
	    }
    }
}
########################################################################
sub insertIntoAliasTable {
########################################################################
    my ($self, $aliasNm, $alias_type) = @_;

    eval {
	Alias->Insert(dbh=>$dbh,
		      literals=>{alias_no=>'CGM_DDB.aliasno_seq.nextval'},
		      binds=>{alias_name=>$aliasNm,
			      alias_type=>$alias_type});
    };
    if ($@) {
	print "An error occurred when inserting new alias '$aliasNm' into database:$@", br;
	$dbh->rollback;
	return;
    }
    else {
	print "The new alias '$aliasNm' has been inserted into alias table.", br;
	$dbh->commit;
	my $aliasObj = Alias->new(dbh=>$dbh,
				  alias_name=>$aliasNm,
				  alias_type=>$alias_type);
	return $aliasObj;
    }
}

########################################################################
sub insertIntoLocusAliasTable {
########################################################################
    my ($self, $locusNo, $aliasNo) = @_;
    eval { 
	Locus_alias->Insert(dbh=>$dbh,
			    binds=>{locus_no=>$locusNo,
				    alias_no=>$aliasNo});
    };
    if ($@) {
	print "An error occurred when inserting new locus_alias entry for locus_no = $locusNo and alias_no = $aliasNo into database:$@", br;
	$dbh->rollback;
    }
    else {
	print "The new locus_alias entry for locus_no = $locusNo and alias_no = $aliasNo has been inserted into database.", br;
	$dbh->commit;
    }
}

########################################################################
sub deleteFromLocusAliasTable {
########################################################################
    my ($self, $locusNo, $aliasNo) = @_;
    my $locusAliasObj = Locus_alias->new(dbh=>$dbh,
					 locus_no=>$locusNo,
					 alias_no=>$aliasNo);
    my $deletedRow;
    if (param('aliasUpdLog')) { $deletedRow = $locusAliasObj->getRow;}
    eval { $locusAliasObj->delete; };
    if ($@) {
	print "An error occurred when deleting locus_alias entry for locus_no = $locusNo and alias_no = $aliasNo:$@", br;
	$dbh->rollback;
    }
    else {
	print "The locus_alias entry for locus_no = $locusNo and alias_no = $aliasNo has been deleted from database.", br;
	$dbh->commit;
	if (param('aliasUpdLog')) {
	    my $dlog = Delete_log->new(dbh=>$dbh,
				       tab_name=>'Locus_ALIAS',
				       deleted_row=>$deletedRow);
           
	    $dlog->updateDescription(param('aliasUpdLog'));
	    eval { $dlog->enterUpdates($self->user); };
	    if ($@) {
		print "An error occurred when updating delete_log table for alias update log:$@", br;
                $dbh->rollback;
	    }
	    else {
                print "The alias update log has been inserted into delete_log table.", br;
		$dbh->commit;
	    }
	}
    }
}

########################################################################
sub updateFeatureTable {
########################################################################
    my ($self, $locusObj) = @_;
    
    my $features = param('feature');
    my $featuresDB =  $locusObj->featureNameList;
    $features =~ s/ //g;
    if ("\U$features" eq "\U$featuresDB") { return; }
    my @featNm = split(/\|/, $features);
    my @featNmDB = split(/\|/, $featuresDB);
    my (%foundFeatDB, %foundFeat);
    foreach my $featNm (@featNm) {
	$foundFeat{"\U$featNm"}++;
    }
    foreach my $featNm (@featNmDB) {
	$foundFeatDB{"\U$featNm"}++;
	if ($foundFeat{"\U$featNm"}) { next;}
	#### it is not found in the new feature list.
	#### unlink this feature ...
	#### set its locus_no = NULL
	$self->updateLocusNo4Feature($featNm, '');
    }
    foreach my $featNm (@featNm) {
	if ($foundFeatDB{"\U$featNm"}) { next;}
	#### it is not found in the feature list for 
        #### this locus in the database.
	#### link this feature ...
        #### set its locus_no to $locusObj->locus_no
	$self->updateLocusNo4Feature($featNm, $locusObj->locus_no);
    }
}

########################################################################
sub updateLocusNo4Feature {
########################################################################
    my ($self, $featNm, $locusNo) = @_;
    my $featObj = Feature->new(dbh=>$dbh,
			       feature_name=>$featNm);
    if (!$featObj) {
	print "The feature name '$featNm' is not found in database.",br;
	return;
    }
    my $oldLocusNo = $featObj->locus_no;
    $featObj->updateLocus_no($locusNo);
    eval { $featObj->enterUpdates; };
    if ($@) {
	print "An error occurred when updating locus_no for feature entry '$featNm':$@", br;
	$dbh->rollback;
    }
    else {
	print "The locus_no for feature entry '$featNm' has been updated.", br;
	$dbh->commit;
	if (param('featUpdLog') && $oldLocusNo && $locusNo) {
	    my $ulog = Update_log->new(dbh=>$dbh,
				       tab_name=>'FEATURE',
				       col_name=>'LOCUS_NO',
				       primary_key=>$featObj->feature_no,
				       old_value=>$oldLocusNo,
				       new_value=>$locusNo);
	    $ulog->updateDescription(param('featUpdLog'));
	    eval { $ulog->enterUpdates($self->user); };
	    if ($@) {
		print "An error occurred when updating update_log table for feature update log:$@", br;
                $dbh->rollback;
	    }
	    else {
                print "The feature update log has been inserted into update_log table.", br;
		$dbh->commit;
	    }
	}
    }
}

########################################################################
sub insertLocusEntry {
########################################################################
    my ($self) = @_;

    my $locus = param('locusNm');
    my $chr = param('chr');
    my $cm = param('cm');
    my $desc = param('desc');
    my $name_desc = param('name_desc');

    &DeleteUnwantedChar(\$locus);
    &DeleteUnwantedChar(\$cm);
    &DeleteUnwantedChar(\$desc);
    &DeleteUnwantedChar(\$name_desc);

    $chr =~ s/[^0-9]//g;
    
    eval {
	Locus->Insert(dbh=>$dbh,
		      literals=>{locus_no=>'CGM_DDB.locusno_seq.nextval'},
		      binds=>{locus_name=>$locus,
			      chromosome=>$chr,
			      genetic_position=>$cm,
			      description=>$desc,
			      name_description=>$name_desc});
    };
    if ($@) {
	print "An error occurred when inserting new locus try for locus_name = '$locus' :$@", br;
	$dbh->rollback;
	return;
    }
    else {
	print "The new locus entry for locus_name = '$locus' has been inserted into locus table.", br;
	$dbh->commit;
	my $locusObj = Locus->new(dbh=>$dbh,
				  locus_name=>$locus);
	return $locusObj;
    }
}


########################################################################
sub updateLocusTable {
########################################################################
    my ($self) = @_;
    my $locusObj = Locus->new(dbh=>$dbh,
			      locus_no=>param('locusNo'));
    my $DBlocus = $locusObj->locus_name;
    my $DBchr = $locusObj->chromosome;
    my $DBname_desc = $locusObj->name_description;
    my $DBdesc = $locusObj->description;
    my $DBcm = $locusObj->genetic_position;

    my $locus = param('locusNm');
    my $chr = param('chr');
    my $cm = param('cm');
    my $name_desc = param('name_desc');
    my $desc = param('desc');

    &DeleteUnwantedChar(\$locus);
    &DeleteUnwantedChar(\$cm);
    &DeleteUnwantedChar(\$name_desc);
    &DeleteUnwantedChar(\$desc);
    $chr =~ s/[^0-9]//g;

    my (@oldVal, @newVal, @colNm, @log);
    if ("\U$locus" ne "\U$DBlocus") {
	$locusObj->updateLocus_name($locus);
	push(@oldVal, $DBlocus);
	push(@newVal, $locus);
	push(@colNm, "LOCUS_NAME");
	push(@log, param('locusUpdLog'));
    }
    if ($chr != $DBchr) {
	$locusObj->updateChromosome($chr);
	push(@oldVal, $DBchr);
	push(@newVal, $chr);
	push(@colNm, "CHROMOSOME");
	push(@log, param('posUpdLog'));
    }
    if ($cm != $DBcm) {
	$locusObj->updateGenetic_position($cm);
	push(@oldVal, $DBcm);
	push(@newVal, $cm);
	push(@colNm, "GENETIC_POSITION");
	push(@log, param('posUpdLog'));
    }
    if ($name_desc ne $DBname_desc) {
	$locusObj->updateName_description($name_desc);
	push(@oldVal, $DBname_desc);
	if ($name_desc eq '') {
	    $name_desc = 'NA';
	}
	push(@newVal, $name_desc);
	push(@colNm, "NAME_DESCRIPTION");
	push(@log, param('name_descUpdLog'));
    }
    if ($desc ne $DBdesc) {
	$locusObj->updateDescription($desc);
	push(@oldVal, $DBdesc);
	if ($desc eq '') {
	    $desc = 'NA';
	}
	push(@newVal, $desc);
	push(@colNm, "DESCRIPTION");
	push(@log, param('descUpdLog'));
    }
    if (!@colNm) { return $locusObj; } 
    
    eval { $locusObj->enterUpdates; };
    if ($@) {
	print "An error occurred when updating locus table for locus_no = ".param('locusNo').":$@", br;
        $dbh->rollback;
    }
    else {
	print "The locus entry for locus_no = ".param('locusNo')." has been updated.", br;
	$dbh->commit;
	for (my $i = 0; $i <= $#colNm; $i++) {
	    if (!$log[$i]) { next; }
 	    my $ulog = Update_log->new(dbh=>$dbh,
				       tab_name=>'LOCUS',
				       col_name=>$colNm[$i],
				       primary_key=>param('locusNo'),
				       old_value=>$oldVal[$i],
				       new_value=>$newVal[$i]); 
            $ulog->updateDescription($log[$i]);
	    eval { $ulog->enterUpdates($self->user); };
	    if ($@) {
		print "An error occurred when updating update_log table:$@", br;
		$dbh->rollback;
	    }
	    else {
		print "The update_log comment for updating $colNm[$i] has been inserted into update_log table.", br;
		$dbh->commit;
	    }
	}
    }
    return $locusObj;
}

########################################################################
sub deleteLocus {
########################################################################
    my ($self) = @_;

    my $locusObj = Locus->new(dbh=>$dbh,
			      locus_no=>param('locusNo'));

    my $deletedRow;
    if (param('locusDelLog')) { $deletedRow = $locusObj->getRow; }

    eval { $locusObj->delete; };
    if ($@) {
	print "An error occurred when deleting locus for locus_no = ".param('locusNo')." from database:$@", br;
	$dbh->rollback;
    }
    else {
	print "The locus ".param('locusNo')." has been deleted from the database.", br;
	$dbh->commit;
	if (param('locusDelLog')) {
	    my $dlog = Delete_log->new(dbh=>$dbh,
				       tab_name=>'LOCUS',
				       deleted_row=>$deletedRow);
	    $dlog->updateDescription(param('locusDelLog'));
	    eval { $dlog->enterUpdates($self->user); };
	    if ($@) {
		print "An error occurred when updating the delete_log table:$@", br;
		$dbh->rollback;
	    }
	    else {
		print "The delete log has been inserted into delete_log table.", br;
		$dbh->commit;
	    }
	}
    }
    $dbh->disconnect;
    &printEndPage;
}

########################################################################
sub deleteAlias {
########################################################################
    my ($self, $alias, $log) = @_;
    my $aliasObj = Alias->new(dbh=>$dbh,
			      alias_no=>$alias);
       
    my $deletedRow;
    if ($log) { $deletedRow = $aliasObj->getRow; }
    
    eval { $aliasObj->delete; };
    if ($@) {
	print "An error occurred when deleting alias $alias from database:$@", br;
	$dbh->rollback;
    }
    else {
	print "The alias $alias has been deleted from database.", br;
	$dbh->commit;
	if ($log) {
	    my $dlog = Delete_log->new(dbh=>$dbh,
				       tab_name=>'ALIAS',
				       deleted_row=>$deletedRow);
	    $dlog->updateDescription($log);
	    eval { $dlog->enterUpdates($self->user); };
	    if ($@) {
		print "An error occurred when updating the delete_log table:$@", br;
		$dbh->rollback;
	    }
	    else {
		print "The delete log has been inserted into delete_log table.", br;
		$dbh->commit;
	    }
	}
    }
}

########################################################################
sub deleteGeneProduct {
########################################################################
    my ($self, $gp, $log) = @_;

    my $gpObj = Gene_product->new(dbh=>$dbh,
				  gene_product=>$gp);

    my $deletedRow;
    if ($log) { $deletedRow = $gpObj->getRow; }
    
    eval { $gpObj->delete; };
    if ($@) {
	print "An error occurred when deleting gene_product '$gp' from database:$@", br;
	$dbh->rollback;
    }
    else {
	print "The gene_product '$gp' has been deleted from database.", br;
	$dbh->commit;
	if ($log) {
	    my $dlog = Delete_log->new(dbh=>$dbh,
				       tab_name=>'GENE_PRODUCT',
				       deleted_row=>$deletedRow);
	    $dlog->updateDescription($log);
	    eval { $dlog->enterUpdates($self->user); };
	    if ($@) {
		print "An error occurred when updating the delete_log table:$@", br;
		$dbh->rollback;
	    }
	    else {
		print "The delete log has been inserted into delete_log table.", br;
		$dbh->commit;
	    }
	}
    }
}


########################################################################
sub checkFeatures {
########################################################################
    my ($self, $featNoRef, $featNmRef) = @_;
    if (param('feature')) {
	my $feature = param('feature');
	@$featNmRef = split(/\|/, $feature);
	foreach my $featNm (@$featNmRef) {
	    &DeleteUnwantedChar(\$featNm);
	    my $featObj = Feature->new(dbh=>$dbh,
				       feature_name=>$featNm);
	    if(!$featObj) {
		print "The feature ".font({-color=>'red'}, $feature)." you entered is not found in the database. Please correct it and try again.", br;
		$dbh->disconnect;
		&printEndPage;
		exit;
	    }
	    push(@$featNoRef, $featObj->feature_no);
	}
    }
}

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

########################################################################
sub err_report {
########################################################################
    my ($self, $err) = @_;
 
    &printStartPage($self->database, $self->title, $self->help);
    
    print b($err);
    
    &printEndPage;

    if ($dbh) { $dbh->disconnect; }
    exit;
}

########################################################################
1;
########################################################################