#!/usr/bin/perl -w

###################################################################
# Non-modperl users should change this variable if needed to point
# to the directory in which the configuration files are stored.
#
$CONF_DIR  = '/bio/argos/gmod/in01/conf/gbrowse.conf';
#
###################################################################
$VERSION   = 1.67;

use lib '/bio/argos/gmod/in01/lib';

# $Id: gbrowse_est.PLS,v 1.6 2004/08/09 14:46:18 sheldon_mckay Exp $

=head1 NAME

gbrowse_est -- a Gbrowse accessory that retrieves EST sequences from Alignment (Target) features.

=head1 AUTHOR

Please report all bugs to Mark Wilkinson (markw at illuminae.com)

=head1 SYNOPSIS

In 0X.organism.conf:

 [alignment:DETAILS]
 URL = http://yoursite.com/cgi-bin/gbrowse_est?id=$value


=head1 DESCRIPTION

Alignment features may be stored in Gbrowse using one of the following GFF
styles

 Gbrowse GFF Style:
 Seqname BLASTN match 100  200  5   +   .   Target EST:a3255.abi  1  100

 GFF 2.5 Style:
 Seqname BLASTN match 100  200  5   +   .   Target EST:a3255.abi ; tstart 1 ; tend 100

In addition, the sequence of the aligned EST (in this case a3255.abi)
can also be stored in the database in order to view the gapped alignment
from a mouse-click on the alignment feature glyph.  It is not possible,
however, to see the original EST sequence.  

This script will accomplish that for you.  Set up an [alignment:DETAILS]
section in your config file that calls on this script with a single
parameter "id" set to the name of your est sequence and it will
retrieve it for you.  On the gbrowse_details screen A link appears next
to the Type: line, that will call on the link you have configured.
    
 Type:  alignment  (Aligned Sequence)
 
Click on 'Aligned Sequence' to view the original EST sequence.


=cut

use strict;
use CGI qw(:standard *table *TR escape);
use Bio::DB::GFF;
use Bio::Graphics::Browser;
use Bio::Graphics::Browser::Markup;
use Bio::Graphics::Browser::Util;
use Bio::Graphics::Browser::Realign 'align';
use vars qw($CONFIG $VERSION $CONF_DIR $LANG @COLORS $INDEX %strands %COLORS %URLS);

use constant DEBUG=>0;

@COLORS = qw(none lightgrey yellow pink orange brown
	     tan teal cyan lime green blue gray);

$CONF_DIR  = conf_dir($CONF_DIR);  # conf_dir() is exported from Util.pm
$CONFIG = open_config($CONF_DIR);  # open_config() is exported from Util.pm

$INDEX  = 0;
%COLORS = ();

my $name  = param('id');

$CONFIG->source(cookie('gbrowse_source'));

print_top("GBrowse EST Details: EST Sequence:$name");
print $CONFIG->header || h1("EST Sequence:$name Details");

my $db = open_database();
my $dbh = $db->dbh;
my $sth = $dbh->prepare("select fdna from fdna where fref=? order by foffset");
$sth->execute($name);
my $sequence;
while (my ($seq) = $sth->fetchrow_array){
    $seq =~ s/\W//g;
    $sequence .= $seq;
}
print print_sequence($name, $sequence);
# footer
print_bottom($VERSION);
exit 0;

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

sub print_sequence {
    my $name = shift;
    my $seq  = shift;
    my $string;
    $string .= start_table();
    my $options = '';
    $string .= PrintMultiple($options,'Name',b($name));
    $string .= PrintMultiple($options,,'Class','EST Sequence');
    $string .= PrintMultiple($options,"Length",length($seq));
    $string .= end_table();

    if ($seq) {
      my $dna = $seq;
      $string .= print_dna($name, "EST Sequence", $dna) if $dna;
    }

  $string;
}

sub print_dna {
  my ($name, $class,$dna) = @_;
  my $markup = Bio::Graphics::Browser::Markup->new;
  # add a newline every 80 positions
  $markup->add_style('newline',"\n");

  my @markup;
  push @markup,map {['newline',80*$_]} (1..length($dna)/80);
  $markup->markup(\$dna,\@markup);
  return pre(">$name class=$class length=".(length($dna))."\n".$dna);
}

sub PrintMultiple {
  local $^W = 0;  # get rid of uninit variable warnings

  my $options = shift;
  my $label   = shift;
  $options ||= {};
  my @a = @_;
  return unless @a;
  my $first = shift @a;
  my $LINK = "";
  if ($URLS{$label}){
        $LINK = $URLS{$label};
        $LINK =~ s/\$tag/$label/;
        $LINK=~ s/\$value/$first/;
        $LINK = "<a href='$LINK'>$first</a>";
  }

  my $string = join '',TR({-valign=>'top',-class=>'databody'},
                          th({-align=>'LEFT',-valign=>'top',-class=>'datatitle'},length $label>0 ? "$label: " : ''),
                          td($options, $LINK?$LINK:$first)
                         );
  for my $obj (@a) {
    $string .= join '', TR({-class=>'databody'},
			   th({-align=>'RIGHT',-class=>'datatitle'},'&nbsp;'),
			   td($options,$obj)
			  );
  }
  $string;
}