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

##########################################################
#                                                        #
# dictyBase Extension of ReferenceUserPage               #
#                                                        #
##########################################################

use ReferenceUserPage_base;

BEGIN { %ReferenceUserPage:: = %ReferenceUserPage_base:: }


#
# took out features from genelists
#
########################################################################
sub getCuratedGeneList {
########################################################################
    my ($self, $refObj) = @_;
    my @loci = $refObj->getCuratedLoci;
#    my @feats = $refObj->getCuratedFeatures;
#    push (@loci, @feats);
    return @loci;
}


#
# took out features from genelists
#
########################################################################
sub getNotYetCuratedGeneList {
########################################################################
    my ($self, $refObj) = @_;
    my @loci = $refObj->getNotYetLoci;
#    my @feats = $refObj->getNotYetFeatures;
#    push (@loci, @feats);
    return @loci;
}

#
#  I forget why we have punctuation in the database (MUST be a good reason ;) )
#  but when linking to ncbi need to remove it
#
#  one simple change: 		$author =~ s/,|(\.\s?)//g;
#
#
######################################################################
sub start{
######################################################################

    	my ($self) = @_;
	$configUrl = ConfigURLdictyBase->new;
	$dblink = $configUrl->dblink($self->database);
	if (param('submit')) {
	    if (param('parameter') =~ /Papers in dictyBase/i) {
		$dbh = &ConnectToDatabase($self->database);
		$self->{'_title'} = "dictyBase Papers";
		$self->paperSearch;
		exit;
	    }
	    elsif (param('parameter') =~ /Colleagues in dictyBase/i) {
		my $author = param('author');
		$author =~ s/^([^ ,]+), .*$/$1/;
		print "location: ", $configUrl->dictyBaseCGIRoot, "$dblink/colleague/colleagueSearch?lname=$author\n";
		print "Content-type: text/html\n\n";
		exit;
	    }
	    else {
		my $author = param('author');

     #
     #  dictyBase added next line to take out punctuation (which is in database)
     #
		$author =~ s/,|(\.\s?)//g;
		$author =~ s/ /\+/g;
		print "location: ", $configUrl->ncbiUrlRoot2, "query.fcgi?dispmax=20&db=PubMed&pmfilter_EDatLimit=No+Limit&cmd_current=Limits&orig_db=PubMed&cmd=Search&term=$author&doptcmdl=DocSum\n";
		print "Content-type: text/html\n\n";
		exit;
	    }
	}
	if (param('author')) {
	     $dbh = &ConnectToDatabase($self->database);
	     $self->{'_title'} = "dictyBase Curated Papers";
	     $self->paperSearch;
	     exit;
	}
	$dbh = &ConnectToDatabase($self->database);
	if ($self->{'_ACEname'}) {
	    my $refNo = $self->getRefNo4AceNm;
	    if (!$refNo) {
		my $aceNm = $self->{'_ACEname'};
		print "location: ", $configUrl->breadServerRoot, "cgi-bin/dbrun/SacchDB?find+AcePaper+$aceNm\n";
		print "Content-type: text/html\n\n";
		exit;	
	    }
	    $self->{'_refNo'} = $refNo;
	}
	if (!$self->refNo && !$self->pubmed) {
	    $self->{'_title'} = "Reference Search";
	    $self->printEntryForm;
	    exit;
	}   
	$self->{'_title'} = "dictyBase Curated Paper";
	my $refObject;
	if ($self->refNo) {
	    $refObject = Reference->new(dbh=>$dbh,
					reference_no=>$self->refNo);
	    if (!$refObject) {
		$self->err_report("The reference_no you entered (". $self->refNo.") is not found in database. Please correct it and try again.");
		exit;
	    }
	}
	else {
	    $refObject = Reference->new(dbh=>$dbh,
					pubmed=>$self->pubmed);
	    if (!$refObject) {
		$self->err_report("The pubmed id you entered (". $self->pubmed.") is not found in database. Please correct it and try again.".
           br."If you arrived here by clicking on a link in dictyBase, we apologize for the inconvenience.");
		exit;
	    }
	}
	if (!param('type')) {
	    $self->displayPaper($refObject);
	}
	else {
	    $self->displayCommentErratum($refObject);
	}
}





#
#
#  call new function "authorArrayRef" from Reference.pm (dictyBase extension)
#    this function returns and array of author names as opposed to a string
#    in the old implementation
#
#
########################################################################
sub authorSearch {
########################################################################
    my ($self, $refObject) = @_;
    my $authorArrayRef = $refObject->authorNameArrayRef;
    my $authorPopup = popup_menu(-name=>'author',
				 -"values"=>$authorArrayRef);
    my @parameter = ("Papers in dictyBase", "Colleagues in dictyBase", "PubMed");
    my $paraPopup = popup_menu(-name=>'parameter',
				 -"values"=>\@parameter);
    print "<a name=author>&nbsp;</a>";
    print start_form, table({-align=>'center',
			     -width=>'600',
			     -border=>'0',
			     -cellpadding=>'3',
			     -cellspacing=>'3'},
			    Tr(th({-align=>'left',
				   -bgcolor=>'#869FB6'},
				  "&nbsp;Author Searches")).
			    Tr(td({-bgcolor=>'#d8d8d8'},
				  table({-border=>'0',
					 -cellpadding=>'0',
					 -cellspacing=>'0'},
					Tr(td({-colspan=>'3'}, "To find contact information or other publications by the authors of this paper, follow these three steps:".br.br)).
					Tr(td("(1) Choose an author,").
					   td("(2) Choose a search parameter,&nbsp;&nbsp;&nbsp;&nbsp;").
					   td("(3) Click to implement.")).

					Tr(td($authorPopup).
					   td($paraPopup).
					   td(submit(-name=>'submit',
						     -value=>'Search!')))
					)))

			    ), end_form;
}


########################################################################
sub getNotYetCuratedGeneList {
########################################################################
    my ($self, $refObj) = @_;
    my @loci = $refObj->getNotYetLoci;

  #  Right now, for dictyBase, don't want to show the feature names, just the locus names
  #  
  #  my @feats = $refObj->getNotYetFeatures;
  #  push (@loci, @feats);
    return @loci;
}


#
#
# took out uppercasing : 
#  changed $$foundTopicGeneRef{"$topic:\U$gene"}
#       to $$foundTopicGeneRef{"$topic:$gene"}
#

########################################################################
sub geneTable {
########################################################################
    my ($self, $lociRef, $foundTopicGeneRef, $label) = @_;
    my $subtitle = "Genes addressed in this paper ";
    if ($label) {
	print "<a name=$label>&nbsp;</a>";
	$label =~ s/^([^\(]+)\(.+$/$1/;
	if ($label =~ /^#([0-9]+)-([0-9]+)$/) {
	    if ($1 == $2) { $label = "#$1"; }
	}
	$subtitle .= "($label)";
    }
    my $geneNum = @$lociRef;
    my $tableHeader;
    my %foundLocus;
    foreach my $locus (@$lociRef) {
	$tableHeader .= th({-rowspan=>'2',
			    -align=>'center',
			    -valign=>'center',
			    -bgcolor=>'#b7d8e4'},
			   a({-href=>$configUrl->dictyBaseCGIRoot."gene_page.pl?gene_name=$locus",
			      -target=>'infowin'}, $locus));
	uc($locus);
	$foundLocus{$locus}++;
    }
    my $geneTable;
    my %foundTopic;
    foreach my $key (sort (keys %$foundTopicGeneRef)) {
	my ($topic, $locus) = split(/:/, $key);
	my $linkTopic = $topic;
	$linkTopic =~ s/ /\+/g;
	if ($foundLocus{$locus} && !$foundTopic{$topic}) {
	    $foundTopic{$topic}++;
	    my $tableCell = td({-width=>"20%"},
			       $topic);
	    foreach my $gene (@$lociRef) {
		if ($$foundTopicGeneRef{"$topic:$gene"}) {
		    $tableCell .= td({-width=>"10%",
				      -align=>'center'},
				     a({-href=>$configUrl->dictyBaseCGIRoot."$dblink/reference/geneinfo.pl?locus=$gene&topic=$linkTopic",
				        -target=>'infowin'},
				       "X"));
		}
		else {
		    $tableCell .= td({-width=>"10%"}, br);
		}
	    }
	    $geneTable .= Tr($tableCell);
	}
    }
    print p,
          table({-align=>'center',
	         -border=>'1',
		 -cellpadding=>'4',
		 -cellspacing=>'2',
		 -width=>"100%"},
		 Tr(td({-rowspan=>'2'}).
		    th({-align=>'center',
			-colspan=>"$geneNum",
			-align=>'center',
			-bgcolor=>'#869FB6'},
		       $subtitle)).
		 Tr($tableHeader).
		 Tr(th({-align=>'center',
			-bgcolor=>'#869FB6'},
		       "Topics in this paper")).
		 $geneTable
	  );

}


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