#!/usr/local/bin/perl -w

# $Id: qtl_display,v 1.76 2007/05/15 17:13:19 kclark Exp $

use strict;
use CGI;
use Carp qw( croak );
use Data::Dumper;
use Data::Pageset;
use Gramene::CDBI::Literature;
use Gramene::CDBI::Markers;
use Gramene::Config;
use Gramene::Marker::DB;
use Gramene::Page;
use Gramene::QTL::DB;
use Gramene::Utils qw( get_logger iterative_search_values pager );
use Readonly;
use Template;

use vars qw[ 
    @Trait_Categories 
    %Traits_By_Cat 
    @Species 
    @All_Species 
    %All_Species_Labels
    @Traits 
    %Trait_Labels 
];

Readonly my $ERROR_TEMPLATE     => 'qtl_error.tmpl';
Readonly my $SEARCH_TEMPLATE    => 'qtl_display.tmpl';
Readonly my $DETAIL_TEMPLATE    => 'qtl_detail.tmpl';
Readonly my %VALID_SEARCH_FIELD => (
    trait_name       => 1,
    trait_symbol     => 1,
    trait_category   => 1,
    chromosome       => 1,
    linkage_group    => 1,
    published_symbol => 1,
    to_accession     => 1,
    qtl_accession_id => 1,
);

Readonly my %ORDER_BY_TO_REAL => (
    qtl_accession_id => 'qtl_accession_id',
    published_symbol => 'published_symbol, linkage_group, qtl_accession_id',
    chromosome       => 'chromosome, trait_name, qtl_accession_id',
    linkage_group    => 'linkage_group, trait_name, qtl_accession_id',
    trait_symbol     => 'trait_symbol, linkage_group, qtl_accession_id',
    trait_name       => 'trait_name, linkage_group, qtl_accession_id',
    trait_category   => 'trait_category, trait_name, '.
                        'linkage_group, qtl_accession_id',
    species          => 'species, trait_name',
);

my $q      = CGI->new;
my $logger = get_logger;
my $page   = Gramene::Page->new( Apache->request );
my ( $template, $html, $dbh, $table_only );

eval {
    my $order_by         = $q->param('order_by')     || '';
       $order_by         = $ORDER_BY_TO_REAL{ $order_by } || $order_by;
    my $limit_start      = $q->param('limit_start')  ||  0;
    my $page_no          = $q->param('page_no')      ||  1;
       $table_only       = $q->param('table')        ||  0;
    my $query            = $q->param('query')        || '';
    my $search_field     = $q->param('search_field') || '';
    my $species          = $q->param('species')      || '';
    my $submit           = $q->param('submit')       || '';
    my $qtl_id           = $q->param('qtl_id')       || '';
    my $qtl_accession_id = $q->param('qtl_accession_id') || '';
    my %vars             = $q->Vars;
    my $show_results     = $q->param('submit') 
         ? 1
         : $q->param('trait_category') && scalar keys %vars == 1;
    my $config           = Gramene::Config->new;
    my $qtl_config       = $config->get( 'qtl' ) or die 'No QTL config info';
    my $qdb              = Gramene::QTL::DB->new;
    $dbh                 = $qdb->db or die $qdb->error;

    #
    # Cache the species, traits, and trait categories.  Only select records 
    # linked to at least one QTL.
    #
    unless ( @Species ) {
        @Species = @{
            $dbh->selectall_arrayref(
                q[
                    select   species, common_name, 
                             gramene_taxonomy_id, ncbi_taxonomy_id
                    from     species 
                    order by display_order, species
                ],
                { Columns => {} }
            )
        };
        @All_Species        = map { $_->{'species'} } @Species;
        %All_Species_Labels = map { 
            sprintf( '%s%s',
                $_->{'species'},
                $_->{'common_name'} ? " ($_->{'common_name'})" : ''
            )
        } @Species;
    }

    unless ( @Traits ) {
        my $traits = $dbh->selectall_arrayref(
            q[
                select trait_name, trait_symbol, to_accession 
                from qtl_trait 
                order by 1
            ],
            { Columns => {} }
        );
        @Traits       = map { $_->{'trait_symbol'} } @$traits;
        %Trait_Labels = map { 
            $_->{'trait_symbol'}, "$_->{'trait_name'} ($_->{'trait_symbol'})" 
        } @$traits;
    }

    unless ( @Trait_Categories ) {
        my $traits = $dbh->selectall_arrayref(
            q[
                select   count(t.qtl_trait_id) as no_qtl,
                         c.trait_category,
                         t.trait_name,
                         t.trait_symbol,
                         t.to_accession
                from     qtl_trait t,
                         qtl_trait_category c,
                         qtl q
                where    q.qtl_trait_id=t.qtl_trait_id
                and      t.qtl_trait_category_id=c.qtl_trait_category_id
                group by c.trait_category,
                         t.trait_name,
                         t.trait_symbol,
                         t.to_accession
            ],
            { Columns => {} },
        );

        #
        # Group the traits by category.
        #
        my %categories;
        for my $trait ( @$traits ) {
            push @{ $categories{ $trait->{'trait_category'} } }, $trait;
        }

        #
        # Sort out just the category names.
        #
        @Trait_Categories = sort keys %categories;

        #
        # Sort all the traits for each category by their name.
        #
        for my $category ( @Trait_Categories ) {
            $Traits_By_Cat{ uc $category } = [
                sort { lc $a->{'trait_name'} cmp lc $b->{'trait_name'} }
                @{ $categories{ $category } }
            ];
        }
    }

    $template            = Template->new(
        INCLUDE_PATH     => [
            $qtl_config->{'template_dir'},
            "$qtl_config->{'template_dir'}/../common",
        ],
        WRAPPER          => 'wrapper.tmpl',
        VARIABLES        => {
            gramene_page       => $page,
            cgi                => $q,
            all_traits         => \@Traits,
            all_trait_labels   => \%Trait_Labels,
            trait_categories   => \@Trait_Categories,
            all_species        => \@All_Species,
            all_species_labels => \%All_Species_Labels,
            cmap_datasource    => $qtl_config->{'cmap_datasource'},
        }
    );

    if ( $qtl_accession_id || $qtl_id ) {
        my $sql = sprintf q[
                select q.qtl_id,
                       q.qtl_accession_id,
                       q.published_symbol,
                       q.linkage_group,
                       q.chromosome,
                       q.start_position,
                       q.stop_position,
                       s.species,
                       s.common_name as species_common_name,
                       s.gramene_taxonomy_id,
                       s.ncbi_taxonomy_id,
                       q.comments,
                       qt.qtl_trait_id,
                       qt.trait_symbol,
                       qt.trait_name,
                       qt.to_accession,
                       qtc.trait_category
                from   qtl q, 
                       qtl_trait qt, 
                       species s,
                       qtl_trait_category qtc
                where  q.%s=?
                and    q.qtl_trait_id=qt.qtl_trait_id
                and    q.species_id=s.species_id 
                and    qt.qtl_trait_category_id=qtc.qtl_trait_category_id 
            ],
            $qtl_id ? 'qtl_id' : 'qtl_accession_id'
        ;
        my $sth = $dbh->prepare( $sql );
        $sth->execute( $qtl_id || $qtl_accession_id ) ;
        my $qtl = $sth->fetchrow_hashref or die "Can't find that QTL\n";

        #
        # Get trait synonyms
        #
        $qtl->{'trait_synonyms'} = $dbh->selectcol_arrayref(
            q[
                select   trait_synonym
                from     qtl_trait_synonym
                where    qtl_trait_id=?
                order by trait_synonym
            ],
            {},
            ( $qtl->{'qtl_trait_id'} )
        );

        #
        # Get the QTL's xrefs
        #
        my $xrefs = $qdb->get_xrefs( qtl_id => $qtl->{'qtl_id'} );

        #
        # Process any existing xref templates
        #
        for my $xref ( @$xrefs ) {
            my $url_template = $xref->{'url_template'} or next;
            my $url          = sprintf $url_template, $xref->{'xref_value'};
            my $url_text     = '';

            # Expand Gramene lit references
            if ( $xref->{'xref_type'} eq 'Gramene Literature' ) {
                my $lit_id = $xref->{'xref_value'};
                my $lit_ref = Gramene::CDBI::Literature::Reference->retrieve(
                    $lit_id
                );

                if ( $lit_ref ) {
                    my @re = $lit_ref->reference_extras;
                    $url_text = join( ', ',
                        $re[0]->author,
                        '<em>' . $lit_ref->title . '</em>',
                        '<u>' . $lit_ref->source->source_name . '</u>',
                        $lit_ref->volume,
                        $lit_ref->year,
                        'pp. ' . $lit_ref->start_page . '-' . $lit_ref->end_page
                    );

                    my $div_db    = Gramene::DB->new('diversity_rice');
                    my $div_xrefs = $div_db->selectall_arrayref(
                        q[  
                            select xt.xref_type,
                                   xt.url_template,
                                   x.record_id,
                                   e.name
                            from   xref x, xref_type xt, div_experiment e
                            where  x.table_name=?
                            and    x.xref_value=?
                            and    x.xref_type_id=xt.xref_type_id
                            and    xt.xref_type like 'Gramene Lit%'
                            and    x.record_id=e.div_experiment_id
                        ],
                        { Columns => {} },
                        ( 'div_experiment', $lit_id )
                    );

                    for my $div_xref ( @$div_xrefs ) {
                        push @{ $qtl->{'xrefs'} }, {
                            name     => 'Genetic Diversity Experiment',
                            value    => $div_xref->{'name'},
                            url      => '/db/diversity/diversity_view'
                                     .  '?action=view&object=div_experiment'
                                     .  '&id=' . $div_xref->{'record_id'},
                        };
                    }
                }
                else {
                    $url_text = "Bad Gramene literature reference id ($lit_id)";
                }
            }

            #
            # Add them to any other xrefs for the QTL
            #
            push @{ $qtl->{'xrefs'} }, {
                name     => $xref->{'xref_type'},
                value    => $xref->{'xref_value'},
                url      => $url,
                url_text => $url_text,
            };
        }

        my $ont_assoc = $qdb->get_qtl_ontology_associations(
            qtl_id => $qtl->{'qtl_id'} 
        );

        for my $oa ( @$ont_assoc ) {
            ($oa->{'ontology_term'}) = Gramene::CDBI::Ontology::Term->search(
                term_accession => $oa->{'term_accession'}
            );
    
            ( my $tt = lc $oa->{'term_type'} ) =~ s/ /_/g;
            push @{ $qtl->{'ontology_associations'}{ $tt } }, $oa;
        }

        #
        # Add mappings from mappings db
        #
        my $mdb = Gramene::Marker::DB->new;

        my @markers = $mdb->marker_search( 
            marker_name => $qtl->{'qtl_accession_id'},
            marker_type => 'QTL',
        );

        if ( @markers == 1 ) {
            my $marker_id = $markers[0]->{'marker_id'};

            $qtl->{'mappings'} = [
                sort { $b->{'is_primary'} <=> $a->{'is_primary'} }
                map  {
                    $_->{'is_primary'} =
                      $_->{'cmap_feature_accession'} eq $qtl_accession_id
                      ? 1 : 0;
                    $_;
                }
                $mdb->get_marker_mappings( marker_id => $marker_id )
            ];

            $qtl->{'qtl_marker_id'} = $marker_id;
            $qtl->{'associated_markers'} = $mdb->get_marker_correspondences(
                marker_id => $marker_id
            );
        }
        else {
            $qtl->{'mappings'} = [];
        }

        $q->param( query        => $qtl_accession_id  );
        $q->param( search_field => 'qtl_accession_id' );

        $template->process( 
            $DETAIL_TEMPLATE,
            {
                qtl     => $qtl,
                species => \@Species,
            },
            \$html
        ) or $html = $template->error;
    } 
    # ----------------------------------------------------------------
    #
    # Show search field, optionally show search results.
    #
    else {
        my $orig_query = $query;
        $query         =~ s/\*/%/g;
        $query         = '%' if $show_results && !$query;
        $search_field  = '' unless exists $VALID_SEARCH_FIELD{ $search_field };

        #
        # Reset Apache::Request with changed values (if any)
        #
        $q->param( query        => $query        );
        $q->param( search_field => $search_field );

        my $action = $q->param('action')         || '';
        my $cat    = $q->param('trait_category') || '';
        my ( $qtls, $traits, $pager, $title );

        #
        # If only searching by trait category ...
        #
        if ( $cat && scalar keys %vars == 1 ) {
            $title  = "QTL in category &quot;$cat&quot;";
            $traits = $Traits_By_Cat{ uc $cat } || [];

            die "Invalid trait category: '$cat'!\n" unless @$traits;

            if ( $order_by eq 'no_qtl' ) {
                $traits = [ 
                    sort { $b->{'no_qtl'} <=> $a->{'no_qtl'} }
                    @{ $Traits_By_Cat{ uc $cat } || [] }
                ];
            }
            elsif ( $order_by && $order_by ne 'trait_name' ) {
                $traits = [ 
                    sort { lc $a->{ $order_by } cmp lc $b->{ $order_by } }
                    @{ $Traits_By_Cat{ uc $cat } || [] }
                ];
            }
            else {
                $traits =   
                    $Traits_By_Cat{ uc $cat } || [];
            }

            my $url = $q->url( -full => 1, -query => 1 );
            my ( $p, $data ) = pager(
                data             => $traits,
                url              => $url,
                entries_per_page => 25,
                current_page     => $q->param('page_no') || 1,
            );
            $traits = $data;
            $pager  = $p;
        }
        elsif ( $show_results ) {
            #
            # Try at least three times to find the query, each
            # time adding a wildcard to the back and front.
            #
            my %args     = (
                search_field         => $q->param('search_field')      || '',
                species              => $q->param('species')           || '',
                trait_id             => $q->param('trait_id')          ||  0,
                trait_category_id    => $q->param('trait_category_id') ||  0,
                lit_id               => $q->param('lit_id')            ||  0,
                order_by             => $q->param('order_by')          || '',
                ps_trait_inc         => join(',', $q->param('ps_trait_inc')),
                ps_trait_exc         => join(',', $q->param('ps_trait_exc')),
                ps_species_inc       => join(',', $q->param('ps_species_inc')),
                ps_species_exc       => join(',', $q->param('ps_species_exc')),
                ps_linkage_group_inc => $q->param('ps_linkage_group_inc') || '',
                ps_linkage_group_exc => $q->param('ps_linkage_group_exc') || '',
            );

            for my $v ( iterative_search_values( $q->param('query') ) ) {
                $args{'query'} = $v;
                $qtls          = $qdb->search( %args );

                if ( @$qtls > 0 ) {
                    $q->param( 'query', $v );
                    last;
                }
            }

            my $url = $q->url( -full => 1, -query => 1 );
            my ( $p, $data ) = pager(
                data             => $qtls,
                url              => $url,
                entries_per_page => 25,
                current_page     => $q->param('page_no') || 1,
                object_name      => 'QTLs',
            );
            $qtls   = $data unless $q->param('download');
            $traits = [];
            $pager  = $p;
            $q->param( 'trait_category' => '' );

            for my $qtl ( @$qtls ) {
                ($qtl->{'mapping'}) = Gramene::CDBI::Markers::Mapping->search(
                    cmap_feature_accession => $qtl->{'qtl_accession_id'}
                );
            }
        }

        if ( $q->param('download') ) {
            $html = join("\t", qw[ 
                species 
                trait_name
                trait_synonyms 
                linkage_group
                chromosome
                trait_category 
                trait_symbol 
                published_symbol 
                qtl_accession_id 
                map_set_accession 
                map_set_name 
                map_name 
                start_position 
                stop_position 
                map_units 
            ]) . "\n";

            for my $qtl ( @$qtls ) {
                my $mapping = $qtl->{'mapping'};
                my @map_data = 
                    $mapping 
                    ? (
                        $mapping->map->map_set->cmap_map_set_accession,
                        $mapping->map->map_set->map_set_name,
                        $mapping->map->map_name,
                        $mapping->start,
                        $mapping->end,
                        $mapping->map->map_set->distance_unit,
                    )
                    : ();

                $html .= join("\t", 
                    $qtl->{'species'},
                    $qtl->{'trait_name'},
                    join( ', ', @{ $qtl->{'trait_synonyms'} || [] } ),
                    $qtl->{'linkage_group'},
                    $qtl->{'chromosome'},
                    $qtl->{'trait_category'},
                    $qtl->{'trait_symbol'},
                    $qtl->{'published_symbol'},
                    $qtl->{'qtl_accession_id'},
                    @map_data,
                ) . "\n";
            }
        }
        else {
            $template->process( 
                $SEARCH_TEMPLATE,
                {
                    qtl              => $qtls,
                    pager            => $pager,
                    show_results     => $show_results,
                    traits           => $traits,
                    species          => \@Species,
                    table_only       => $table_only,
                    title            => $title || 'QTL Search',
                },
                \$html
            ) or $html = $template->error;
        }
    }
};

if ( my $err = $@ ) {
    if ( $template ) {
        $template->process( 
            $ERROR_TEMPLATE,
            {
                error_message => $err,
                table_only    => $table_only,
            },
            \$html
        ) or $html = $template->error;
    }
    else {
        $html = "Error: $err";
    }
}

my $type = $q->param('download') ? 'application/x-download' : 'text/html';
print $q->header( $type ), $html;

# ----------------------------------------------------------------

=pod

=head1 NAME

qtl_display

=head1 DESCRIPTION

This CGI script allows for searching and displaying QTL data.  When
given no arguments, just a search form is displayed.  When search
arguments are present, a search is performed and the results are
returned along with the search form with the search values in place.
If a specific QTL accession ID is provided, then the details of that
QTL are shown.

The following arguments are acceptable:

=over

=item * query

The search string.  When a search is submitted but no value is given
for C<query>, then the search is treated as a simple wildcard search
("*").  All stars in the C<query> string are converted to SQL
wildcards ("%").

=item * search field

The field in the database to search with the C<query> argument
(optional).

=item * species

A string (e.g., "Rice") to limit the search results.

=item * submit

The value of the "submit" button, indicates that a search was
performed.

=item * qtl_accession_id

An accession ID for a particular QTL.  If present, the details page
will be displayed for the QTL (if it can be found).

=back

This script is written to run under Apache::Registry.

=cut


=head1 SEE ALSO

DBI, Template, Gramene::Config, Gramene::Page, Data::Pageset,
Apache::Request, Bio::GMOD::CMap.

=head1 AUTHORS

Wei Zhao E<lt>zhaow@cshl.eduE<gt>,
Ken Youens-Clark E<lt>kclark@cshl.orgE<gt>.

=cut
