#!/usr/bin/perl

use strict;
use vars qw($DB $useragent);

use lib '/usr/local/gramene/lib/perl/';

use Ace 1.51;
use CGI 2.42 qw/:standard :html3 escape *table *TR *td/;
use CGI::Carp qw/fatalsToBrowser/;
use Ace::Browser::AceSubs qw(:DEFAULT ResolveUrl DoRedirect AceHeader);
use Ace::Browser::SearchSubs;
use GrameneSubs qw(:swish AceSearchMenuBar);
use GramenePage;
use LWP;
use CSHL::Config;

$useragent  ||= LWP::UserAgent->new;

my $search_class   = param('class');
$search_class= param('class' => 'Any' ) if my $from_relational=( $search_class eq 'aceobject');   #referred here by unisearch
#print STDERR "sc $search_class\n";
my $search_pattern = param('query');
my $offset         = AceSearchOffset();

# fetch database handle
$DB = OpenDatabase() || AceError("Couldn't open database.");

# here's where the search happens


my ($objs,$count);

my $relational_content="";
my $relational_links=[];

#print STDERR  "$search_class | $search_pattern | $from_relational\n";
($relational_content,$relational_links)=relational_search($useragent,$search_pattern)
    if ( defined($search_class) && $search_class =~ /^Any/ && $search_pattern && !$from_relational) ;

if (defined $search_class) {
  my ($keep_trying) = 1;
  while ($keep_trying) {
    if ($search_class =~ /^Any/ && $search_pattern) {
      my $long = param('Long');
      ($objs,$count) = do_grep ($search_pattern,$offset,$long);
    } elsif ($search_class =~ /locus|marker/i) {
      ($objs,$count) = do_marker_search ($search_pattern || '*',$offset);
    }  else {
      if (!grep { $_ eq $search_class } @{Configuration->Simple}) {
	 #print STDERR "<$search_class>\n<",join(",",@{Configuration->Simple}),">\n";
	 print redirect("/perl/unisearch?q=".escape($search_pattern));
         return;
      }
      ($objs,$count) = do_search($search_class,$search_pattern || '*',$offset);
    }

    $keep_trying = 0 if $count;

    if (!$count && param('query') !~ /\*$/ && param('class') !~ /^Any/) {
      param('query' => param('query') . '*');
      $search_pattern = param('query');
      $keep_trying++;
    } else {
      $keep_trying = 0; # give up
    }
  }
}

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


($relational_content,$relational_links)=relational_search($useragent,$search_pattern)
    if ( $search_class !~ /^Any/ && $search_pattern && !$from_relational) ;

#if(!$count && !$static_files && !$from_relational) { 
#    my $request=HTTP::Request->new( 
#	    GET=>'http://'.EnsemblServerName.'/perl/unisearch?type=all&q='.escape($search_pattern) );
#    my $response=$useragent->request($request);
#    if(  $response->is_success ) {
#	my $cc=\$response->content;
#	unless ($$cc =~/Your Search has Returned No Results/) {
#	    $$cc =~ s!<base[^>]*>!!si;
#	    $$cc =~ s!(<head[^>]*>)!$1<base href="/perl/unisearch">!si;
#	    print CGI::header();
#	    print $response->content;
#	    return;
#        }
#    } else {
#        print STDERR "/perl/unisearch error: ",$response->code,"\n";
#    }
#}

DoRedirect(@$objs) if $count==1 && !$static_files && !$relational_content;

AceHeader();
my $r    = Apache->request;
my $page = GramenePage->new($r) || AceError("Can't open Gramene page configurator");

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

#have 
my $sh= start_html(-Title  =>'Simple Search',
		 -Style  => {-src => $page->stylesheet},
		 -Class  =>'search'
		);
		 #-Target =>'_top',	#prevents internal anchors from working
$sh =~ s/<body\b[^>]*>//i;	
my $sb= $page->start_body;
#$sb =~ s/<body\b[^>]*>//i;	
print "$sh$sb";

print
  AceSearchMenuBar('nohome'),
  h1(img({-src=>SEARCH_ICON,-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;",@$relational_links,@result_links) if @$relational_links or @result_links;

display_search_form();
print a({-name=>'searchagain'},'&nbsp;');
print $relational_content,"\n" if $relational_content;
print ( qq(<center><h2>RiceGenes Search Result</h2></center><a name="acedb"></a> ) ) if defined $search_class;
display_search($objs,$count,$offset,$search_class,$search_pattern) if defined $search_class;
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 $classlist = Configuration->Simple;
#print STDERR map { "$_ => %INC{$_}\n" } sort keys %INC;
    my @classes   = @{$classlist}[map {2*$_} (0..@$classlist/2-1)];  # keep keys, preserving the order
    my $name = 'Gramene'; #Configuration()->Name || get_symbolic();
    AceSearchTable("\u$name Search",
		   'Search for (object name, identifier, or keyword):'.br.
		   textfield(-name=>'query',-size=>40).'&nbsp;'.submit('Search').br.
		   table(
			 TR(td({-rowspan=>2},
			       popup_menu(-name=>'class',
					  -Values=>\@classes,
					  -Labels=>{@$classlist},
					  -default=>'Any')
			       ),
			    td(checkbox(-name=>'RGN',-label=>'Include Rice Genetics Newsletter & Gramene Documentation'))
			    ),
			 TR(td(checkbox(-name=>'Long',-label=>'Detailed search (long)')))
		   )
	       );
}

sub do_marker_search {
  my ($pattern,$offset) = @_;
  my $count;
  # first search for locus objects
  my (@objs) = $DB->fetch(-class=>'Locus',-pattern=>$pattern,
			  -count=>MAXOBJECTS,-offset=>$offset,
			  -total=>\$count);
  return (\@objs,$count) if @objs;

  # then search for marker objects
  @objs = $DB->fetch(-class=>'Marker',-pattern=>$pattern,
		     -count=>MAXOBJECTS,-offset=>$offset,
		     -total=>\$count);
  return unless @objs;
  return (\@objs,$count);
}

sub do_search {
  my ($class,$pattern,$offset) = @_;
  my $count;
  my (@objs) = $DB->fetch(-class=>$class,-pattern=>$pattern,
			  -count=>MAXOBJECTS,-offset=>$offset,
			  -total=>\$count);
  return unless @objs;
  return (\@objs,$count);
}

sub display_search {
  my ($objs,$count,$offset,$class,$pattern) = @_;
  my $title;
  $title = $count > 0 ? p(strong($count),"acedb objects of type",strong($class),"contain pattern",strong($pattern))
    :p({-class=>'error'},'No matching acedb objects found');

  #if($count != scalar(@$objs) ) {
  #     print STDERR "count=$count but ",scalar(@$objs)," objects\n";
  #}
  my @objects;
  if ($count && param('class') =~ /^Any/i) {
    @objects = map { font({-color=>'red'},$_->class) . ":&nbsp;".a({-href=>Object2URL($_)},$_) } 
      sort { $a->class cmp $b->class } 
					  #grep { $_->class ne 'Reference' } 
      @$objs;
    #$count=scalar(@objects);
  } else {
    @objects = map { ObjectLink($_) } @$objs;
  }
  AceResultsTable(\@objects,$count,$offset,$title);
}

sub do_grep {
  my ($text,$offset,$long) = @_;
  my $count;
  $text =~ s/\"//g;
  my (@objs) = $DB->grep(-pattern=> $text,
			 -count  => MAXOBJECTS,
			 -offset => $offset,
			 -total => \$count,
			 -long  => $long,
			 );
  return ([],0) unless @objs;
  #if($count != scalar(@objs) ) {
       #print STDERR "count=$count but ",scalar(@objs)," objects\n";
  #}
  #print STDERR "($offset)$text vs\n",join("!\n",@objs),"!\n\n";
  #my @exact = grep { uc($_->name) eq uc($text) } @objs;
  #if(@exact) {
  #    @objs = @exact;
  #    $count=scalar(@objs);
  #}
  return (\@objs,$count);
}




sub relational_search {
my ($useragent,$query)=@_;
    
    #print STDERR "rs $query ".EnsemblServerName."\n";
    my ($request,$response,$content);
    $content="";
    my (@links)=();


    # unisearch
    my $uquery=$query;
    #$uquery='*'.$uquery unless substr($uquery,0,1) eq '*';
    #$uquery .='*' unless substr($uquery,-1) eq '*';
    $request=HTTP::Request->new( 
	    GET=>'http://'.EnsemblServerName.'/perl/unisearch?type=all&table=1&q='.escape($uquery) );
    $response=$useragent->request($request);
    if(  $response->is_success ) {
	my $cc=\$response->content;
#print STDERR "uni=",length($$cc),"\n";
	unless ($$cc =~/Your Search has Returned No Results/) {
	    $$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>Sequence Search Result</h2></center><a name="sequence"></a>).$$cc;
	    push @links,qq(<a href="#sequence">Sequence</a>);
        }
    } else {
        print STDERR "/perl/unisearch error: ",$response->code,"\n";
    }

    my $proquery=$query;
    $proquery =~ s/\*/%/g;
    $proquery =~ s/\s+/+/g;
    $request=HTTP::Request->new( 
	    GET=>'http://'.EnsemblServerName.'/perl/uni/protein_search?word='.escape($proquery) );
    $response=$useragent->request($request);
    if(  $response->is_success ) {
       
	my $cc=\$response->content;
#print STDERR "protein=",length($$cc),"\n";
	unless ($$cc =~/Sorry, no matching records/) {
	    $$cc =~ s/record/protein record/;
	    
	    $content .= qq(\n<a name="protein"></a>).$$cc;
	    push @links,qq(<a href="#protein">Protein</a>);
        }
    } else {
        print STDERR "/perl/uni/protein_search error: ",$response->code,"\n";
    }

    $request=HTTP::Request->new( 
	    GET=>'http://'.EnsemblServerName.'/perl/uni/search?query='.escape($query) );
    $response=$useragent->request($request);
    if(  $response->is_success ) {
	my $cc=\$response->content;
#print STDERR "ontology=",length($$cc),"\n";
	unless ($$cc =~/Sorry! Cannot find any information about/) {
	    $$cc =~ s/Summary/Controlled Vocabulary Summary/;
	    $content .= qq(\n<a name="ontology"></a>).$$cc;
	    push @links,qq(<a href="#ontology">Ontology</a>);
        }
    } else {
        print STDERR "/perl/uni/search error: ",$response->code,"\n";
    }
#print STDERR "total=",length($content),"\n";

    return $content,\@links;
}
