#!/usr/local/bin/perl 

package snpview;

use SiteDefs;
use EnsWeb;
use ExtURL;

use CGI qw/:standard :form :netscape3/;
use strict;
use Bio::Annotation::DBLink; 
use Bio::EnsEMBL::DB::ExternalFeatureFactoryI; 
use Bio::EnsEMBL::ExternalData::SNPSQL::DBAdapter;
use Bio::EnsEMBL::ExternalData::Variation;
 
my $q = new CGI;

my $snp = $q->param('snp');
my $cloneid = $q->param('seqentry');

$cloneid =~ s/\s//g;
$snp  =~ s/\s//g;

my $contigid;
my @contiglist = (); 
my @clonelist = (); 

my $r = Apache->request();
print header();
$r->err_header_out('ensembl_headers_out'=>1);
print EnsWeb::make_cgi_header(('initfocus'=>1));
print EnsWeb::print_form($snp, "snp");


if (defined $snp){      
    &display_snp_info($snp);
    print EnsWeb::make_cgi_footer();
    &ensembl_exit();
}
elsif (defined $snp && defined $cloneid){

    if ($cloneid =~ /\|/){
        @clonelist = split(/\|/, $cloneid);
        @contiglist = @clonelist;
        foreach (@clonelist){
            s/(.*)\..*/$1/;
        }
    }
    elsif ($cloneid =~ /\./){
        $cloneid =~  s/(.*)\..*/$1/;
        push(@clonelist, $cloneid);
    }
    else{
        push(@clonelist, $cloneid);
    }

    &display_clone_snp_info($snp, @clonelist);
}
else {
    print ensembl_exception("Need to supply a snp name as arguments!","",1);
    &ensembl_exit();

}
                            


1;


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

sub display_snp_info {

    my $id = shift;
    $id =~ s/TSC:://i;
    my $name = "$id";
    my @clonelist = @_;
    my $snpdb;
    my $db;
    my $snp;

    eval {

	my $locator = &EnsWeb::get_locator();
	$db =  Bio::EnsEMBL::DBLoader->new($locator);
	$snpdb = Bio::EnsEMBL::ExternalData::SNPSQL::DBAdapter->new(    
						-dbname => $ENSEMBL_SNP,
						-user   => $ENSEMBL_DBUSER,
						-host   => $ENSEMBL_HOST,
                                                -port   => $ENSEMBL_HOST_PORT,
						 );
	$db->add_ExternalFeatureFactory($snpdb);
	$db->static_golden_path_type('UCSC');
    };
	 
    if( $@ ) {
	print ensembl_exception("Error in Ensembl database.",$@);
	&ensembl_exit();
    }

    my @snp;

    eval {
	@snp = $snpdb->get_SeqFeature_by_id($name);
    };

    if( $@ ) {
	print ensembl_exception("SNP $id is either not in the Ensembl database or is not mapped to a clone.",$@,1);
	&ensembl_exit();
    }
    
    print "<h3>Ensembl SNP Data: $id</h3>";

    print_snp_summary($snp[0],$id,$db);
    print qq(<p><B>SNP "$id" is currently mapped to the following clone(s):</B> <p>);

    print_snp_info(\@snp,$id,$db);
}



sub print_snp_summary {
    my ($snp,$id,$db)=@_;
        
    my $sid	= $snp->id;
    my $source  = $snp->{'_source_tag'};
    my $score   = $snp->{'_gsf_score'};
    my $status	= $snp->status;
    my $dss	= uc($snp->dnStreamSeq);
    my $uss	= uc($snp->upStreamSeq);
    my $alleles = $snp->alleles;
    my $urls    = ExtURL->new;
    $dss   ||= "unavailable";
    $uss   ||= "unavailable";


    my %ambig = (
	     'A|C'     => "M",
	     'T|G'     => "M",
	     'A|C|G|T' => "N",
	     'T|G|C|A' => "N",
	     'A|G'     => "R",
	     'T|C'     => "R",
	     'A|T'     => "W",
	     'T|A'     => "W",
	     'C|G|T'   => "B",
	     'G|C|A'   => "B",
	     'G|T'     => "K",
	     'C|A'     => "K",
	     'A|C|G'   => "V",
	     'T|G|C'   => "V",
	     'A|C|T'   => "H",
	     'T|G|A'   => "H",
	     'A|G|T'   => "D",
	     'T|C|A'   => "D",
	     'C|G'     => "S",
	     'G|C'     => "S",
	     'C|T'     => "Y",
	     'G|A'     => "Y",
    );
    
    my %SNPLINK = ();

    foreach my $link ($snp->each_DBLink){
	
	my $l = $link->primary_id();
	my $d = $link->database();
	
	if ($d =~ /tsc/i){
	    $SNPLINK{'TSC'} = qq(<A HREF=").$urls->get_url('TSC',$l).qq(">$l</A><BR>);    
	}
	if ($d =~ /dbsnp/i){
	    $SNPLINK{'DBSNP'} = qq(<A HREF=").$urls->get_url('SNP',$l).qq(">$l</A><BR>);    
	}
	$SNPLINK{'DBSNP'} ||= "unavailable";
	$SNPLINK{'TSC'}   ||= "unavailable";
    };
    
    print qq(<TABLE ALIGN="CENTER" class="yellow1" width="100%" BORDER="1" CELLPADDING="3" CELLSPACING="0">);
    print qq(<TR class="yellow2">\n);
    print "<th colspan =\"2\">$id Summary Data</th>\n";
    print "</TR>\n";

    print "<TR>\n";
    print "<td>Source</td><td>$source</td>\n";
    print "</TR>\n";

    print "<TR>\n";
    print "<td>TSC Accn. No.</td><td>$SNPLINK{'TSC'}</td>\n";
    print "</TR>\n";

    print "<TR>\n";
    print "<td>dbSNP Accn. No.</td><td>$SNPLINK{'DBSNP'}</td>\n";
    print "</TR>\n";

    print "<TR>\n";
    print "<td>Score</td><td>$score</td>\n";
    print "</TR>\n";

    if ($status =~ /confirmed/i){
	print "<TR>\n";
	print "<td>Status</td><td><i>$status</i> (SNP tested and observed in a sample population)</td>\n";
	print "</TR>\n";
    } elsif ($status =~ /suspected/i){
	print "<TR>\n";
	print "<td>Status</td><td> <i>$status</i> (SNP arising directly from SNP detection assays)</td>\n";
	print "</TR>\n";
    } else{
	print "<td>Status: unknown</td><td>&nbsp;</td>\n";
    }

    if ($snp->{'position_problem'}){
	print "<TR>\n";
	print "<td>Additional status information</td><td><i>$snp->{'position_problem'}</I></td>\n";
	print "</TR>\n";
    }

    print "<TR>\n";
    print "<td>Alleles</td><td>$alleles (ambiguity code: <B><font color=\"red\">$ambig{$alleles}</font></b>)</td>\n";
    print "</TR>\n";

    print "<TR>\n";
    print "<td>Sequence Region (SNP highlighted)</td><td>$uss<B><font color=\"red\">$ambig{$alleles}</font></B>$dss</td>\n";
    print "</TR>\n";
    print("</TABLE><BR clear=\"left\">\n");
}

sub print_snp_info {
    my ($snpref,$id,$db)=@_;
    my @clonelist;
    my @snp = @$snpref;
    my $urls = ExtURL->new;
    foreach my $snp(@snp){ 
	my $sid = $snp->id;

	my $start   = $snp->start;
	$start ||= "unavailable";

	my ($clonename,$sv) = split(/\./,$snp->seqname);

	my $length;
	my $con;
	my $contig;
	my $c;

	my $sa=$db->get_StaticGoldenPathAdaptor();

	eval{
	    $c = $db->get_Clone($clonename);
	};
	if ($@){
	    my $temphash={
			'clonelink' => $clonename,
			'sv'	    => $sv,
			'contiglink'=> "unknown",
			'length'    => "-",
			'start'	    => $start,
			'dumplink'  => "Not available",
			'srslink'   => qq(<A HREF=").$urls->get_url('EMBL',$clonename).qq(">$clonename</a>),
		    };
	
	    push (@clonelist, $temphash);
	}
	elsif ($start ne "unavailable") {
	    $con = $c->get_rawcontig_by_position($start);
	    $length = $con->length; 
	    $contig = $con->id;
	    my $clonelink = qq(<a href="/perl/contigview?clone=$clonename">$clonename</A>);   
	    my $contiglink = qq(<a href="/perl/contigview?clone=$clonename&contig=$contig">$contig</A>);
	    my $dumplink_clone = qq([<a href="/perl/dumpcfgview?type=clone&id=$clonename">Clone</a>);
	    my $dumplink_contig = qq(<a href="/perl/dumpcfgview?type=contig&id=$contig">Contig</a>]); 
	    
	    if (!$sa->is_golden_static_clone($clonename)){
		$clonelink = $clonename;
		$dumplink_clone = "[Clone";
	    }
	    if (!$sa->is_golden_static_contig($contig)){
		$contiglink = $contig;
		$dumplink_contig = "Contig]";
	    }
	    
	    my $dumplink = "$dumplink_clone | $dumplink_contig";
	    
	    my $temphash={
			'clonelink' => $clonelink, 
			'sv'	    => $sv,
			'contiglink'=> $contiglink,
			'length'    => $length,
			'start'	    => $start,
			'dumplink'  => $dumplink,
			'srslink'   => qq(<A HREF=").$urls->get_url('EMBL',$clonename).qq(">$clonename</a>),
		    };
	
	    push (@clonelist, $temphash);
	}
    }
    if (@clonelist){

	print qq(<TABLE ALIGN="CENTER" class="yellow1" WIDTH="100%" BORDER="1" CELLPADDING="3" CELLSPACING="0">);
	print qq(<TR class="yellow2">\n);
	print qq(<th>Ensembl Clone</th><th>SV</th><th>Contig Map</th><th>Total Length</th><th>Position in contig</h><th>Flatfile</th><th>EMBL Source</th>\n);
	print qq(</TR>\n);
    
	foreach my $snpref(@clonelist){
	    print qq(<TR>\n);
	    print qq(<td align="center">$snpref->{'clonelink'}</td>\n);
	    print qq(<td align="center">$snpref->{'sv'}&nbsp;</td>\n);
	    print qq(<td align="center">$snpref->{'contiglink'}</td>\n);
	    print qq(<td align="center">$snpref->{'length'}</td>\n);
	    print qq(<td align="center">$snpref->{'start'}</td>\n);
	    print qq(<td align="center">$snpref->{'dumplink'}</td>\n);
	    print qq(<td align="center">$snpref->{'srslink'}</td>\n);
	    print qq(</tr>\n);
	}

	print("</TABLE><BR>\n");
    } else{

	print <<EOS;
	<p>
	<B>SNP "$id" has no mapping information available.</B>
	<p>
EOS
    }


}
###############################################################################
1;
