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

# $Id: browser,v 1.58 2007/03/19 18:22:19 kclark Exp $

use strict;
use Apache::URI ();
use CGI 2.42 qw/:standard :html3 escape *table *TR *td/;
use CGI::Carp qw/fatalsToBrowser/;
use Gramene::Config;
use Gramene::Page;
use Gramene::Search::SearchSubs qw(:swish GrameneError GrameneSearchTable );
use Gramene::Utils qw( get_logger );
use LWP;
use Readonly;

Readonly my $QUERY_LOG_FILE => '/usr/local/gramene/logs/simple-search.log';

use vars qw( $useragent );
$useragent ||= LWP::UserAgent->new;

my $gconfig        = Gramene::Config->new;
my $logger         = get_logger();
my $r              = Apache->request;
my $search_type    = param( 'search_type' );
my $search_pattern = param( 'query' );

#log_query( $search_pattern );

# 'All'=all relational else search particular relational db
if ( $search_pattern ) {
    $search_type ||= "All";
}

my %location = %{ $gconfig->get( 'web' )->{location} };
{    #only need $here here
    my $here = "http://"
        . join( ":",
        $gconfig->get( 'web' )->{servername},
        $gconfig->get( 'web' )->{port} );
    for my $m ( keys %location ) {
        $location{$m} = $here if $location{$m} eq 'HERE';
    }
}

# here's where the search happens
my $relational_content = '';
my $relational_links   = [];

if ( $search_type && $search_type eq "Maps" ) {
    print redirect( "/db/cmap/feature_search?search_field=both&features="
            . escape( $search_pattern ) );
    return;
}


# possibly search Rice genetics newsletter with SWISH-E
my $static_files;
if ( param( 'RGN' ) && $search_pattern ) {
    $static_files = Search_Swish( $search_pattern );
}

if ( $search_pattern ) {
    ( $relational_content, $relational_links )
        = relational_search( $useragent, $search_pattern, $search_type,
        \%location );
    $relational_content ||= h2( "Database Results" )
        . table(
        {
            align       => "CENTER",
            cellspacing => 2,
            class       => "resultsbody",
            border      => 0,
            cellpadding => 2,
            width       => "100%"
        },
        TR(
            th(
                { class => "resultstitle" },
                p(
                    { class => "datawarning" },
                    "Sorry, no matching records were found"
                )
            )
        )
        );
}

print header();
my $page = Gramene::Page->new( $r )
    || GrameneError( "Can't open Gramene page gconfigurator" );

my @result_links = ();
push @result_links, qq(<a href="#swish">Newsletter & Docs</a>)
    if param( 'RGN' ) && $static_files;

#have
my $sh = $page->start_html(
    -title  => 'Simple Search',
    -Class  => 'search',
    -Target => '_top',
);
$sh =~ s/<body\b[^>]*>//i;
my $sb = $page->start_body;

print "$sh$sb";

if ( @$relational_links or @result_links ) {
    my $current_url = $page->url_for_form;
    my @anchored_result_links = map { $_ =~ s/#/$current_url#/; $_ }
        ( @$relational_links, @result_links );

    print h1(
        img(
            {
                -src   => $gconfig->get( 'SearchIcon' ),
                -align => 'MIDDLE',
                -alt   => 'search'
            }
        ),
        'Search the Gramene Database'
    );
    print qq(&nbsp;<img src="/images/icons/grain_icon.jpg" alt="grain_icon"
  height=16 width=16
  align="top">&nbsp;Results:&nbsp;),
        join( "&nbsp;|&nbsp;", @anchored_result_links );
}

display_search_form();
print a( { -name => 'searchagain' }, '&nbsp;' );
print $relational_content, "\n" if $relational_content;

print(
    qq(<center><h2><a href="/newsletters/rice_genetics/">Rice Genetics Newsletter</a> & Documentation Search Result</h2></center><a name="swish"></a>)
) if param( 'RGN' );

Display_Swish_Hits( $static_files, $search_pattern ) if param( 'RGN' );

print $page->end_body;

sub display_search_form {
    my $name = 'Gramene';    #Configuration()->Name || get_symbolic();

    my @types = (
        "All",      "Genomes",    "Maps",  "Markers",
        "Proteins", "Ontologies", "Genes", "QTL",
        "Literature"
    );
    GrameneSearchTable(
        { method => 'GET' },
        "\u$name Search",
        table(
            { -width => "100%" },
            TR(
                td( 'Search for (object name, identifier, or keyword):', ),
                td(
                    { -align => 'left' },
                    a(
                        { -href => '/multi/martview' },
                        b( 'Gramene&nbsp;Mart' )
                    )
                )
            ),
            TR(
                td(
                    textfield( -name => 'query', -size => 40 ) . '&nbsp;'
                        . submit( 'Search' )
                ),
                td(
                    { -align => 'left' },
                    a(
                        { -href => '/multi/blastview' },
                        b( 'Blast&nbsp;search' )
                    )
                )
            ),

            #.br.
            TR(
                td(
                    { -colspan => 2 },
                    table(
                        TR(
                            td(
                                { align => 'center' },
                                "&nbsp;&nbsp;<b>Database:</b>&nbsp;&nbsp;",
                                popup_menu(
                                    -name    => 'search_type',
                                    -Values  => \@types,
                                    -default => 'All'
                                )
                            ),
                            td(
                                checkbox(
                                    -name => 'RGN',
                                    -label =>
                                        'Include Rice Genetics Newsletter & Gramene Documentation'
                                )
                            )
                        ),
                    )
                )
            )
        )
    );
}

sub relational_search {
    my ( $useragent, $query, $search_type, $pLocn ) = @_;

    $logger->debug(
        "rs $query " . join( "; ", map {"$_ $pLocn->{$_}"} sort keys %$pLocn )
    );
    my ( $request, $response, $content );
    $content = "";
    my ( @links ) = ();

    ########## Sequence Search ################################
    if ( ( $search_type eq "All" || $search_type eq "Genomes" )
        && $pLocn->{gramene_ensembl} )
    {

        # unisearch
        my $uquery = $query;

        #$uquery='*'.$uquery unless substr($uquery,0,1) eq '*';
        #$uquery .='*' unless substr($uquery,-1) eq '*';
        for my $species (
            'Oryza_sativa', 'Zea_mays',
            'Zea_mays2',    'Arabidopsis_thaliana'
            )
        {
            $request = HTTP::Request->new( GET => $pLocn->{gramene_ensembl}
                    . "/$species/unisearch?type=all&table=1&q="
                    . escape( $uquery ) );
            $response = $useragent->request( $request );
            if ( $response->is_success ) {
                my $cc = \$response->content;

                #warn "uni $species=".length($$cc)." @".time()."\n";
                if ( $$cc =~ /Your Search has Returned No Results/ ) {
                    $$cc =
                        ( $search_type eq 'All' )
                        ? ""
                        : qq(<center class="resultsbody">Not found in Sequence Database</center>);
                }
                if ( $$cc ) {
                    $$cc =~ s/\bclass="yellow2"/class="resultstitle"/ig;
                    $$cc =~ s/\bclass="yellow1"/class="resultsbody"/ig;
                    $$cc =~ s/\bclass="arial"//ig;
                    $$cc =~ s/\bclass="smarial"//ig;

#$$cc =~ s/(\d results?)\)/$1 in sequence database)/g; #redundant given header
                    $content
                        .= qq(\n<center><h2>$species Sequence Search Result</h2></center><a name="${species}_sequence"></a>)
                        . $$cc;
                    push @links,
                        qq(<a href="#${species}_sequence">$species Sequence</a>);
                }
            }
            else {
                $logger->info("/$species/unisearch error: " . $response->code);
            }
        }
    }

    my $proquery = $query;
    $proquery =~ s/\*/%/g;

    #$proquery =~ s/\s+/+/g; Don't - it's escaped below

    ########## Protein Search ################################
    if ( ( $search_type eq "All" || $search_type eq "Proteins" )
        && $pLocn->{protein} )
    {
        $request = HTTP::Request->new(
                  GET => "$pLocn->{protein}/db/protein/protein_search?word="
                . escape( $proquery )
                . '&table=1' );
        $response = $useragent->request( $request );
        if ( $response->is_success ) {
            my $cc = \$response->content;

            unless ( $search_type eq "All"
                && $$cc =~ /Sorry, no matching records/ )
            {
                $$cc =~ s/record/protein record/;
                $content .= qq(\n<a name="protein"></a>)
                    . "<center><h2>Protein Search Result</h2></center>"
                    . $$cc;
                push @links, qq(<a href="#protein">Protein</a>);
            }

        }
        else {
            $logger->info("/db/protein_search error: " . $response->code);
        }
    }

    ########## Ontology Search ###############################
    if ( ( $search_type eq "All" || $search_type eq "Ontologies" )
        && $pLocn->{ontology} )
    {
        $request = HTTP::Request->new(
                  GET => "$pLocn->{ontology}/db/ontology/search?query="
                . escape( $query )
                . '&table=1' );
        $response = $useragent->request( $request );
        if ( $response->is_success ) {
            my $cc = \$response->content;

            unless ( $search_type eq "All"
                && $$cc =~ /Cannot find any information about/ )
            {
                $$cc =~ s/Summary/Ontology Search Result/;
                $content .= qq(\n<a name="ontology"></a>) . $$cc;
                push @links, qq(<a href="#ontology">Ontology</a>);
            }
        }
        else {
            $logger->info("/db/ontology/search error: " . $response->code);
        }
    }

    ########## Gene Search ##################################
    if ( ( $search_type eq "All" || $search_type eq "Genes" )
        && $pLocn->{genes} )
    {
        my $gene_query = '*' . $proquery . '*';    # wild card search
        $request = HTTP::Request->new( GET =>
                "$pLocn->{genes}/db/genes/search_gene?core=1&query_submit=Search&query="
                . escape( $gene_query )
                . '&table=1' );
        $response = $useragent->request( $request );
        if ( $response->is_success ) {

            my $cc = \$response->content;
            unless ( $search_type eq "All"
                && $$cc =~ /Cannot find any information/ )
            {
                $$cc =~ s|href="(?=[^hf/])|href="/db/genes/|ig
                    ; #turn relative urls to absolute. exclude h,f,m as starts of http:, ftp:
                $content
                    .= qq(\n<a name="gene"></a><center><h2>Gene Search Result</h2></center>)
                    . $$cc;
                push @links, qq(<a href="#gene">Gene</a>);
            }
        }
        else {
            $logger->info("/db/genes/search_gene error: " . $response->code);
        }
    }
    ########### Literature Search ################################
    if ( ( $search_type eq "All" || $search_type eq "Literature" )
        && $pLocn->{literature} )
    {
        $request = HTTP::Request->new(
                  GET => "$pLocn->{literature}/db/literature/pub_search?word="
                . escape( $proquery )
                . '&table=1' );
        $response = $useragent->request( $request );
        if ( $response->is_success ) {

            my $cc = \$response->content;
            unless ( $search_type eq "All"
                && $$cc =~ /Sorry, no matching records/ )
            {
                $content .= qq(\n<a name="literature"></a>)
                    . "<center><h2>Literature Search Result</h2></center>"
                    . $$cc;
                push @links, qq(<a href="#literature">Literature</a>);
            }
        }
        else {
            $logger->info("pub_search error: " . $response->code);
        }
    }
    ########### Marker Search ################################
    if ( ( $search_type eq "All" || $search_type eq "Markers" )
        && $pLocn->{markers} )
    {
        $request = HTTP::Request->new( GET => $pLocn->{markers}
                . '/db/markers/marker_view?marker_name='
                . escape( $proquery )
                . '&table_only=1' );
        $response = $useragent->request( $request );
        if ( $response->is_success ) {
            my $cc = \$response->content;
            unless ( $search_type eq "All"
                && $$cc =~ /No markers (match|found)/
                || !$$cc )
            {
                $content
                    .= qq(\n<a name="markers"></a><center><h2>Marker Search Result</h2></center>)
                    . $$cc;
                push @links, qq(<a href="#markers">Marker</a>);
            }
        }
        else {
            $logger->info("/db/markers/marker_view error: " . $response->code);
        }
    }
    ########### QTL Search ################################
    if ( ( $search_type eq "All" || $search_type eq "QTL" ) && $pLocn->{qtl} )
    {
        ( my $qtl_query = $proquery )
            =~ s/-.*/*/;    #QTLID-TRAIT seen in genome browser
                            # -> QTLID + wildcard
        my $qtl_url = $pLocn->{qtl}
            . '/db/qtl/qtl_display?submit=Submit&query='
            . escape( $qtl_query )
            . '&table=1';
        $request = HTTP::Request->new( GET => $qtl_url );
        $response = $useragent->request( $request );
        if ( $response->is_success ) {
            my $cc = \$response->content;
            unless ( $search_type eq "All"
                && $$cc =~ /no QTL entries have been found/
                || !$$cc )
            {
                $$cc =~ s|href="(?=[^hf/])|href="/db/qtl/|ig
                    ; #turn relative urls to absolute. exclude h,f,m as starts of http:, ftp:
                $content
                    .= qq(\n<a name="QTL"></a><center><h2>QTL Search Result</h2></center>)
                    . $$cc;
                push @links, qq(<a href="#QTL">QTL</a>);
            }
        }
        else {
            $logger->info("$qtl_url: " . $response->code);
        }
    }
    return $content, \@links;
}

sub log_query {
    my $query = shift or return;

    open my $fh, '>>', $QUERY_LOG_FILE 
        or croak("Can't open '$QUERY_LOG_FILE': $!\n");
    print $fh join("\t", $query, scalar localtime()), "\n";
    close $fh; 
}
