#!/usr/bin/perl

our $VERSION = '0.02';

# $Id: display_genotype_by_marker,v 1.8.2.2 2007/06/14 19:04:09 kclark Exp $

use warnings;
use strict;

use FindBin::Real qw(Bin);
use HTML::SearchPage;
use HTML::SearchPage::Param;
use List::MoreUtils qw(any);
use Panzea::FormModifier;
use Panzea::FormConfig;
use Panzea::WebFormUtils;

my $config_file = '/usr/local/gramene-25/conf//html-searchpage.conf'; # MKFILE:Q:CONF_FILE
my $config = Panzea::FormConfig->new($config_file);

my $code2sampstat = Panzea::WebFormUtils->code2sampstat();

# Search page object
my $sp = HTML::SearchPage->new(
    page_title     => 'Assay Results (by Marker Name)',
    header         => $config->cfg('form_header'),
    css            => $config->cfg('form_css'),
    temp_dir       => $config->cfg('temp_dir'),
    temp_dir_eq    => $config->cfg('temp_dir_eq'),
    instructions   => $config->cfg('instructions_display_genotype'),
    footer         => $config->cfg('form_footer'),
    base_sql_table => qq[aux_feature_to_taxonomy aftt
        LEFT  JOIN div_taxonomy dt ON (dt.div_taxonomy_id = aftt.div_taxonomy_id)
        LEFT  JOIN div_passport dp ON (dp.div_passport_id = aftt.div_passport_id)
        LEFT  JOIN div_scoring_tech_type dstt ON (dstt.div_scoring_tech_type_id = aftt.div_scoring_tech_type_id)
        LEFT  JOIN cdv_marker cm ON (cm.cdv_marker_id = aftt.cdv_marker_id)
        LEFT  JOIN cdv_map_feature cmf ON (cmf.cdv_map_feature_id = aftt.cdv_map_feature_id)
    ],
    base_sql_fields => [
        'cm.name',
        'cmf.name',
        'aftt.div_allele_assay_id',
        'aftt.div_obs_unit_id',
        'dp.accename',
        'dp.source',
        'dp.sampstat',
        'dt.genus',
        'dt.species',
        'dt.subspecies',
        qq[CONCAT(aftt.div_allele_assay_id, ':', aftt.div_obs_unit_id)],
    ],
    distinct            => 1,
    no_reset            => 1,
    base_output_headers => [
        'Marker Name',
        'Gene/Locus',
        'Assay Id:aftt.div_allele_assay_id',
        'Plant Id:aftt.div_obs_unit_id',
        'Accession:dp.accename',
        'Source:dp.source',
        'Germplasm Type',
        'Genus:dt.genus',
        'Species:dt.species',
        'Subspecies:dt.subspecies',
        'Genotype',
    ],
    sort_fields      => 3,
    sort_defaults    => [qw(asc dp.accename asc aftt.div_obs_unit_id)],
    method           => $config->cfg('form_method'),
    page_size        => $config->cfg('form_page_size'),
    db_access_params => $config->cfg('db_access_params'),
    debug_level      => $config->cfg('form_debug_level'),
    go_to_results    => $config->cfg('form_go_to_results'),
    show_search_url  => $config->cfg('form_show_search_url'),
    modifier         => Panzea::FormModifier->new(),
);    # Displays error page if fails

# Intermediary steps
my $submit = $sp->cgi_params->{'submit'};

my $marker_name = $sp->cgi_params->{'marker_name'};
my $marker_type = $sp->cgi_params->{'marker_type'};
my $assay_id    = $sp->cgi_params->{'assay_id'};
my $sampstat    = $sp->cgi_params->{'sampstat'};

my $dbh = $sp->dbh;

# Make sure a marker name is available
if (!$marker_name) {
    $sp->display_error_page("A valid marker name is required!");
}

# Make sure this is a genotype assay (SNP SSR)
my %allowed_scoring_tech_groups = (SNP => 1, SSR => 1);

# Determine assay types
my @marker_types;
eval {
    my $statement =
      qq[SELECT distinct CONCAT(dstt.div_scoring_tech_type_id, ':', dstt.scoring_tech_group)
        FROM  aux_feature_to_taxonomy aftt
        LEFT  JOIN div_scoring_tech_type dstt ON (dstt.div_scoring_tech_type_id = aftt.div_scoring_tech_type_id)
        LEFT  JOIN cdv_marker   cm ON (cm.cdv_marker_id = aftt.cdv_marker_id)
        WHERE dstt.div_scoring_tech_type_id IS NOT NULL
        AND dstt.div_scoring_tech_type_id != ""
        AND cm.name = ] . $dbh->quote($marker_name);
    @marker_types = $sp->run_distinct_statement($statement);
};
$sp->display_error_page($@) if $@;

# Determine if there are any assays
if (!@marker_types) {
    $sp->display_error_page(
        "Cannot find any assays for marker ($marker_name)!");
}

# Remove assay types unless they are allowed
my @filtered_marker_types;
foreach (@marker_types) {
    my ($scoring_tech_group) = $_ =~ /:(.+)/;
    push @filtered_marker_types, $_
      if $allowed_scoring_tech_groups{$scoring_tech_group};
}

# Check assay types
if (!@filtered_marker_types) {
    $sp->display_error_page("This tool can only be used for "
          . join(', ', keys %allowed_scoring_tech_groups)
          . " assays!");
}

# Determine assay ids
my @assay_ids;
eval {
    my $statement =
      qq[SELECT distinct CONCAT(aftt.div_allele_assay_id, ":", aftt.div_allele_assay_id, " (", dstt.scoring_tech_group, ")")
        FROM  aux_feature_to_taxonomy aftt
        LEFT  JOIN div_scoring_tech_type dstt ON (dstt.div_scoring_tech_type_id = aftt.div_scoring_tech_type_id)
        LEFT  JOIN cdv_marker   cm ON (cm.cdv_marker_id = aftt.cdv_marker_id)
        WHERE aftt.div_allele_assay_id IS NOT NULL
        AND aftt.div_allele_assay_id != ""
        AND cm.name = ] . $dbh->quote($marker_name);
    @assay_ids = $sp->run_distinct_statement($statement);
};
$sp->display_error_page($@) if $@;

# Determine sampstats and format for display
my @sampstats;
eval {
    my $statement =
      qq[SELECT distinct dp.sampstat
        FROM  aux_feature_to_taxonomy aftt
        LEFT  JOIN cdv_marker   cm ON (cm.cdv_marker_id = aftt.cdv_marker_id)
        LEFT  JOIN div_passport dp ON (dp.div_passport_id = aftt.div_passport_id)
        WHERE dp.sampstat IS NOT NULL
        AND dp.sampstat != ""
        AND cm.name = ] . $dbh->quote($marker_name);
    @sampstats = $sp->run_distinct_statement($statement);
};
$sp->display_error_page($@) if $@;

my @formatted_sampstats = map {
        $code2sampstat->{$_}
      ? $_ . ":" . $sp->url_encode($code2sampstat->{$_})
      : $_ . ":"
      . $sp->url_encode($_)
} @sampstats;

# If submit was clicked make sure dynamic params are selected properly
if ($submit) {
    any { /^([^:]+)/; $1 eq $marker_type } @filtered_marker_types
      or $sp->display_error_page("Invalid assay type ($marker_type)!");

    any { /^([^:]+)/; (($1 eq $assay_id) or ($assay_id eq 'all')) } @assay_ids
      or $sp->display_error_page("Invalid assay_id ($assay_id)!");

    any { /^([^:]+)/; (($1 eq $sampstat) or ($sampstat eq 'all')) } @sampstats
      or $sp->display_error_page("Invalid germplasm type ($sampstat)!");
}

# Param fields
my $pf;

$pf = HTML::SearchPage::Param->new(
    -label            => 'Marker Name (Required):',
    -sql_column       => 'cm.name',
    -form_name        => 'marker_name',
    -operator_list    => ['=:equals'],
    -operator_display => 0,
    -param_type       => 'text:12',
) or $sp->display_error_page($@);
$sp->param_field('marker_name', $pf);

$pf = HTML::SearchPage::Param->new(
    -label            => 'Marker Type:',
    -sql_column       => 'dstt.div_scoring_tech_type_id',
    -form_name        => 'marker_type',
    -operator_list    => ['=:equals'],
    -operator_display => 0,
    -param_type       => 'drop_down',
    -param_list       => \@filtered_marker_types,
) or $sp->display_error_page($@);
$sp->param_field('marker_type', $pf);

$pf = HTML::SearchPage::Param->new(
    -label            => 'Assay Id:',
    -sql_column       => 'aftt.div_allele_assay_id',
    -form_name        => 'assay_id',
    -operator_list    => ['=:in', '<>:not in'],
    -operator_display => 1,
    -operator_default => '=',
    -param_type       => 'scrolling_list:3',
    -param_list       => \@assay_ids,
    -auto_all         => 1,
    -param_default    => ['all'],
) or $sp->display_error_page($@);
$sp->param_field('assay_id', $pf);

$pf = HTML::SearchPage::Param->new(
    -label            => 'Germplasm Type:',
    -sql_column       => 'dp.sampstat',
    -form_name        => 'sampstat',
    -operator_list    => ['=:in', '<>:not in'],
    -operator_display => 1,
    -operator_default => '=',
    -param_type       => 'scrolling_list:3',
    -param_list       => \@formatted_sampstats,
    -auto_all         => 1,
    -param_default    => ['all'],
) or $sp->display_error_page($@);
$sp->param_field('sampstat', $pf);

# Modifications
$sp->add_modification(
    -action => 'add_link',
    -column => 1,
    -type   => 'gene_locus'
);

$sp->add_modification(
    -action => 'add_link',
    -column => 4,
    -type   => 'accession'
);

$sp->add_modification(
    -action => 'add_link',
    -column => 5,
    -type   => 'source'
);

$sp->add_modification(
    -action => 'translate',
    -column => 6,
    -type   => 'code2sampstat'
);

$sp->add_modification(
    -action => 'get_genotype',
    -column => 10,
);

# Call display method
$sp->display_page;

=head1 NAME

display_genotype_by_marker

=head1 DESCRIPTION

Panzea web display script.

Please refer to documentation of HTML::SearchPage and
HTML::SearchPage::Param for information on script structure.

=head1 AUTHOR

Payan Canaran <canaran@cshl.edu>

=head1 BUGS

=head1 VERSION

Version 0.02

=head1 ACKNOWLEDGEMENTS

=head1 COPYRIGHT & LICENSE

Copyright (c) 2005-2007 Cold Spring Harbor Laboratory

This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself. See DISCLAIMER.txt for
disclaimers of warranty.

=cut

