#!@@_perl_root_@@/bin/perl.exe 
package LocusCurationPage;

##########################################################
#                                                        #
# dictyBase Extension of LocusCurationPage               #
#                                                        #
##########################################################

use LocusCurationPage_base;

BEGIN { %LocusCurationPage:: = %LocusCurationPage_base:: }
use DictyBaseConfig;
use Data::Dumper;
use dicty::Gene;
#
# use function 'Makedictybasid' on database to make dictybaseid
#
#######################################################################
sub assigndictyBaseid4newLocus {
########################################################################
    my ($self, $locusObj) = @_;
    if (param('assigndictyBaseidCB') !~ /on/i) {  return; }
    my $sth = $dbh->prepare("
         SELECT CGM_DDB.Makedictybaseid(CGM_DDB.dictyBaseidno_seq.nextval)
         FROM   dual
    ");
    $sth->execute;
    my $dictyBaseid = $sth->fetchrow;
    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 = $locusNo into database:$@", p;
	$dbh->rollback;
    }
    else {
	print "The new dictyBaseid entry for locus_no = $locusNo has been inserted into database.", p;
	$dbh->commit;
    }
}

#
# took out uppercaseing
#
########################################################################
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 =~ /^[a-z]{3}[A-Z]$/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);
	    }
    }
}

#
# take out updateFeatureTable
#
# changed limit on gene product and alias
# 
########################################################################
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 <= 10; $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;
}

#
#
#  remove limit of 5 on gene product (allow 10 -- see second line of subroutine!)
#
########################################################################
sub updateGeneProductTable {
########################################################################
    my ($self, $locusObj) = @_;
    for (my $i = 1; $i <= 10; $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);   
	    }
	}
    }
}

#
# take out UpdateFeatureBox, write feature table based on gene object
# 
########################################################################
sub displayInfo {
########################################################################
    my ($self) = @_;
    my $locusObj = $self->createLocusObject;


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

    my $gene;

    eval { $gene = new dicty::Gene( -locus_no => $self->{'_locusNo'} ); } if $self->{'_locusNo'};
    


    my($chrnum, $feat_ddb_list, $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;






        #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 ( $gene ) {

       if ( @{$gene->features} ) {
          &printSubTitle("Feature Curation");

           print qq{ <table border="0" cellpadding="3" cellsapcing="3">
                          <th>Feature</th><th>Source</th><th>Deleted?</th></tr> }; 

           my $feat_link = $configUrl->dictyBaseCGIRoot."$dblink/curation/featureCuration?user=".$self->user."&dictybaseid=";

      	   foreach my $feature (@{ $gene->features }, @{ $gene->deleted_features } ) {
              my $feat_ddb     = $feature->dictybaseid();
              my $source       = $feature->source();
              my $is_deleted   = $feature->is_deleted() ? 'Y' : "N";

              print qq{ <tr><td bgcolor="#b7d8e4">
                               Edit <a href="${feat_link}${feat_ddb}" target="infowin">$feat_ddb</a>
                            </td> };
              print qq{     <td bgcolor="#dddddd">$source</td>                                                              };
              print qq{     <td bgcolor="#dddddd">$is_deleted</td></tr>                                                     };
           }
           print "</table>".br;
        }
        &printSubTitle("Paragraph Curation");
        if ( $gene->paragraph() ) {
           my $para_link = $configUrl->dictyBaseCGIRoot."$dblink/curation/load_paragraph.pl?user=".$self->user."&paragraph_no=".$gene->paragraph->paragraph_no;
           print qq{ <a href="$para_link" target="infowin">Edit Paragraph</a> };
        }
        else {
           my $para_link = $configUrl->dictyBaseCGIRoot."$dblink/curation/load_paragraph.pl?user=".$self->user."&new_for_gene=".$gene->locus_no;
           print qq{ <a href="$para_link" target="infowin">Add Paragraph</a> };
        }
        print br.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;
}




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