#!/usr/local/bin/perl

package geneview;

use strict;
use SiteDefs;
use Apache;
use EnsWeb;
use SiteDefs qw/:DEFAULT $ENSEMBL_SERVERADMIN/;
use ExtURL;
use GD;
use Bio::EnsemblViewer::Sequence::Contig;
use Bio::EnsemblViewer::Sequence::Transcript;
use Bio::EnsEMBL::ExternalData::Family::FamilyAdaptor;
use Bio::EnsEMBL::DrawableContainer;
use Bio::EnsEMBL::Map::DBSQL::Map;
use Bio::EnsEMBL::ExternalData::SNPSQL::WebSNPAdaptor;
use Bio::EnsEMBL::ExternalData::TCORESQL::DBAdaptor;
use Bio::EnsEMBL::ExternalData::EXONERATESQL::DBAdaptor;
use CGI;
use WebUserConfig;
use Digest::MD5;
use Bio::EnsemblViewer::JSTools;
use GramenePage;

&EnsWeb::get_locator();     # set up the environment...
my $q       = new CGI;
my $geneid  = $q->param('gene'); #do idfix() later because it might be an external id
my $transid = SiteDefs::idfix($q->param('transcript'));  # if we only want a single transcript shown
my $peptideid = SiteDefs::idfix($q->param('peptide'));  # to go in by peptide instead...
my $sscon = $q->param('sscon');  # no of bp to show either side of a splice site..

my $r = Apache->request();
$r->err_header_out('ensembl_headers_out'=>1);

my $gene_prefix = $ENSEMBL_PREFIXG;	#$ENSEMBL_PREFIX."G";

if (defined ($q->param('gene')) && $geneid !~ /$gene_prefix/){
    &get_known_gene($geneid);
}
$geneid=SiteDefs::idfix($geneid);

print CGI::header();
my ($head,$onload,$js_divs)=&EnsWeb::cgi_header_info(('initfocus'=>1));
my $grpg=GramenePage->new($r);
print $head,$grpg->start_body(  -ensembl=>1, -bodyattr=>$onload, -bodyfirst=>$js_divs  );
print "<br><br>\n";
print EnsWeb::print_form($geneid, "gene");

###########################
# Are we using gif or png?
###########################
my $img_type;

if (GD::Image->can("gif")){
    print STDERR "GD::Image thinks it can gif!\n";
    print STDERR GD::Image->can("gif"),"!\n";
    $img_type="gif";
}
else {
    $img_type="png";
}

## Get a DB handle
my $db = &db_connect($geneid);
my $sa = $db->get_StaticGoldenPathAdaptor();

my $family_db;
if($ENSEMBL_FAMILY) {
eval {
    my $temp_db = Bio::EnsEMBL::DBSQL::DBAdaptor->new(
						-dbname=>$ENSEMBL_FAMILY,
						-host=>$ENSEMBL_HOST,
						-driver=>$ENSEMBL_DRIVER,
						-port=>$ENSEMBL_HOST_PORT,
						-user=>$ENSEMBL_DBUSER,
						-pass=>$ENSEMBL_DBPASS
						    );
    $family_db = Bio::EnsEMBL::ExternalData::Family::FamilyAdaptor->new($temp_db);  
};
}

if($@){
    print STDERR "Protein Family database is unavailable: $@\n";
    undef $family_db;
    #print &ensembl_exception("Protein Family database is unavailable.",$@);
    #&ensembl_exit();
}

my $gene;

eval{
    if (defined $transid && ! defined $geneid){
        # we only got a transcript - get a gene ID first...
        $gene = $db->gene_Obj->get_Gene_by_Transcript_id($transid);
        $geneid = $gene->id;
    } 
    elsif (defined $peptideid && !defined $geneid){
        # we only got a peptide - get a gene ID first...
        $gene = $db->gene_Obj->get_Gene_by_Peptide_id($peptideid);
        $geneid = $gene->id;
    }
    else {
        $gene = $db->gene_Obj->get($geneid);
    }
};

if($@){
    if ($@ =~/Error retrieving gene with ID:/){
	print &ensembl_exception("This gene is not in the current database.  If you think this gene should be present, or have any other enquiry about this gene, please contact $ENSEMBL_SERVERADMIN",$@,1);
    }
    else {
	print &ensembl_exception("Cannot retrieve required gene from database",$@);
    }
    &ensembl_exit();
}

## Get a list of clones for this gene
my %clones;

## Get a list of exons for this gene
my @exons=$gene->each_unique_Exon;
my $focus_contig = $exons[0]->contig_id;

foreach my $exon (@exons){
    $clones{ $exon->clone_id }=1;
}

## Get a list of transcripts for this gene
my @trans = $gene->each_Transcript();
my $exon_total = scalar(@exons);
my $transcript_total = scalar(@trans);

#########################################
# Get InterPro accessions for this gene
#########################################
my @interpro = $db->gene_Obj->get_Interpro_by_geneid($geneid);

#########################################
# Get Protein Family info for this gene
#########################################
my $family = $family_db->get_Family_of_Ensembl_gene_id($geneid) if $family_db;

################################
# Get Description for this gene
################################
my $description = $gene->description();

#####################################################################
## Construct the web page
#####################################################################

print qq(<h3>Ensembl Gene Report</h3>\n);

print qq(
     <TABLE ALIGN="CENTER" BGCOLOR="#ffffff" WIDTH="100%" BORDER="1" CELLPADDING="3" CELLSPACING="0">
    <tr align="left" valign="middle">
      <td nowrap class="yellow2"><H4>Ensembl gene ID</H4></td>
      <td class="yellow1">
        <Font><B>&nbsp;&nbsp;$geneid</B></font>&nbsp;&nbsp;&nbsp;&nbsp;
      </td>
    </tr>
);

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

print qq(<tr><td class="yellow2"><h4>Genome Location</h4></td>);
print qq(<td class="yellow1">\n);
if( %clones ) {

    my $sp = $db->get_StaticGoldenPathAdaptor;
    my ($chr,$mbase) = $sp->get_Gene_chr_MB($geneid);
    #$chr =~ s/^R(\d+)_.*/Nipponbare Chromosome $1/;
    $chr =~ s/^R(\d+)_.*/Rice Chromosome $1/;
    print qq(&nbsp;&nbsp;<B>View this gene in the genome in BAC/PAC </B> \n);
    &print_clone_list($sa,$geneid, $focus_contig, keys %clones); 
    print qq(on <B>$chr</B> );  #[ location: $mbase MB ]);
    print qq(<BR>\n);
} else {
    print qq(<i>Database does not support gene to sequence entry links.</i>\n);
}
print qq(</td></tr>\n);

#####################################################################
print qq(
    <tr align="left" valign="middle">
      <td nowrap class="yellow2"><H4>Description</H4></td>
      <td class="yellow1">
        &nbsp;&nbsp;$description&nbsp;&nbsp;&nbsp;&nbsp;
      </td>
    </tr>
);
# Now we have put all the stuff from Genbank in as internal 
#  So this is false:
#    <tr align="left" valign="middle">
#      <td nowrap class="yellow2"><h4>Prediction Method</h4></td>
#      <td class="yellow1">
#        This gene was predicted by the Ensembl analysis pipeline from either a GeneWise or Genscan prediction followed
#    	by confirmation of the exons by comparisons to protein, cDNA and EST databases
#      </td>
#    </tr>

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

print qq(<tr valign="middle"><td class="yellow2"><h4>Predicted Transcripts</h4></td>);
print qq(<TD class="yellow1">);       
my $j = 1;
foreach my $t (@trans){ 
    my $tmp =  $t->id();    
    my @dblinks = $t->each_DBLink();
    my %swisslink;

    foreach my $DB_link ( @dblinks ){
	if( $DB_link->database() =~ /SWISS/o ||
	    $DB_link->database() eq 'SPTREMBL') {
	    $swisslink{ $DB_link->display_id } = $DB_link->primary_id;
	}
    }
    print qq(&nbsp;&nbsp;$j:&nbsp;&nbsp; $tmp [<A HREF="#$j">View transcript</A>]\n);  #supporting evidence</A>]\n);
    print qq(&nbsp;&nbsp;[<A HREF="/perl/protview?peptide=$tmp">View&nbsp;protein</A>]\n);
    print map { qq(&nbsp;&nbsp;[<A HREF="/perl/protein_search?acc=).$swisslink{$_}.qq(">View&nbsp;protein&nbsp;information($_)</A>]\n) } sort keys %swisslink;
    print qq(<BR>);
    $j++;
}
print qq(</TD></TR>\n);

###############################################################################
# is this a known gene?
###############################################################################

my @DBLINKS;
my $gramene_href;
eval {
    @DBLINKS = grep { $_->database() ne "DUMMY" }$gene->each_DBLink();
};
if ($@){
    print &ensembl_exception("Error on gene each_DBLink",$@);
    &ensembl_exit();
}

my %HTML = (
    'PIR'       => [],
    'HSSP'      => [],
    'PFAM'      => [],
    'PRINTS'    => [],
    'PROSITE'   => [],
    'SWISS'     => [],
    'MIM'       => [],
    'EMBL'      => [],
    'HUGO'      => [],
    'SWISSPROT' => [],
    'SP' 		=> [],
    'PDB'       => [],
    'GENECARD'  => [],
    'TRANSFAC'  => [],
    'PRODOM'    => [],
    'LOCUS'     => [],
);

if(@DBLINKS){
    
    my $link = ""; 
    my $urls = ExtURL->new();
    foreach (sort @DBLINKS){
        # Can't link refseq acc. nos if there is an SV - so strip it off
	if ($_->database() eq "REFSEQ"){
	    #now its the display_id which is showed on the web site
	    my $tmp = $_->display_id();
		$tmp =~ s/(.*)\.\d+$/$1/o;
		$_->display_id($tmp);
	}
	$link = "";
    	if ($urls->is_linked($_->database())){
	    $link = '&nbsp;&nbsp;&nbsp;&nbsp;<A HREF="'. 
		    $urls->get_url($_->database(),$_->primary_id()).'">'. 
		    $_->display_id(). '</A>';
	    if ($_->database() eq "HUGO"){
			    $link = '&nbsp;&nbsp;&nbsp;&nbsp;<A HREF="'. 
			    $urls->get_url('GENECARD',$_->display_id()).'">'. 
			    $_->display_id(). '</A>';
	    }
    	} else {
	    $link = "&nbsp;&nbsp;&nbsp;&nbsp;". $_->display_id();
    	}

    	if ($_->database() =~ /SWISS/o){  # make swiss and swissprot synonymous
        	push (@{$HTML{"SWISS"}}, $link);
		$gramene_href="/perl/protein_search?swall=".$_->display_id();
    	} else {
    		push (@{$HTML{$_->database()}}, $link);
    	}
    }
#    if($gramene_href) {
#	print qq(<tr valign="middle"><td class="yellow2"><h4>Protein Information</h4></td>);
#	print qq(<TD class="yellow1">[<a href="$gramene_href">View Protein Information</a>]</td></tr>);
#    }

    print qq(<tr valign="middle"><td class="yellow2"><h4>Links</h4></td>);
    print qq(<TD class="yellow1"><B>This Ensembl gene corresponds to the following other database identifiers</B><BR><BR>);
    foreach my $key (sort keys %HTML){
        print "&nbsp;&nbsp;$key: ", join(' ',(sort @{$HTML{$key}})),"<BR>" if (scalar (@{$HTML{$key}}) > 0);
    }
    print "</TD></TR>\n";
}

####################
# Do InterPro links
####################
if(@interpro){
    print qq(<tr valign="middle"><td class="yellow2"><h4>InterPro</h4></td>);
    print qq(<TD class="yellow1">);

    my $urls = ExtURL->new;

    foreach (sort @interpro){
	my($accession,$desc) = split(/:/,$_);
	my $interpro_url = $urls->get_url('INTERPRO',$accession);
	print qq(<A HREF="$interpro_url">$accession</A> $desc [<A HREF="domainview?domainentry=$accession">View other Ensembl genes with this domain</A>]<br>);
    }
    print "</TD></TR>\n";
}

################
# Do Familyview
################
if($family){
    print qq(<tr valign="middle"><td class="yellow2"><h4>Protein Cluster</h4></td>);
    print qq(<TD class="yellow1">);
   
    my $family_id = $family->id; 
    my $family_desc = substr($family->description, 0,40);
    my $fam_count = $family->size('ENSEMBLGENE')+ $family->size('SPTR');
    $family_desc .= "<br>&nbsp;&nbsp;This cluster contains $fam_count members";
    my $family_url = "/perl/familyview?family=$family_id";
   
    
    print qq(&nbsp;&nbsp;<A HREF="$family_url">$family_id</A> : $family_desc<br>);
    print "</TD></TR>\n";
}
#####################################################################

###########
# SAGEVIEW
###########
my $sage_url="/perl/sageview?alias=$geneid";

if($ENSEMBL_EXPRESSION) {
print qq(<tr><td class="yellow2"><h4>SAGE Expression Profile</h4></td>);
print qq(<td class="yellow1">\n);
print qq(&nbsp;&nbsp;<A HREF=$sage_url>$geneid</A>);
print qq(</td></tr>\n);
}

###########
# DUMPVIEW
###########
print qq(<tr><td class="yellow2"><h4>Text Dump</h4></td>);
print qq(<td class="yellow1">\n);
print qq(&nbsp;&nbsp;<a href="/perl/dumpcfgview?type=gene&id=$geneid">Generate a text dump of this gene</A>\n);
print qq(</td></tr>\n);
print "</TABLE>\n";

print qq(<br><h5><a href="#transcripts">Transcript information is below.</a></h5>);

print $grpg->end_body('',1);

print qq(<BR><BR>\n<a name="transcripts">);
&print_transcript_report($sa,$gene, $db, $sscon , SiteDefs::idfix($q->param('transcript'))
);
#print qq(</td></tr></TABLE><BR><BR>);

print $grpg->end_body('',2);
#print EnsWeb::make_cgi_footer();

1; # we end;

#####################################################################
#####################################################################
sub print_exon_list {

    my ($sa,$trans, $db, $sscon) = @_;
    my $strand = undef;

    my @el = $trans->each_Exon;

	print qq(
    	<TABLE ALIGN="CENTER" WIDTH="100%" CELLPADDING="3" CELLSPACING="0" BORDER="0">
    	 <TR align="left" class="yellow2"><TD colspan="8"><font color="#000000"><b>Exon Information</b></font></TD></tr>
    	<tr align="left" CLASS="yellow1">
    	 <td><b>No.</b>&nbsp;</td> <td><b>Exon ID</b></td> <td><b>Contig</b></td> <td><b>Strand</b>&nbsp;</td> <td><b>Start</b>&nbsp;</td> <td><b>End</b>&nbsp;</td> <td><b>Length</b>&nbsp;</td> <td align="center"><b>Exon Sequence</b></td>
    	</tr>
    	<tr><td colspan="8">&nbsp;</td></tr>
	);
    my $i =1;
    foreach my $exon (@el) {
    	my ($pep, $peplen, $dna, $dnalen, $seq, $contig, $clone);

    	$contig = $exon->contig_id();
    	$clone  = $exon->clone_id();

    	if ($exon->isa("Bio::EnsEMBL::StickyExon")) {
        	my @tmp = $exon->each_component_Exon;
        	$contig = $tmp[0]->contig_id;
        	$clone  = $tmp[0]->clone_id;
    	}

    	$pep = $exon->seq()->seq();
    	$peplen = length($pep);
    	$pep =~ s/([\*\w]{40})/$1<BR>/g;

    	print "<tr valign=\"top\">\n";
        print "<td align=\"center\">$i</td>\n";
        print "<td> ".$exon->id."&nbsp;</td>\n";

		if ($sa->is_golden_static_contig($contig)){
	    	print("<td> <a href=\"/perl/contigview?contig=$contig\">$contig</a>&nbsp;</td>\n");
		}else {
	    	print ("<td> $contig &nbsp;</td>\n");
		}
    	print "<td align=\"center\">".$exon->strand." </td>\n" ;
    	print "<td>".$exon->start."&nbsp;</td>\n" ;
    	print "<td>".$exon->end."&nbsp;</td>\n" ;
    	print "<td>$peplen bp</td>\n";

    	print("<td><font face=\"courier\"><small>$pep</small></font></td>\n");
    	print "</tr>\n";
    	$i++;
    }

    print "<tr><td colspan=\"8\">&nbsp;</td></tr>\n";
    print "</TABLE>\n";
    print "<br>\n";	#?


    if (scalar(@el) > 1){

    print qq(
        <TABLE ALIGN="CENTER" WIDTH="100%" CELLPADDING="3" CELLSPACING="0" BORDER="0">
        <TR align="left" class="yellow2"><TD colspan="4"><font color="#000000"><b>Splice Information</b></font></TD></tr>
    		<tr align="left" CLASS="yellow1">
    			<td align="center"><b>Site</b></td>
				<td align="right"><b>Exon ID</b></td>
				<td align="center"><b>Splice Site</b></td>
				<td align="left"><b>Exon ID</b></td>
    		</tr>
    	<tr>
			<td colspan="4">&nbsp;</td>
		</tr>
	);
    
	# Add a select box so user can choose how many bp either side of splice site to show
    my $cut = 3;
	my $self_url ;
	if ($sscon){
		if ($sscon < 1){ $sscon = 3;} 
		$cut = $sscon
	} else {
		$sscon = $cut;
	}
	my $self_url = &CGI::url();
	my @names = &CGI::param();
    print qq(<TR align="center">
			<TD colspan = "4">
			 <form method="GET" action="/perl/geneview" >Display up to <input name="sscon" value="$sscon" size="2" maxlength="2">
				base pairs either side of splice sites. 
				&nbsp;&nbsp;&nbsp;<INPUT TYPE="submit" VALUE="Redraw" class="red2">
			 </form>
	);
	foreach (qw(gene transcript peptide)){
		print qq(<INPUT TYPE="hidden" NAME="$_" VALUE=") . &CGI::param($_) . qq(">) if &CGI::param($_);
	}
    print qq(
			</td>
	       </tr>
	);

    my $i = 1;
    my $e1;
    my $e2;
    my $exonA;
    my $exonB;
    
    for (my $j=1; $j<=(scalar(@el)-1); $j++){
        $exonA = $el[$j-1];
        $exonB = $el[$j];
        

        ##########################################################################
        eval{
        if ($exonA->contig_id eq $exonB->contig_id){   # exons are on the same contig...
            if($exonA->strand == 1){
            # ...on the forward strand
                $e1 = $exonA->entire_seq()->trunc(($exonA->end)-$cut,($exonA->end)+$cut)->seq();
                $e2 = $exonB->entire_seq()->trunc(($exonB->start)-$cut,($exonB->start)+$cut)->seq();
            }
            else{
            # ...on the reverse strand
                $e1 = $exonA->entire_seq()->trunc(($exonA->start)-$cut,($exonA->start)+$cut)->revcom->seq();
                $e2 = $exonB->entire_seq()->trunc(($exonB->end)-$cut,($exonB->end)+$cut)->revcom->seq();
            }
        }
        else {                                          # exons are on different contigs... 
            if($exonA->strand == $exonB->strand){
            	# exons are on the same strand...
            	if($exonA->strand == 1){
            	# the forward strand
                    $e1 = $exonA->entire_seq()->trunc(($exonA->end)-$cut,($exonA->end)+$cut)->seq();
                	$e2 = $exonB->entire_seq()->trunc(($exonB->start)-$cut,($exonB->start)+$cut)->seq();
            	}
            	else{
            	# the reverse strand
                    $e1 = $exonA->entire_seq()->trunc(($exonA->start)-$cut,($exonA->start)+$cut)->revcom->seq();
                	$e2 = $exonB->entire_seq()->trunc(($exonB->end)-$cut,($exonB->end)+$cut)->revcom->seq();
            	}
            }
            else{
                # exons are on different strands...
            	if($exonA->strand == 1 && $exonB->strand == -1){
                	#print "1 ==&gt; -1<BR>";
                    $e1 = $exonA->entire_seq()->trunc(($exonA->end)-$cut,($exonA->end)+$cut)->seq();
                	$e2 = $exonB->entire_seq()->trunc(($exonB->end)-$cut,($exonB->end)+$cut)->revcom->seq();
            	}
            	if($exonA->strand == -1 && $exonB->strand == 1){
                	#print "-1 ==&gt; 1<BR>";
                    $e1 = $exonA->entire_seq()->trunc(($exonA->start)-$cut,($exonA->start)+$cut)->revcom->seq();
                	$e2 = $exonB->entire_seq()->trunc(($exonB->start)-$cut,($exonB->start)+$cut)->seq();
            	}
            }
        }


        }; # end of eval

        if($@){
        	print "<tr><td align=\"center\">$i</td><td align=\"right\">".$exonA->id."</td><td align=\"center\"><font color=\"red\">Coordinate Error!</font></td><td>".$exonB->id."</td></tr>";
        	$i++;
            next;
        }
        ################################################################################

        #my $cut2 = $cut-1;
        my $cut2 = 40;
        $e1 =~ s/^(.*)(\w{$cut})$/$1<FONT CLASS="red1">$2<\/FONT>/;
        $e2 =~ s/^(\w{$cut})(.*)$/<FONT CLASS="red1">$1<\/FONT>$2/;




        print qq(<tr><td align="center">$i</td><td align="right">) ,
				$exonA->id,
				qq(</td><td align="center"><FONT FACE="courier">...$e1<FONT CLASS="red1">------</FONT>$e2...</FONT></td><td>) ,
				$exonB->id,
				qq(</td></tr>\n);
        $i++;
    }

    print qq(<tr><td align="right" colspan="4">&nbsp</td></tr>);
    print qq(<tr><td align="right" colspan="4"><I><b><small>Intron sequence shown in <font color="#a00000">red</font></small></b></I></td></tr>);
    print "</TABLE>\n";

    }

    print qq(<hr noshade size="1">\n);

} # end of sub

#"####################################################################
sub print_transcript_report {

    my ($sa,$gene, $db, $sscon,$transid) = @_;
    
    my $name = $gene->id;
    my @trans = $gene->each_Transcript();
    
    #my $transid = $q->param('transcript');
    
    if($transid ne ""){ # do we restrict display only one transcript?
        my @temp =();
        foreach my $trans (@trans) {
            if($transid eq $trans->id){
                push(@temp, $trans);
                last;
        }
        }
    }
    
    my $trans_len = 0;
    
    print qq(<TABLE ALIGN="CENTER" BGCOLOR="#ffffff" WIDTH="100%" BORDER="0" CELLPADDING="3" CELLSPACING="0">);

    my $i=1;

    foreach my $trans ( @trans ) {
        my @e = $trans->each_Exon;
        my $num_exons = scalar(@e);
        my $tr_len = length($trans->translate->seq);

        print "<TR align=\"left\" class=\"yellow2\"><TH colspan=\"3\"><font color=\"#000000\"><A NAME=\"$i\">Transcript $i</A>: ",$trans->id(),"</font></TH>";
         print "<TR valign=\"top\" class=\"yellow1\">";
         print "<TD>";
         print "<B>Predicted Spliced Sequence</B>"; 
         print "</TD>";       
         print "<TD align=\"center\">\n";
         print "<B>Exon Information</B>";
         print "</TD>";       
         print "<TD align=\"center\">";
         print "<B>Exon Structure</B>";
         print "</TD>";       
        print "</TR>";


        print "<TR valign=\"top\">";
         print "<TD>";
         &print_fasta($trans); 
         print "</TD>";       
 
         print "<TD align=\"center\">\n";
         print "<BR><B>Total Length:</B> ",($tr_len * 3)," bp<BR>";
         print "<B>No. Exons:</B> $num_exons<BR>";
         print "</TD>";
 
         print "<TD align=\"center\"><BR>";
         $num_exons > 1 ? &print_transcript_image2($sa,$trans,$name) : print "Single exon" ;

		my $tid = $trans->id();
#		print qq(
#				<BR><FORM method="GET" action="/perl/transview">
#				<INPUT TYPE="hidden" name="gene" VALUE="$name">
#				<INPUT TYPE="hidden" name="transcript" VALUE="$tid">
#				<center><INPUT class="red2" TYPE="submit" VALUE="View Evidence"></center>
#				</form><BR>
#		);
		print qq(
				<BR><FORM method="GET" action="/perl/protview">
				<INPUT TYPE="hidden" name="peptide" VALUE="$tid">
				<center><INPUT class="red2" TYPE="submit" VALUE="View Protein"></center>
				</form><BR>
		);

        print "</TD>";
        print "</TR>";        
        
        print "<TR><TD colspan=\"3\">";
        &print_exon_list($sa,$trans, $db, $sscon);
        print "&nbsp\n";
        print "</TD></TR>";

    $i++;   
    }
        
        print "</TABLE>\n";
}
#"####################################################################
sub print_pepstats {

    my ($peptide, $flag) = @_;
    my $html = "";
    my $PEPSTATS = "$SiteDefs::EMBOSSBIN/pepstats";
    open (OUT, "echo '$peptide' | $PEPSTATS -filter 2>&1 |");
    my @lines = <OUT>;
    close(OUT);
    
    #Molecular weight = 3224.53              Residues = 30  
    #Average Residue Weight  = 107.484       Charge   = -1.5  
    #Isoelectric Point = 4.4939  
    
    if ($flag == 1){                         # give back full results.....
        return (@lines);
    }

    else{                               # give back summary results....
        foreach my $line (@lines){
        
            if($line =~ /^Molecular(\s+)(\S+)(\s+)=(\s+)(\S+)(\s+)(\S+)(\s+)=(\s+)(\S+)/){
                $html = "<B>MW:</B> $5<BR>\n";
            }
            if($line =~ /^Average(\s+)(\S+)(\s+)(\S+)(\s+)=(\s+)(\S+)(\s+)(\S+)(\s+)=(\s+)(\S+)/){
                $html .= "<B>Avg. Res. Wt.:</B> $7<BR> <B>Charge:</B> $12<BR>\n";
            }
            if($line =~ /^Isoelectric(\s+)(\S+)(\s+)=(\s+)(\S+)/){
                $html .= "<B>pI:</B> $5<BR>\n";
            }
            if ($line =~ /FATAL/){
                # pepstats failed
                print STDERR "pepstats: $line\n";
                $html = "Error getting peptide statistics<BR>\n";
                return $html;
            }
        }
        return $html;
    }
    
}
#####################################################################
# Lots of hassle to
# convert protein strings to HTML string but still treat them as non-
# substituted protein strings.
#####################################################################
sub print_fasta {

    my ($trans) = @_;
    my $flip = 0;
    my $fasta = $trans->dna_seq()->seq();
    my $dna2 = "";
    my $c = 0;
    my $wrap = 60;

	if(0){
    	my @exons = $trans->each_Exon;

    	if(scalar(@exons) > 1){  # only highlite exons if we have more than one!

        	foreach my $t (@exons){
            	my $subseq = $t->translate()->seq();
            	if ($flip%2 == 0){
                	$fasta =~ s/(\Q$subseq\E)/<font class="red1">$1<\/font>/;
            	}
            	else{
                	$fasta =~ s/(\Q$subseq\E)/<font color="#000070">$1<\/font>/;
            	}

            	$flip++;
        	}

        	my @dna = split('', $fasta);

        	while(@dna){
            	my $b = shift(@dna);
            	if ($b ne "<"){ 
                	$dna2 .= $b;
                	$c++;
                	if ($c == ($wrap-1)){
                	   $dna2 .= "<BR>";
                	   $c = 0; 
                	}
            	}
            	else{
                	$dna2 .= $b;
                	while ($b ne ">"){
                	   $b = shift(@dna);
                	   $dna2 .= $b;
                	}
            	}

        	} 
        
        	print "<BR><font face=\"courier\"><small>";
        	print "&gt;".$trans->id."<BR>$dna2";
        	print "</small></font>";
    	}
	} else{    
    	$fasta =~ s/(\w{$wrap})/$1<BR>/g;    
        print "<BR><font face=\"courier\"><small>";
        print "&gt;".$trans->id."<BR>$fasta";
        print "</small></font>";
    }
    
    #print qq(<BR><BR><b>[<i>Exons are shown in alternating colours</i>]</b>); 
}

#####################################################################
sub print_clone_list {

    my $sa = shift;
    my $id = shift;
    my $focus = shift;
    my @clones = @_;
    foreach my $clone (@clones) {
    	if ($sa->is_golden_static_clone($clone)){
			if ($id eq ""){
            		print qq(<a href="/perl/contigview?clone=$clone">$clone</a>&nbsp;\n);
        	} else{
            	print qq(<a href="/perl/contigview?clone=$clone&geneid=$id&contig=$focus">$clone</a>&nbsp;\n);
        	}
    	}
    	else {
			print "$clone ";
    	}
    }
}

#"####################################################################
sub print_transcript_list {

    my ($gene) = @_;
    
print<<EOL;
<p>
The following transcripts belong to this gene. Each transcript is 
supported by a number of different pieces of supporting evidence. 
</p>
EOL
    my $i =1;
    my $tid;
    my $gid = $gene->id();
    foreach my $trans ( $gene->each_Transcript ) {
        $tid = $trans->id();
        print qq(<b>Transcript $i:</b> $tid [<a href="/perl/transview?gene=$gid&transcript=$tid">Supporting Evidence</a>]\n<BR>\n);
        $i++;
    }
    print "<BR>\n";
}

#####################################################################
sub print_transcript_image {

    my ($sa,$trans,$geneid) = @_;
	
	my $gvc = $sa->fetch_VirtualContig_of_gene($geneid);
	my $Config      = new WebUserConfig($q, 'geneview');
	$Config->container_width($gvc->length());
	my $dc = Bio::EnsEMBL::DrawableContainer->new("geneview", $gvc, $Config);

    my $image = $dc->render($img_type);
	my $imagemap = "";

	my $filename = &Digest::MD5::md5_hex(rand());
	$filename .= ".geneview.$img_type";
	my $TMP = "${ENSEMBL_SERVERROOT}/htdocs/gfx/image_tmp";
	open(IMG_OUT, qq(>$TMP/$filename)) || die qq(cannot open temporary image file $TMP/$filename: $!\n);
	binmode IMG_OUT;
	print IMG_OUT $image;
	close(IMG_OUT);

	print qq(<center>);
	print qq(<img border="0" src="/gfx/image_tmp/$filename" usemap="#geneview"><BR><BR>\n);
	print qq([<A target="new" href="http://dev.ensembl.org/perl/config?script=geneview">Configure this image</A>]<BR><BR>);
	print qq(</center>);
	print qq(<map name="geneview">\n$imagemap</map>\n);

}

#####################################################################
sub print_transcript_image2 {

    my ($sa,$trans,$geneid) = @_;
    
    my $transid = $trans->id;
    
    my $vc = $sa->fetch_VirtualContig_of_gene($geneid,100);

    ######################################################################
    # This is dumb - need to get the transcript obj again, but from a VC,
    # so the coordinate system is correct
    ######################################################################
    my @geneids = ($geneid);
    my @genes=$vc->get_Genes(@geneids);

    foreach my $vc_gene(@genes){
	if ($vc_gene->id eq $geneid) {
	    foreach  my $vc_trans ( $vc_gene->each_Transcript){
			if ($vc_trans->id eq $transid){
		    	$trans=$vc_trans;  
		    	last;
			}
	    }
	    last;
	}
    }
	    
    # draw transcript
    my $image_param={
        x_img_len=>200,
        y_img_len=>100,
        left_margin=>10,
        right_margin=>10,
        top_margin=>10,
        bottom_margin=>50, 
    };
    my $outpath = "$ENSEMBL_SERVERROOT/htdocs/gfx/gene/$transid.$img_type";
    print  qq(<MAP Name="$transid">\n);
    
    my $trans_im=Transcript->new($trans,$image_param);
    $trans_im->intron_height(2);
    $trans_im->exon_height(30);
    $trans_im->draw_transcript;
    my $gif=$trans_im->get_GIF(\*STDOUT) or print STDERR "No image from Transcript->get_GIF\n";
    # draw GIF
    if (! -s $outpath){
        open(GIF,">$outpath") or die "Cannot write transcript GIF image $outpath\n";
        print GIF $gif or die "Cannot write transcript image $outpath\n";
        close(GIF);
    }
    #else{
        #print STDERR "Using cached transcript image $transid.gif\n";
    #}
    print qq(</map>\n);
    print qq(<img align="middle" alt="Exon structure for transcript $transid" src="/gfx/gene/$transid.$img_type" usemap="#$transid" border="0"><br><br>\n);

}



#####################################################################
sub print_gene_image {

    my ($geneid, $gene) = @_;
    
    print  "<MAP Name=\"$geneid\">\n";
    my $image_param_ref=&Parameters::gene_image_par;
    my $im=new GD::Image($image_param_ref->{x_img_len},$image_param_ref->{y_img_len});
    &SeqContigDraw::draw_gene($im,$gene);
    my $outpath = "$ENSEMBL_SERVERROOT/htdocs/gfx/gene/$geneid.$img_type";
    open(GIF,">$outpath") or print STDERR "Can't open $outpath:$!\n";
    if ($img_type eq 'gif') {     #GD::Image->can("gif")
		print GIF $im->gif;
    }
    else {
		print GIF $im->png or print STDERR "can't print to $outpath:$!\n";
    }
    close(GIF);
    print "</map>\n";
    print "<img src=\"/gfx/gene/$geneid.$img_type\""," usemap=\"#gene\"","border=\"0\"", "><br><br>","\n";

}

#####################################################################
sub db_connect {

    my ($geneid) = @_;
    my $db = undef;
    # wrap all the db manipulation in an eval.
    eval {
        my $locator = &EnsWeb::get_locator();
        $db =  Bio::EnsEMBL::DBLoader->new($locator);
		$db->static_golden_path_type($ENSEMBL_GOLD);
    };
    if( $@ ) { 
        print &ensembl_exception("Sorry, the Ensembl database is currently unavailable.",$@);
		&ensembl_exit();
    }
    else{
        return ($db);
    }
}

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

sub get_known_gene {

    my ($name) = @_;
    my $db;
    my @genes = undef;
    eval {
        $db = &db_connect($name);
        @genes = $db->gene_Obj->get_Gene_by_DBLink($name);
    };
    if($@){
        print &ensembl_exception("Error retrieving genes from database",$@);
		&ensembl_exit();
    }
    if ($genes[0]){
        my $g = $genes[0]->id;
        $q->redirect("/perl/geneview?gene=$g");
        Apache::exit;   
    }
    else {  # we couldn't find the named gene....
		print CGI::header();
		print EnsWeb::make_cgi_header(('initfocus'=>1));
        print &ensembl_exception("<P>No gene named $name was found in the ensembl database.<P>");
		&ensembl_exit();
    }
}

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

1;
