#!/usr/bin/perl
package SeqTools;

#######################################################################
##### Author :	Shuai Weng
##### Date   :  Nov. 2001
##### Description : This package contains all necessary methods for 
#####               displaying Gene/Sequence Resources page. 
#####              
#######################################################################
use strict;
use DBI;
use CGI qw/:all/;

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);

use lib "/usr/local/dicty/www_dictybase/db/lib/dictyBase/Objects";

use SeqParamTranslator;

use ConfigURLdictyBase;
use ConfigPathdictyBase;
use Chromosome;
use GCG;
use Display_seq;


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

my $dbh;
my $dblink; 
my $configUrl;
my $configPath;
my $locusObj;
my $featObj;
my $queryline;

my %num2rom = ('1'=>'I', '2'=>'II', '3'=>'III', '4'=>'IV', '5'=>'V', 
	       '6'=>'VI', '7'=>'VII', '8'=>'VIII', '9'=>'IX', 
	       '10'=>'X', '11'=>'XI', '12'=>'XII', '13'=>'XIII', 
	       '14'=>'XIV', '15'=>'XV', '16'=>'XVI', '17'=>'Mito');

my %rom2num = ('I'=>'1', 'II'=>'2', 'III'=>'3', 
	       'IV'=>'4', 'V'=>'5', 'VI'=>'6', 'VII'=>'7', 
	       'VIII'=>'8', 'IX'=>'9', 'X'=>'10', 'XI'=>'11', 
	       'XII'=>'12', 'XIII'=>'13', 'XIV'=>'14', 'XV'=>'15', 
	       'XVI'=>'16', 'Mito'=>'17');

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

	$self = {};

	bless $self;

      	$self->{'_database'} = $args{'database'};
	$self->{'_help'} = $args{'help'};
	$self->{'_title'} = $args{'title'};
	$self->{'_query'} = $args{'query'};
	$self->{'_chr'} = $args{'chr'};
	$self->{'_beg'} = $args{'beg'};
	$self->{'_end'} = $args{'end'};
	$self->{'_sequence'} = $args{'sequence'};

    	return $self;
}

sub help { $_[0]->{_help} }
sub database { $_[0]->{_database} }
sub title { $_[0]->{_title} }


######################################################################
sub DESTROY {   ############ destructor ##############################
######################################################################
    	if (defined $dbh) {
		$dbh->disconnect;
    	}
}

######################################################################
sub start{
######################################################################

    	my ($self) = @_;

	$self->{'_chr'} =~ s/^Number//;

	if (param('back') ||
	    (!$self->{'_query'} && !$self->{'_chr'} && 
	     !$self->{'_sequence'} && !param('id'))) {
	    $self->printEntryForm;
	    exit;
	}

        if (($self->{'_query'} && $self->{'_chr'}) ||
            ($self->{'_query'} && $self->{'_sequence'}) ||
            ($self->{'_chr'} && $self->{'_sequence'})){
           print $self->err_report("Error:  Please go back and choose only one option (gene name, chromosome coordinates, or sequence). ");

        }

	$dbh = &ConnectToDatabase($self->database);
	$self->setVariables;
	$self->choosePageToPrint;
	exit;
}

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

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

	$self->initBackVariables;

	my @chr;
	push(@chr, 'Number');
	for (my $i = 1; $i <= 17; $i++) {
	    push(@chr, $i);
	}

	print start_form, 
	      blockquote(table(Tr(td(submit(-name=>'submit',
				 -value=>'Submit Form')))));
	
	print blockquote("This resource allows one to retrieve a list of options for accessing information available for 1) a named gene or sequence, 2) a specified chromosomal region, or 3) a raw DNA or protein sequence. This information includes biological information, table/map displays, and sequence analysis and retrieval options."), p;

	print table({-width=>'100%',
		     -border=>'0',
		     -cellpadding=>'10'},
		    Tr(td({-bgcolor=>'#b7d8e4',
			   -width=>'30%',
			   -valign=>'top'}, 
			  b(big("1. Enter a Name")).br.
			  "or the first few characters followed by *:".br.
			  textfield(-name=>'seqname',
				    -value=>$self->{'_seqname'},
				    -size=>'12').br.
			  b("Examples").":".br.
			  "Gene - act1".br.
			  "ORF - YHR023W".br.
			  "GenBank Locus - YSCHELI".br.
			  "GenBank AccNo. - L00683".br.
			  "GenBank GI - gi:171655".br.
			  "Clone - 70353".p.
			  b("If available").", add flanking basepairs".br.
			  "upstream ".
			  textfield(-name=>'flankl',
				    -value=>$self->{'_flankl'},
				    -size=>'6').
			  " and downstream ".
			  textfield(-name=>'flankr',
				    -value=>$self->{'_flankr'},
				    -size=>'6').p.
			  checkbox(-name=>'rev1',
				   -value=>'-REV',
				   -label=>' Use the reverse complement',
				   -checked=>$self->{'_rev1'})).
		       td({-valign=>'top'},
			  b(font({-size=>'5',
				  -color=>'red'}, "OR"))).
		       td({-bgcolor=>'#b7d8e4',
			   -width=>'25%',
			   -valign=>'top'}, 
			  b(big("2. Pick a chromosome:")).br.
			  popup_menu(-name=>'chr',
                                     -values=>\@chr,
				     -labels=>\%num2rom,
				     -default=>$self->{'_chr'}).br.
			  b("Then enter coordinates (optional):").br.
			  textfield(-name=>'beg',
				    -value=>$self->{'_beg'},
				    -size=>'10')." to ".
			  textfield(-name=>'end',
				    -value=>$self->{'_end'},
				    -size=>'10').br.
			  "The first 100,000 bp (nucleotide numbers) are displayed if no coordinates are entered.".p.
			  b("Note:")." Enter coordinates in ascending order for the Watson strand and descending order for the Crick strand.".p.
			  checkbox(-name=>'rev3',
				   -value=>'-REV',
				   -label=>' Use the reverse complement',
				   -checked=>$self->{'_rev3'})).
		       td({-valign=>'top'},
			  b(font({-size=>'5',
				  -color=>'red'}, "OR"))).
		       td({-bgcolor=>'#b7d8e4',
		           -width=>'30%',
		           -valign=>'top'},
			  b(big("3. Type or Paste a".br.
				popup_menu(-name=>'seqtype',
					   -values=>['DNA', 'Protein'],
					   -default=>$self->{'_seqtype'}).
				"Sequence:")).br.
			  textarea(-name=>'sequence',
				   -value=>$self->{'_sequence'},
				   -cols=>'25',
				   -rows=>'7').br.
			  "The sequence ".b("MUST")." be provided in ".b("RAW format").", no comments (numbers are okay).".p.
			  checkbox(-name=>'rev2',
				   -value=>'-REV',
				   -label=>' Use the reverse complement',
				   -checked=>$self->{'_rev2'})
			  )));

	if (!param('back')) {
	    print blockquote(table(Tr(td(submit(-name=>'submit',
						-value=>'Submit Form')).
				      td(reset(-name=>'Reset Form')).
				      td(end_form))));
	}
	else {
	    print blockquote(table(Tr(td(submit(-name=>'submit',
						-value=>'Submit Form').
					 end_form).
				      td(start_form.
					 submit(-name=>'Reset Form').
					 end_form))));
	}

	&printEndPage;
}

########################################################################
sub choosePageToPrint {
########################################################################
    my ($self) = @_;
  
    if ($self->{'_query'}) {
        
	my $seqObj = SeqParamTranslator->new(dbh=>$dbh,
				   query=>$self->{'_query'});
	
	if ($seqObj->error) {
	    $self->err_report($seqObj->error);
	    return;
	}
	
	if ($seqObj->matchList) {
	    $self->displayMatchList($seqObj->matchList, $seqObj->type);
	    return;
	}
	
	if ($seqObj->type =~ /^clone/i) { ### clone
	    $self->printPage4Clone($seqObj);
	    return;
	}

	my $locusObj = $seqObj->locusObject;
	my $featObj = $seqObj->featureObject;

	if (!$featObj && $locusObj) {
	    $self->printPage4GeneticMappedGene($seqObj);
	    return;
	}

	if ($featObj) { ### feature/gene
	    $self->printPage4feature($seqObj);
	    return;
	}

	### genBank sequence
	$self->printPage4gb($seqObj);
	return;

    }
    elsif ($self->{'_chr'}) {
	$self->printPage4Chrnum;
    }
    elsif ($self->{'_sequence'}) {
	$self->printPage4Sequence;
    }
    elsif (param('id')) {
	if (param('map') =~ /^rmap/i) {
	    $self->printPage4SixFrame;
	}
	else {
	    $self->printPage4Translation;
	}
    }
}

########################################################################
sub getBackLink {
########################################################################
    my ($self) = @_;
    return "[".a({-href=>url."?back=1&$queryline"}, "Change Entered Selection or Coordinates")."]";

}

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

    my $chr = $seqObj->chromosome;
    my $flankl = param('flankl');
    my $flankr = param('flankr');
    &DeleteUnwantedChar(\$flankl);
    &DeleteUnwantedChar(\$flankr);
    if ($flankl < 0) { $flankl *= -1; }
    if ($flankr < 0) { $flankr *= -1; }
    my $beg = $seqObj->start_coord - $flankl;
    my $end = $seqObj->stop_coord + $flankr;
    my $rev;
    if (param('rev1')) { $rev = "-REV"; }

    $self->printDescription("clone", $self->{'_query'},
			    $self->{'_query'}, $chr, 
			    $seqObj->start_coord,
			    $seqObj->stop_coord,
			    "W", $flankl, $flankr, $rev);

    $self->getgcgseq("clone", $self->{'_query'}, $chr, $beg, $end, $rev);

    my (@BIO, @MAP, @SEQANAL);

    push(@BIO, big(b("Biology/Literature")));
    push(@BIO, a({-href=>$configUrl->dictyBaseCGIRoot."$dblink/PHYSMAP/PHYSmap?clone=".$self->{'_query'}}, "Clone details"));

    $self->setMainMapLinks4seqname(\@MAP, $self->{'_query'});

    $self->setSeqAnalysisLinks(\@SEQANAL);
    
    $self->displaySeqAnalysis(\@BIO, \@MAP, \@SEQANAL); 

    
    my $getSeqQueryline = "seq=".$self->{'_query'}."&flankl=$flankl&flankr=$flankr&rev=$rev";

    $self->displaySequenceRetrieval('clone', $getSeqQueryline);

    &printEndPage;
}

########################################################################
sub printPage4feature {
########################################################################
    my ($self, $seqObj) = @_;
    &printStartPage($self->database, $self->title, $self->help);
    
    my $flankl = param('flankl');
    my $flankr = param('flankr');
    &DeleteUnwantedChar(\$flankl);
    &DeleteUnwantedChar(\$flankr);
    if ($flankl < 0) { $flankl *= -1; }
    if ($flankr < 0) { $flankr *= -1; }
    my $featObj = $seqObj->featureObject;
    my $chr = $featObj->chromosome;
    my $beg = $featObj->start_coord;
    my $end = $featObj->stop_coord;
    if ($featObj->strand =~ /^C/i) {
	($beg, $end) = ($end, $beg);
	($flankl, $flankr) = ($flankr, $flankl);
    }
    $beg -= $flankl;
    $end += $flankr;
    my $rev;
    if ((param('rev1') && $featObj->strand =~ /^W/i) ||
	(!param('rev1') && $featObj->strand =~ /^C/i)) { 
	$rev = "-REV"; 
    }
    my $showNm = $featObj->feature_name;
    if ($seqObj->locusObject) {
	my $locusObj = $seqObj->locusObject;
	$showNm .= "/".$locusObj->locus_name;
    }
    $self->printDescription("feature", $featObj->feature_name, 
			    $showNm, $chr, $featObj->start_coord, 
			    $featObj->stop_coord, 
			    $featObj->strand,  
			    $flankl, $flankr, $rev,
			    $featObj->featureTypeList);
    if ($seqObj->type =~ /^alias/i) {
	$self->printAliasStatement($self->{'_query'}, $showNm);
    }

    $self->getgcgseq("feature", $featObj->feature_name, 
		     $chr, $beg, $end, $rev);

    my (@BIO, @MAP, @SEQANAL);

    $self->setBioLinks(\@BIO, $featObj);

    $self->setMainMapLinks4seqname(\@MAP, $featObj->feature_name);

    $self->setExtraMapLinks(\@MAP, $featObj->feature_name, 
			    $chr, $beg, $end);

    $self->setSeqAnalysisLinks(\@SEQANAL);
    
    $self->displaySeqAnalysis(\@BIO, \@MAP, \@SEQANAL); 

    
    my $getSeqQueryline = "seq=".$featObj->feature_name."&flankl=$flankl&flankr=$flankr&rev=".param('rev1');

    $self->displaySequenceRetrieval("feature", $getSeqQueryline, $featObj);

    &printEndPage;

}


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

    my $locusObj = $seqObj->locusObject;
    my $chr = $locusObj->chromosome;
    my $seqname = $locusObj->locus_name;
    my $chrdesc = "chromosome ".$num2rom{$chr};
    if ($chr == 17) { $chrdesc = "mitochondria"; }

    print p, "The currently selected gene/sequence is : ".b(font({-color=>'red'}, $seqname))." on $chrdesc".br.$self->getBackLink,p;
   
    if ($seqObj->type =~ /^alias/i) {
	$self->printAliasStatement($self->{'_query'}, $seqname);
    }
    
    my (@BIO, @MAP, @SEQANAL);

    $self->setBioLinks(\@BIO, $locusObj, "genetic");

    $self->setMainMapLinks4seqname(\@MAP, $locusObj->locus_name, 
				   "genetic");

    $self->displaySeqAnalysis(\@BIO, \@MAP, \@SEQANAL); 

    &printEndPage;

}

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

#    my $flankl = param('flankl');
#    my $flankr = param('flankr');

#    if ($flankl < 0) { $flankl *= -1; }
#    if ($flankr < 0) { $flankr *= -1; }

#    &DeleteUnwantedChar(\$flankl);
#    &DeleteUnwantedChar(\$flankr);

    my $rev = param('rev1');

    my $gbSeqObj = $seqObj->genbankSeqObject;
 
    my $seqname = $gbSeqObj->display_id();

    my $len = $gbSeqObj->length();

    my $desc = $gbSeqObj->desc();

#    my $moltype = $gbSeqObj->moltype;

    my $moltype = $gbSeqObj->alphabet();

    $self->{'_gbSeq'} = $gbSeqObj->seq;
    
    my $uid = $gbSeqObj->primary_id;

    if ($moltype =~ /protein/i) {

	print p, "The currently selected sequence is : ".b("GenPept entry ".font({-color=>'red'}, $seqname)." ($desc)").br; 

    }
    else {

	print p, "The currently selected sequence is : ".b("GenBank entry ".font({-color=>'red'}, $seqname)." ($len bps long, $desc)").br;  

    }

    if (param('rev1') && $moltype !~ /protein/i) {

	print blockquote("You have selected the reverse complement of this sequence. The reverse complement is on the Crick strand and will be displayed 5'->3' for all Sequence Analysis and Sequence Retrieval options."),p;

    }
    print $self->getBackLink,p;  
    if (param('rev1')) { $rev = "-REV"; }
	    
    $self->createTmpSeqFile($self->{'_gbSeq'}, $moltype);

    my (@BIO, @MAP, @SEQANAL);
    
    push(@BIO, big(b("Biology/Literature")));
    
    if ($moltype =~ /protein/i) {

	push(@BIO, a({-href=>$configUrl->ncbiUrlRoot."query.fcgi?cmd=Retrieve&db=Protein&list_uids=$uid&dopt=GenPept"}, "Sequence details"));

    }
    else {
    
	push(@BIO, a({-href=>$configUrl->ncbiUrlRoot."query.fcgi?cmd=Retrieve&db=nucleotide&list_uids=$uid&dopt=GenBank"}, "Sequence details"));
    
    }

    $self->{'_moltype'} = $moltype;

    $self->setSeqAnalysisLinks(\@SEQANAL);

    $self->displaySeqAnalysis(\@BIO, \@MAP, \@SEQANAL); 
 
    $seqname =~ s/^(.+).\(GB.+$/$1/;

    if ($moltype !~ /protein/i) {

	my $getSeqQueryline = "seq=$seqname&rev=".param('rev1');

	$self->displaySequenceRetrieval("gb", $getSeqQueryline);

    }
	
    if (open(LOG, ">>".$configPath->logDir4web."seqToolsGBquery.log")) {

	my $date = `/usr/bin/date`;

	chomp $date;

	print LOG "$date\t$seqname\t$desc\n";

	close(LOG);

    }
    else { 

	print "can't open '".$configPath->logDir4web."seqToolsGBquery.log"."' for writing:$!\n";

    }

    &printEndPage;

}

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

    my $chrdesc = "chromosome ".$num2rom{$self->{'_chr'}};
    if ($self->{'_chr'} == 17) {
	$chrdesc = "Mitochondrial";
    }

    print p, "The current selection is : ".b(font({-color=>'red'}, 
						  $chrdesc));
    if ($self->{'_beg'} && $self->{'_end'}) {
	print b(font({-color=>'red'}, 
		     ", coordinates ".
		     $self->{'_beg'}." to ".
		     $self->{'_end'}));
    }

    my ($strand, $revStrand);
    if ($self->{'_beg'} > $self->{'_end'}) {
	$revStrand = 'Watson';
	$strand = 'Crick';
    }
    else {
	$strand = 'Watson';
	$revStrand = 'Crick';
    }
	
    if (param('rev3')) {
	print p, blockquote(b("You have selected the reverse complement of this sequence. The reverse complement is on the $revStrand strand and will be displayed 5'->3' for all Sequence Analysis and Sequence Retrieval options."));
    }
    else {
	print p, blockquote(b("The selected sequence is on the $strand strand and will be displayed 5'->3' for all Sequence Analysis and Sequence Retrieval options."));
    }
    print p, $self->getBackLink;

    my $beg = $self->{'_beg'};
    my $end = $self->{'_end'};

    my $rev;
    if ((param('rev3') && $beg < $end) ||
	(!param('rev3') && $beg > $end)) {
	$rev = "-REV";
    }
    if ($beg > $end) { ($beg, $end) = ($end, $beg); }
    
    $self->getgcgseq('chr', '', $self->{'_chr'}, $beg, 
		     $end, $rev); 

    my (@BIO, @MAP, @SEQANAL);

    $self->setMainMapLinks4chr(\@MAP);


    $self->setSeqAnalysisLinks(\@SEQANAL);
    
    $self->displaySeqAnalysis(\@BIO, \@MAP, \@SEQANAL); 
    
    # my $rev;
    # if (param('rev3')) {
    #	$rev = "-REV";
    # }

    my $getSeqQueryline = "chr=".$self->{'_chr'}.
	                  "&beg=".$beg.
			  "&end=".$end.
			  "&rev=$rev";

    $self->displaySequenceRetrieval("chr", $getSeqQueryline);

  
    &printEndPage;

}

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

    my $sequence = $self->{'_sequence'};

    print p, "The current raw sequence you have entered is : ".b(font({-color=>'red'}, param('seqtype')." sequence"));

    if (param('seqtype') =~ /^DNA/i) {  ### dna sequence
	if (param('rev2')) {
	    $sequence = $self->reverseCompl($self->{'_sequence'});
	    print p, start_form.b(font({-color=>'red'}, "The reverse complement of this sequence")).br.
		  textarea(-name=>"compl_seq",
			   -value=>"$sequence",
			   -cols=>'70',
			   -rows=>'7').end_form;
	}
    }
    else {
	
    }

    $self->createTmpSeqFile($sequence);
        
    $sequence =~ s/[^a-zA-Z]//g;
    
    my (@BIO, @MAP, @SEQANAL);

    $self->setSeqAnalysisLinks(\@SEQANAL, $sequence);
    
    $self->displaySeqAnalysis(\@BIO, \@MAP, \@SEQANAL); 

    &printEndPage;

}


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

    my $id = param('id');

    my $translateFile = $configPath->tmpDir."gcgseq.translated.tmp.$id";
	               
    open(TRAN, "$translateFile") || 
         print "Can't open '$translateFile' for reading:$!\n";
    my $seqstart = 0;
    my $SEQ;
    while(<TRAN>) {
	if (/\.\.$/) {
	    $seqstart = 1;
	}
        elsif ($seqstart == 1) {
            $SEQ .= $_;
        }
    }
    close (TRAN);

    print p, start_form, b(font({-color=>'red'}, "Translated protein sequence")),br;
    print textarea(-name=>"compl_seq",
		   -value=>"$SEQ",
		   -cols=>'70',
		   -rows=>'7').end_form;
    
    $SEQ =~ s/[^a-zA-Z]//g;
    my $list;
    if (length($SEQ) > 15) {
	$list = li(a({-href=>$configUrl->DictyosteliumServerRoot."cgi-bin/blast.pl?id=$id&trans=1"}, "BLAST Search"));
	$list .= li(a({-href=>$configUrl->DictyosteliumServerRoot."cgi-bin/dictyBase/nph-fastadictyBase?id=$id&trans=1"}, "FASTA Search"));
    }
    print p, ul($list),p;

    &printEndPage;
}

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

    my $id = param('id');

    my $seqFile = $configPath->tmpDir."gcgseq.tmp.$id";
	               
    print "<pre>";
    system("/bin/cat $seqFile");
    print "</pre>";

    &printEndPage;
}


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

    if ($type =~ /alias/i) {
	print b($self->{'_query'})." is a non-standard name for following genes.",p;
    }
    else {
        print "Available sequence names that begin with ".b($self->{'_query'}.":"),p;
    }
    my @seqname = split(/\:/, $matchList);
    my $list;
    foreach my $seqname (@seqname) {
        #get only name and no space, (GB)
        my ($name) = split(/ /, $seqname);
	$list .= li(a({-href=>url."?seqname=$name&flankr=".param('flankr')."&flankl=".param('flankl')."&rev1=".param('rev1')}, $seqname));
    }
    print ul($list),p;
    
    &printEndPage;
}

########################################################################
sub displaySeqAnalysis {
########################################################################
    my ($self, $BIOref, $MAPref, $SEQANALref) = @_;
    
    my $listNum;
    if (@$MAPref > @$BIOref) { $listNum = @$MAPref; }
    else { $listNum = @$BIOref; }
    if ($listNum < @$SEQANALref) { $listNum = @$SEQANALref; }

    my $rows;
    if (!@$BIOref && !@$MAPref) {
	foreach my $seqAnal (@$SEQANALref) {
	    $rows .= Tr(td({-width=>'30%'},
			   $seqAnal));
	}
    }
    elsif (!@$MAPref) {
	for (my $i = 0; $i < $listNum; $i++) {
	    if (!$$BIOref[$i]) { $$BIOref[$i] = br; }
	    if (!$$SEQANALref[$i]) { $$SEQANALref[$i] = br; }
	    $rows .= Tr(td({-width=>'25%'},
			   $$BIOref[$i]).
			td({-width=>'30%'},
			   $$SEQANALref[$i]));
	}
    }
    elsif (!@$BIOref) {
	for (my $i = 0; $i < $listNum; $i++) {
	    if (!$$MAPref[$i]) { $$MAPref[$i] = br; }
	    if (!$$SEQANALref[$i]) { $$SEQANALref[$i] = br; }
	    $rows .= Tr(td({-width=>'25%'},
			   $$MAPref[$i]).
			td({-width=>'30%'},
			   $$SEQANALref[$i]));
	}
    }
    else {
	for (my $i = 0; $i < $listNum; $i++) {
	    if (!$$BIOref[$i]) { $$BIOref[$i] = br; }
	    if (!$$MAPref[$i]) { $$MAPref[$i] = br; }
	    if (!$$SEQANALref[$i]) { $$SEQANALref[$i] = br; }
	    $rows .= Tr(td({-width=>'25%'},
			   $$BIOref[$i]).
			td({-width=>'40%'},
			   $$MAPref[$i]).
			td({-width=>'30%'},
			   $$SEQANALref[$i]));
	}
    }

    print p, table({-width=>'95%',
		    -border=>'0'},
		   $rows);
}

########################################################################
sub displaySequenceRetrieval {
########################################################################
    my ($self, $type, $getSeqQueryline, $featObj) = @_;
   
    my $getSeqUrl = $configUrl->dictyBaseCGIRoot."$dblink/getSeq";

    my %seqTypeHash;

    #check which sequences exist for given feature
    if ($type eq 'feature') {
        %seqTypeHash = $featObj->getDisplaySeqNumHash;
       
    }


    my $rows;

    #if (($type ne 'feature') || (($type eq 'feature') && $genomicObj)) { 

    if (($type ne 'feature') || (($type eq 'feature') && 
                                   exists($seqTypeHash{'Genomic DNA'}))) { 

       $rows .= Tr(th({-width=>'45%'}, br).
		  th({-width=>'30%'}, "Output Format")).
               Tr(td({-width=>'45%'}, b("DNA of Region")).
		  td({-width=>'30%'}, 
		     a({-href=>$getSeqUrl."?map=amap&".$getSeqQueryline}, 
		       "GCG")." | ".
		     a({-href=>$getSeqUrl."?map=a3map&".$getSeqQueryline},
		       "FASTA")." | ".
		     a({-href=>$getSeqUrl."?map=a2map&".$getSeqQueryline},
		       "NoHeader")));
    }


    my $sectionTitle = "Protein Translation";
   
 
    if ((($type ne 'feature') && ($type ne 'gb')) || (($type eq 'feature') && 
                             exists($seqTypeHash{'DNA coding sequence'}))) {

	$rows .= Tr(td({-width=>'45%'},
		       b("Coding Sequence of selected gene/ORF").br.
		       "(without introns, without flanking regions)").
		    td({-width=>'30%'},
		       a({-href=>$getSeqUrl."?map=nmap&".$getSeqQueryline},
			"GCG")." | ".
		       a({-href=>$getSeqUrl."?map=n3map&".$getSeqQueryline},
			 "FASTA")." | ".
		       a({-href=>$getSeqUrl."?map=n2map&".$getSeqQueryline},
			 "NoHeader"))); 
	$sectionTitle .= " of ORF";

    }



    if (($type ne 'feature') || (($type eq 'feature') && 
                             exists($seqTypeHash{'Protein'}))) {
       $rows .= Tr(td({-width=>'45%'},
    		   b($sectionTitle)).
		td({-width=>'30%'}, 
		   a({-href=>$getSeqUrl."?map=pmap&".$getSeqQueryline}, 
		       "GCG")." | ".
		   a({-href=>$getSeqUrl."?map=p3map&".$getSeqQueryline},
		       "FASTA")." | ".
		   a({-href=>$getSeqUrl."?map=p2map&".$getSeqQueryline},
		       "NoHeader")));

    }

    $rows .= Tr(td({-width=>'45%'},
		   b("6-Frame Translation")." (with Restriction Map)").
		td({-width=>'30%'}, 
		   a({-href=>$getSeqUrl."?map=rmap&".$getSeqQueryline}, 
		       "GCG"))).
	     Tr(td({-width=>'45%'},
		   b("Restriction Fragment Sizes")).
		td({-width=>'30%'},
		   a({-href=>$getSeqUrl."?map=fmap&".$getSeqQueryline}, 
		       "GCG")));

    print p, table({-align=>'center',
		     -width=>'75%',
		     -border=>'1',
		     -cellspacing=>'2',
		     -cellpadding=>'2'},
		    center(caption(big(b("Sequence Retrieval")))).
		    $rows),p;

}

########################################################################
sub printDescription {
########################################################################
    my ($self, $type, $seqname, $showNm, $chr, $beg, $end, $strand, 
	$flankl, $flankr, $rev, $featureTypeList) = @_;

    my $miniORFmap;
    if ($type =~ /^feature/i) {
	$miniORFmap = "<p>";
    }

    my $chrdesc = "chromosome ".$num2rom{$chr};
    if ($chr == 17) { $chrdesc = "mitochondria"; }

    my $subtitle = "The currently selected gene/sequence is : $miniORFmap".b(font({-color=>'red'}, $showNm)." on $chrdesc from coordinates $beg to $end");
    
    if ($strand =~ /^C/i) {
	($flankl, $flankr) = ($flankr, $flankl);
    }

    if ($flankr && $flankl) { 
	 $subtitle .= b(" plus $flankl basepairs of upstream sequence and $flankr basepairs of downstream sequence.");
    }
    elsif ($flankl && !$flankr) {
	 $subtitle .= b(" plus $flankl basepairs of upstream sequence.");
    }
    elsif (!$flankl && $flankr) { 
	 $subtitle .= b(" plus $flankr basepairs of downstream sequence.");
    }
    else { $subtitle .= b("."); }
    
    $subtitle .= $self->{'_note4negativeflank'};
    
    if (param('rev1')) {

	my $revStrand;
	if ($strand =~ /^W/i) { $revStrand = "Click"; }
	else { $revStrand = "Watson"; }
	    
	$subtitle .= blockquote("You have selected the reverse complement of this sequence. The reverse complement is on the $revStrand strand and will be displayed 5'->3' for all Sequence Analysis and Sequence Retrieval options.");
	
    }
    else { $subtitle .= br; }

    my $badType;

    if ($featureTypeList =~ /Merged/i) {
	$badType = 'Merged';
    }
    elsif($featureTypeList =~ /Deleted/i) {
	$badType = 'Deleted';
    }
    
    if ($badType) {

	$subtitle .= p.font({-color=>'red'}, b("Warning: this chromosome feature is flagged as '$badType' in dictyBase. Thus, the information below may be outdated or inaccurate, since information about '$badType' features is not always updated. In particular, be wary of the sequence or chromosomal coordinates. See the Locus Info link below for more information.")),p;

    }

    $subtitle .= $miniORFmap.$self->getBackLink;


    if ($miniORFmap) {
	$subtitle = td({-align=>'left'}, $subtitle).
	            td("<pre>         </pre>").
	            td({-align=>'right'}, 
		       a({-href=>$configUrl->dictyBaseCGIRoot."$dblink/ORFMAP/ORFmap?seq=$seqname"}, 
			 img({-src=>$configUrl->dictyBaseCGIRoot."$dblink/ORFMAP/miniORFmap?seq=$seqname",
			      -align=>'right',
			      -border=>'0',
			      -alt=>'ORFmap'})));
    }

    print p, table(Tr($subtitle));

}

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

    return b("[".a({-href=>url."?back=1&$queryline"}, "Change Entered Selection or Coordinates")."]");

}

########################################################################
sub printAliasStatement {
########################################################################
    my ($self, $aliasNm, $showNm) = @_;
    print br, table(Tr(th(font({-color=>'red'}, "Note:")." $aliasNm is a non-standard name for $showNm")));
}


########################################################################
sub setBioLinks {
########################################################################
    my ($self, $BIOref, $geneObj, $type) = @_;
    
    my $name;
    if ($type =~ /^genetic/) { ### locus object 
	$name = $geneObj->locus_name;
    }
    else { ### feature object
	$name = $geneObj->feature_name; 
    }
    
    push(@$BIOref, big(b("Biology/Literature")));
    push(@$BIOref, a({-href=>$configUrl->dictyBaseCGIRoot."gene_page.pl?gene_name=$name"}, "Locus Info"));
    push(@$BIOref, a({-href=>$configUrl->dictyBaseCGIRoot."$dblink/reference/geneinfo.pl?locus=$name"}, "Literature Summaries"));
    
#    if ($type !~ /^genetic/i && $geneObj->featureTypeList =~ /ORF/i) {
#	my $ypdObj = Ypd_protein_info->new(dbh=>$dbh,
#					   dictyBaseid=>$geneObj->dictyBaseid);

#	if ($ypdObj) {
#	    push(@$BIOref, a({-href=>$configUrl->dictyBaseCGIRoot."$dblink/YPD/ypd.pl?dictyBaseid=".$geneObj->dictyBaseid}, "Protein Info"));
#	}
#    }

    if ($type !~ /^genetic/ && $geneObj->protein_info_no) {

	push(@$BIOref, a({-href=>$configUrl->dictyBaseCGIRoot."$dblink/protein/protein?dictyBaseid=".$geneObj->dictyBaseid}, "Protein Info"));

    }

    my $breadCGIRoot = $configUrl->breadServerRoot."cgi-bin/dictyBase/";

    push(@$BIOref, a({-href=>$configUrl->dictyBaseCGIRoot."$dblink/geneHunter?locus=$name"}, "Global Gene Hunter"));

    if ($type =~ /^genetic/i || $geneObj->chromosome == 17 ||
	$geneObj->featureTypeList !~ /ORF/i ) { 
	return ; 
    }

    push(@$BIOref, a({-href=>$breadCGIRoot."Sacch3D/get?class=gene&item=$name"}, "3-D Structure"));
    push(@$BIOref, a({-href=>$breadCGIRoot."Sacch3D/getblast?name=$name&db=mammal"}, "Mammalian Homologs"));
    
}

########################################################################
sub setMainMapLinks4seqname {
########################################################################
    my ($self, $MAPref, $seqname, $type) = @_;

    my $queryline4map = "seq=$seqname";

    $self->setMainMapLinks($MAPref, $queryline4map, $type);

}

########################################################################
sub setMainMapLinks4chr {
########################################################################
    my ($self, $MAPref) = @_;

    my $beg = $self->{'_beg'};
    my $end = $self->{'_end'};
    if ($beg > $end) { ($beg, $end) = ($end, $beg); }
	
    my $queryline4map = "chr=".$self->{'_chr'}."&beg=$beg&end=$end";

    $self->setMainMapLinks($MAPref, $queryline4map);
    
    if ($self->{'_chr'} != 17) {
	push(@$MAPref, a({-href=>$configUrl->breadServerRoot."cgi-bin/dictyBase/SSV/stripe?".$self->{'_chr'}.":chr:$beg:$end:"}, "Genomic Stripe View"));
    }
    push(@$MAPref, a({-href=>$configUrl->dictyBaseCGIRoot."$dblink/ORFMAP/ORFmap?$queryline4map&sage=1"}, "SAGE Results Map"));

}

########################################################################
sub setMainMapLinks {
########################################################################
    my ($self, $MAPref, $queryline4map, $type) = @_;

    push(@$MAPref, big(b("Display Maps/Tables")));

    if ($type !~ /^genetic/i) {
	push(@$MAPref, a({-href=>$configUrl->dictyBaseCGIRoot."$dblink/ORFMAP/ORFmap?$queryline4map"}, "Chromosomal Features Map"));
	push(@$MAPref, a({-href=>$configUrl->dictyBaseCGIRoot."$dblink/featureform?$queryline4map"}, "Chromosomal Features Table"));
	push(@$MAPref, a({-href=>$configUrl->dictyBaseCGIRoot."$dblink/PHYSMAP/PHYSmap?$queryline4map"}, "Physical Map"));
    }
    if ($queryline4map !~ /^chr=17/) {
	push(@$MAPref, a({-href=>$configUrl->dictyBaseCGIRoot."$dblink/PGMAP/PGmap?$queryline4map"}, "Combined Physical and Genetic Map"));
	push(@$MAPref, a({-href=>$configUrl->dictyBaseCGIRoot."$dblink/PGMAP/ratioMap?$queryline4map"}, "Genetic Distance vs. Physical Distance Ratios"));
    }
}

########################################################################
sub setExtraMapLinks {
########################################################################
    my ($self, $MAPref, $seqname, $chrnum, $beg, $end) = @_;

    if ($chrnum == 17) { return; }


    my $breadCGIRoot = $configUrl->breadServerRoot."cgi-bin/dictyBase/";

    push(@$MAPref, a({-href=>$breadCGIRoot."SSV/stripe?$chrnum:$seqname:$beg:$end:"}, "Genomic Stripe View"));

    if ($seqname !~ /^Y[A-P][RL][0-9]+/i) { return ; }
    push(@$MAPref, "Genome-wide Similarity View [".a({-href=>$breadCGIRoot."SWA/swaStart.pl?set=0&crit=0&orfs=$seqname"}, "Protein")." | ".a({-href=>$breadCGIRoot."SWA/swaStart.pl?set=1&crit=0&orfs=$seqname"}, "DNA")."]" );
    push(@$MAPref, "Genome-wide Similarity Table [".a({-href=>$breadCGIRoot."SWA/swaPrintTable.pl?set=0&crit=0&orfs=$seqname"}, "Protein")." | ".a({-href=>$breadCGIRoot."SWA/swaPrintTable.pl?set=1&crit=0&orfs=$seqname"}, "DNA")."]");

    push(@$MAPref, a({-href=>$configUrl->dictyBaseCGIRoot."$dblink/ORFMAP/ORFmap?gene=$seqname&sage=1"}, "SAGE Results Map"));

}

########################################################################
sub setSeqAnalysisLinks {
########################################################################
    my ($self, $SEQANALref, $sequence) = @_;

    my $DictyosteliumUrlRoot = $configUrl->DictyosteliumServerRoot."cgi-bin/dictyBase/";

    push(@$SEQANALref, big(b("Sequence Analysis")));

    if (!$sequence || length($sequence) > 15) {
	push(@$SEQANALref, 
	     a({-href=>$DictyosteliumUrlRoot."blast.pl?id=$$"}, 
	       "BLAST Search"));
	push(@$SEQANALref, 
	     a({-href=>$DictyosteliumUrlRoot."nph-fastadictyBase?id=$$"}, 
	       "FASTA Search"));
    }
    if ((!$sequence || param('seqtype') =~ /^DNA/i) &&  
	$self->{'_moltype'} !~ /protein/i) {
	push(@$SEQANALref, a({-href=>$configUrl->dictyBaseCGIRoot."$dblink/PATMATCH/RestrictionMapper?id=$$"}, 
			 "Genome Restriction Map"));
    }
    if ($sequence && length($sequence) <= 20) {
	my $seqtypeNm = "pepPat";
	if (param('seqtype') =~ /^DNA/i) { $seqtypeNm = "dnaPat"; }
	push(@$SEQANALref, a({-href=>$DictyosteliumUrlRoot."PATMATCH/nph-patmatch?$seqtypeNm=$sequence"}, "Genome Pattern Matching"));    
    }
    if (($sequence && param('seqtype') =~ /^protein/i) || 
	 $self->{'_moltype'} =~ /protein/i) { 
	return ;
    }
    push(@$SEQANALref, a({-href=>$DictyosteliumUrlRoot."web-primer?id=$$"},
			 "Design Primers"));
    
    if ($sequence && param('seqtype') =~ /^DNA/i) {
	$self->getgcgseq('trans', "$sequence"); 
	push(@$SEQANALref, a({-href=>$configUrl->dictyBaseCGIRoot."$dblink/seqTools?id=$$"}, "Translated Protein Sequence"));
	push(@$SEQANALref, a({-href=>$configUrl->dictyBaseCGIRoot."$dblink/seqTools?id=$$&map=rmap"}, "6-Frame Translation(with Restriction Map)"));
    }
}


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

    $self->{'_seqname'} = param('seqname');
    $self->{'_flankl'} = param('flankl');
    $self->{'_flankr'} = param('flankr');
    if ($self->{'_flankl'} < 0) { $self->{'_flankl'} *= -1; }
    if ($self->{'_flankr'} < 0) { $self->{'_flankr'} *= -1; }
    $self->{'_chr'} = param('chr');
    $self->{'_beg'} = param('beg');
    $self->{'_end'} = param('end');
    $self->{'_sequence'} = param('sequence');
    $self->{'_seqtype'} = param('seqtype');
    $self->{'_rev1'} = param('rev1');
    $self->{'_rev2'} = param('rev2');
    $self->{'_rev3'} = param('rev3');
	
}

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


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

    $configUrl = ConfigURLdictyBase->new;
    $dblink = $configUrl->dblink($self->database);
    $configPath = ConfigPathdictyBase->new;

    if ($self->{'_query'}) {

	my $query = $self->{'_query'};
	my $flankl = param('flankl');
	my $flankr = param('flankr');
	&DeleteUnwantedChar(\$query);
	&DeleteUnwantedChar(\$flankl);
	&DeleteUnwantedChar(\$flankr);

	$flankl =~ s/\,//g;
	$flankr =~ s/\,//g;

	$self->{'_query'} = $query;

	if ($flankr < 0) { 
	    $flankr *= -1;
	    $self->{'_note4negativeflank'} = " Negative numbers are not allowed on this form. You can use coordinates in Option 2 to retrieve partial ORFs.";
	}
	if ($flankl < 0) { 
	    $flankl *= -1; 
	    $self->{'_note4negativeflank'} = " Negative numbers are not allowed on this form. You can use coordinates in Option 2 to retrieve partial ORFs.";
	}
	
	
	$queryline = "seqname=$query";
	if ($flankr) { $queryline .= "&flankr=$flankr"; }
	if ($flankl) { $queryline .= "&flankl=$flankl"; }
	if (param('rev1')) { $queryline .= "&rev1=".param('rev1'); }
	    
    }
    elsif ($self->{'_chr'}) {

	my $beg = $self->{'_beg'};
	my $end = $self->{'_end'};
	&DeleteUnwantedChar(\$beg);
	&DeleteUnwantedChar(\$end);
	$beg =~ s/\,//g;
	$end =~ s/\,//g;

	$self->{'_beg'} = $beg;
	$self->{'_end'} = $end;

	if ($self->{'_beg'} =~ /^\-/ || $self->{'_end'} =~ /^\-/) {
	    $self->err_report("You should enter positive numbers for coordinates. Please go back, correct them and submit again. Thanks.");
	}
	if ($self->{'_chr'} =~ /^(mito|mt)/i) {
	    $self->{'_chr'} = 17;
	}
	elsif ($self->{'_chr'} =~ /^[IVX]+$/i) {
	    $self->{'_chr'} = $rom2num{uc($self->{'_chr'})};
        }   
	my $chrObj = Chromosome->new(dbh=>$dbh,
				     chromosome=>$self->{'_chr'});
	if (!$chrObj) {
	    $self->err_report("The chromosome number = ".$self->{'_chr'}." is not found in database.");
	}
	if ($self->{'_beg'} >= $chrObj->physical_length) {
	    $self->err_report("The starting coordinate is larger than or equal to the chromosome size (".$chrObj->physical_length."). Please go back and enter a smaller number. Thanks.");
	}
	elsif ($self->{'_end'} > $chrObj->physical_length) {
	    $self->err_report("The ending coordinate is larger than the chromosome size (".$chrObj->physical_length."). Please go back and enter a smaller number. Thanks!");
	}

        if (($self->{'_beg'} == 0 && $self->{'_end'} == 0)) {
             $self->{'_beg'} = 1;
             $self->{'_end'} = 100000; 
        }
	
	if ($self->{'_beg'} == $self->{'_end'}) {
	    $self->err_report("Error: The beginning and ending coordinates (nucleotide numbers) must be different numbers.");
	}

        if (($self->{'_beg'} == 0 ) || ($self->{'_end'} == 0)) {
            $self->err_report("Error: You must enter start and stop coordinates or no coordinates at all.");
        }

	$queryline = "chr=".$self->{'_chr'};

	if ($self->{'_beg'}) {
	    $queryline .= "&beg=".$self->{'_beg'};
	}
	if ($self->{'_end'}) {
	    $queryline .= "&end=".$self->{'_end'};
	}
	if (param('rev3')) {
	    $queryline .= "&rev3=".param('rev3');
	}
    }
    elsif ($self->{'_sequence'}) {
	$queryline = "sequence=".$self->{'_sequence'}.
	             "&seqtype=".param('seqtype');
	if (param('rev2')) {
	    $queryline .= "&rev2=".param('$rev2');
	}
    }
}

########################################################################
sub getgcgseq {
########################################################################
    my ($self, $type, $seq, $chr, $beg, $end, $rev) = @_;
   
    my $map = "amap";
    my ($sequence, $seqname);

    if ($type =~ /^trans/i) {

	$sequence = $seq;
    
	my $gcg = GCG->new(sequence=>$sequence);

	my $seqfile = $gcg->getSequence;

	### for 6-frame
	$gcg = GCG->new(sequence=>$sequence,
			map=>'rmap');

	$seqfile = $gcg->getSequence;

    }
    else {
	$seqname = $seq;
	my $gcg = GCG->new(map=>$map,
			   seqname=>$seqname,
			   chrnum=>$chr,
			   beg=>$beg,
			   end=>$end,
			   rev=>$rev);

	my $seqfile = $gcg->getSequence;		

    }
}

########################################################################
sub createTmpSeqFile {
########################################################################
    my ($self, $sequence, $seqtype) = @_;
    my $SEQTMP = $configPath->tmpDir."gcgseq.tmp.$$";  # Sequence temp file 
    open(OUT, ">$SEQTMP") || die "seqTools: Can't create tmp seq file:$!\n";
    
    $seqtype = $seqtype || param('seqtype');

    if ($seqtype =~ /^protein/i) {
	print OUT "\!\!AA\_SEQUENCE\n";
    }
    else {
	print OUT "\!\!NA\_SEQUENCE\n";
    }
    print OUT "temp sequence ..\n\n";
    print OUT "$sequence\n";
    close (OUT);
}

########################################################################
sub compl {
########################################################################
    my ($self, $sequence) = @_;
    my $complement;

    while ($sequence) {
	my $nuc = chop($sequence);
	if ($self->getComplement($nuc)) { 
	    $complement = $self->getComplement($nuc).$complement; 
	}
	else {
	    $complement = $nuc.$complement;
	} 
    }
    return ($complement);
}

########################################################################
sub reverseCompl {
########################################################################
    my ($self, $sequence) = @_;
    my $complement;

    while ($sequence) {
	my $nuc = chop($sequence);
	if ($nuc =~ /^[0-9]$/) { next; }
	elsif ($self->getComplement($nuc)) { 
	    $complement .= $self->getComplement($nuc); 
	}
	else {
	    $complement .= $nuc;
	} 
    }
    return ($complement);
}

########################################################################
sub getComplement {
########################################################################
    my ($self, $nuc) = @_;
    return 't' if ($nuc eq 'a');
    return 'T' if ($nuc eq 'A');
    return 'g' if ($nuc eq 'c');
    return 'G' if ($nuc eq 'C');
    return 'c' if ($nuc eq 'g');
    return 'C' if ($nuc eq 'G');
    return 'a' if ($nuc eq 't' || $nuc eq 'u');
    return 'A' if ($nuc eq 'T' || $nuc eq 'U');
    return 'k' if ($nuc eq 'm');
    return 'K' if ($nuc eq 'M');
    return 'y' if ($nuc eq 'r');
    return 'Y' if ($nuc eq 'R');
    return 'r' if ($nuc eq 'y');
    return 'R' if ($nuc eq 'Y');
    return 'm' if ($nuc eq 'k');
    return 'M' if ($nuc eq 'K'); 
    return 'v' if ($nuc eq 'b');
    return 'V' if ($nuc eq 'B');
    return 'h' if ($nuc eq 'd');
    return 'H' if ($nuc eq 'D');
    return 'd' if ($nuc eq 'h');
    return 'D' if ($nuc eq 'H');
    return 'b' if ($nuc eq 'v');
    return 'B' if ($nuc eq 'V');

}

########################################################################
sub err_report {
########################################################################
    my ($self, $err) = @_;

    &printStartPage($self->database, $self->title, $self->help);
   
    print b($err);
    
    &printEndPage;

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

    exit;
}


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