#!/usr/local/bin/perl
# fbreslist.pm
# perl module for query result listings
# jan'99, dgg, flybase
## revised for MEOW -- switch to java version sometime soon
 

package fbreslist;

$dataname= "MEOW";
$debug= 0;

## from mEnviron.properties, reference db urls
%DBurls = (
	'FlyBase' => 'http://flybase.bio.indiana.edu/.bin/fbidq.html?%s',
	'LocusLink' => 'http://www.ncbi.nlm.nih.gov/LocusLink/LocRpt.cgi?l=%s',
	'MGI' => 'http://www.informatics.jax.org/bin/query_accession?id=MGI:%s',
	'ACEDB' => 'http://stein.cshl.org/perl/ace/gene/elegans?name=%s',
	'ACEPRED' => 'http://stein.cshl.org/perl/ace/sequence/elegans?name=%s',
	'SGDID' => 'http://genome-www.stanford.edu/cgi-bin/dbrun/SacchDB?find+SGDID+%s',

        'ATDB' => 'http://genome-www3.stanford.edu/cgi-bin/Webdriver?MIval=atdb_locus_min&locus=%s',
        'ZFIN' => 'http://zfish.uoregon.edu/cgi-bin/ZFIN_jump?record=%s',
	);

%DBNamesList=(
 	'FBgn' => 'Fruitfly genes',
 	'HUgn' => 'Human genes',
	'SGgn' => 'Yeast genes',
	'ATgn' => 'Weed genes',
	'CEgn' => 'Worm genes',
	'MGgn' => 'Mouse genes',
	'ZFgn' => 'Fish genes',
	);
	
%ScriptsList=(
	'FBgn' => 'fbgenq2',
	'HUgn' => 'fbgenq2',
	'SGgn' => 'fbgenq2',
	'ATgn' => 'fbgenq2',
	'CEgn' => 'fbgenq2',
	'MGgn' => 'fbgenq2',
	'ZFgn' => 'fbgenq2',
	);

## should be constant...
$gSymbolKey= 'SYM';
$gDbIDKey =  'DID';
$visibleFields='SYM:15=Symbol|NAM:15=Name|CHR:10=Chromosome|ORG:10=Organism|DID:12=Ref. database';
$briefFields= $visibleFields;
$sortKinds='KLOC=2|DT=3';
@views= ("text/html","text/plain","text/acode","text/acode-pretty", "text/xml" );

$dohtmlsup= 1;  ## use html super/sub codes ?
$useBriefFields= 0;
$reslisturl= "/.bin/fbreslist.pl";
$idurl= "/.bin/fbidq.html";
$pagesize= 20;
$fbidtag= "ZZzz"; ## unknown
$gopath= $ENV{'SERVER_PATH'};
$headlinedir= '/.etc/jdata/headlines'; ##?
$javaResList= 0; 
$prettyquery= undef;
$refineForm= undef;
$selectmanyForm= undef;
$footer= undef;
$docgi= 0;
$dohtml= 1;
if ($ENV{'GATEWAY_INTERFACE'} =~ /CGI/) { $docgi= 1; $dohtml=3; }


# ------------------ START OF THE LIBRARY ------------

sub setClassVars {
  local($_) = @_;   ## parameter is section value or FBid value
  local($idokay) = 1;

  $dataname = "Genes" if (!$dataname || $dataname eq 'MEOW');
  
 	if ($DBNamesList{$_}) {  $fbidtag= $_; }
 	elsif (!$_) {  $fbidtag= 'FBgn'; }
 	else { $idokay= 0; }

  &main'SetViewsNStyles();
  return $idokay;
}


sub init() {
	local($query) = @_;
	$debug= $main'debug;
	$dohtmlsup= $main'dohtmlsup;
	$dohtml= $main'dohtml;
	$fbidtag= $main'fbidtag;
	$gopath= $main'gopath;
	if ($query) { $prettyquery= $query; }
	else { $prettyquery= $main'query; }
}



## was testCGI()
sub putContentType {
	local($contype)= @_;
  if ($ENV{'GATEWAY_INTERFACE'} =~ /CGI/) { $docgi= 1; $dohtml=3; }
  return if ($putcont==1 && $contenttype ne "");
  if ($contype) { $contenttype= $contype; } 
  else { $contenttype= $ENV{'CGI_CONTYPE'}; }
  if (!$contenttype) { $contenttype= $ENV{'CONTENT_TYPE'}; }
  if (!$contenttype) { $contenttype= "text/html"; }
	if ($contenttype eq "application/x-www-form-urlencoded") { $contenttype= "text/html"; } 
  if ($docgi) {
     print "Content-type: $contenttype\n\n";
  	 $ENV{'CGI_CONTYPE'} = $contenttype;
     $putcont= 1;
     }
}


sub putNoResults {
	local($msg,$noexit)= @_;
 	print STDERR "putNoResults: $msg\n" if $debug;
  &putContentType(); 
  print "<B>" if ($contenttype eq 'text/html');
  print $msg;
  print "</B><BR>" if ($contenttype eq 'text/html');
  print "\n";
	if ($noexit) { return(1); } else { &main'fbexit(0); }
}

sub redirectToUrl {
	local($url,$noexit)= @_;
	if ($docgi) {
		if ($url !~ /^http/i) {
				## prepend "http://$host:$port/" to url
			local($u)= "http://" . $main'host;
			$u .= ":" . $main'port if ($main'port != 80);
			$url= $u . $url;
			}
  	print STDERR "redirectToUrl url= $url \n" if $debug;
		## print "Status: 302\n"; ## == moved-temporarily, force httpd to do client-redirect !?
		print "Location: $url\n";
		print "Content-Type: text/html\n\n";
		print "Results are at <A HREF=\"$url\">$url</A><BR>\n";
		if ($noexit) { return(1); } else { &main'fbexit(0); }
		}
}



sub putResultsReports {
  local( $totalcount,$askdata,$noexit) = @_;
  local( $i,$_,$id,$idq,$headline);

  print STDERR " putResultsReports count= $totalcount \n" if $debug;
  if ($totalcount < 1) {
  	return &putNoResults("No matches to query '$prettyquery'", $noexit);
    }
    
  else  {
    if ( $dohtml ) { 
  	  unless (open(DATAF, "<$askdata")) {
        print STDERR " can't open $askdata \n" if $debug;
  			return &putNoResults("Error reading results to query '$prettyquery'", $noexit);
				}
    	$i= 0;
    	while ( $i<$totalcount ) {
    		$_= <DATAF>;
    		chop();
  		  ## print STDERR " data=$_\n" if $debug; ##? nothing here !
				## id should be first item on line, maybe only thing
				($id,$headline) = split(/[\t]/,$_,2);
				$idq .= "+" if ($i>0);
				$idq .= $id;
				$i++;
  		 	## print STDERR " id= $id  head=$headline \n" if $debug;
				}
			close(DATAF);
  		if ($idq) {
    	  print STDERR "${idurl}?${idq}\n" if $debug;
				return &redirectToUrl("${idurl}?${idq}", $noexit);
				}
  		else {
        print STDERR " no ids found in $askdata \n" if $debug;
  			return &putNoResults("Error reading results to query '$prettyquery'", $noexit);
  			}
			}
		else {
			##? add support for gopher output?
			}
	}
}


sub getResultsListTitle {
  local( $query, $totalcount) = @_;
 	local( $title);
	$title  = "<TITLE>$dataname Results</TITLE><BODY>\n";
	$title .= "<B>$dataname query results</B><BR>\n";
	$title .= "Query: $query, " if ($query);
	$title .= "No. matches= $totalcount <BR>";
  return ($title); 
}


sub getResultsSelectManyDialog  {
	##  form to select items to return as one 
 	local($datafile,$headlinepath)= @_;
 	local($fm);
	## note: $askdata == $askfile with path prefix and .data suffix
  ## $askdata    = $gopath . $tmpdir . $askfile . ".data";
	## was METHOD=GET, why?
	
	$fm = <<TEOF;
<A NAME=batch>
<FORM ACTION="$reslisturl" METHOD=POST>
<TABLE BORDER=1 BGCOLOR="#f0e8e8" WIDTH="100%" CELPADDING=4 CELLSPACING=0>
<TR><TH><BIG>Batch Download</BIG></TH></TR>
<TR><TD>
<INPUT TYPE=hidden NAME=data VALUE=$datafile>
<INPUT TYPE=submit VALUE="Fetch items">:
<INPUT TYPE=radio NAME=returnall VALUE=yes>All
<INPUT TYPE=radio NAME=returnall VALUE=no CHECKED>Items: 
<INPUT NAME=items VALUE=1 SIZE=10> (e.g., '1..5,10..11')
TEOF

	$fm .= "<INPUT TYPE=hidden NAME=head VALUE=1>\n" if ($headlinepath);
	$fm .= "&nbsp; <B>Format:</B> <SELECT name=format>\n$main'viewlist\n</SELECT>\n" if ($main'viewlist);
	## $fm .= "Report style: <SELECT name=rstyle>\n$main'reportStyles\n</SELECT>\n"  if ($main'reportStyles);
  $fm .= "</FORM>\n";
  $fm .= "</TD></TR></TABLE>\n";
  return ($fm);   
}


sub putResultsList {
  local( $totalcount, $askdata, $noexit, $pquery) = @_;
  local( $i,$_,$id,$headline);

	$fbidtag= $main'fbidtag;
	$prettyquery= $pquery if ($pquery);
	
  print STDERR " putResultsList count= $totalcount\n" if $debug;
	
  if ($totalcount < 1) {
  	return &putNoResults("No matches to query '$prettyquery'", $noexit);
    }
    
  else  {
    ## $|= 1; # force flush output, otherwise java output beats perl to client ...
	  ## &putContentType();  

    local( $dpath, $dfile, $at);
    $dfile= $askdata;
    $at= rindex($askdata, "/");
    if ($at>0) {
    	$dfile= substr( $askdata, $at+1);
    	$dpath= substr( $askdata, 0, $at);
    	}
    	
    if ( open(TF,">>$askdata") ) {
    	print TF "0\tDATANAME|$dataname\n"; 
    	print TF "0\tQUERY|$prettyquery\n"; 
			$selectmanyForm = &getResultsSelectManyDialog($dfile) if (!$selectmanyForm);
			$refineForm= &getRefineDialog($main'query,$prettyquery)  if (!$refineForm);
			local $footer = $selectmanyForm;
			$footer .= $refineForm if $refineForm;
			$footer =~ tr/\n/\t/;
    	print TF "0\tFOOTER|$footer\n"; 
    	close(TF);
    	}
    
    	## drop this for call in printResultList() ??
    if ($javaResList) {
			local(@myclasses) = ( "fbqueryj.jar", "jgl3.1.0.jar" );
			&initJavaEnv(@myclasses);
			
	 		$japp= "flybase.query.FbQuery";
			$jflags= "";
			$javaparms = "debug " . $javaparms if ($debug);
			$javaparms .= " maxhit=$main'maxhits" if ($main'maxhits);
			$javaparms .= " path=$dpath" if ($dpath);
			local($cmd)= "$javabin $jflags $japp $javaparms kind=querylist class=$fbidtag data=$dfile";
			print STDERR "putResultsList: $cmd\n" if $debug;
			system($cmd);
			unlink $envtemp;
			}
			
		else {
   		&printResultList( $dpath, $dfile, $main'maxhits, 1);
   		}
	
		## print $selform; ## print to tmp and have japp use
		}
}


sub makeReslistIndex { 
	local( $dpath, $dfile) = @_;
	$kIdxrecsize= 4;
	local($record)= pack("L", 5000);  # dummy to get fixed rec size
	$reslistIndexRecsize= length($record); ## 8 * 1 = 8

	## also put Batch download form at end of $dfile, if not there !??
	
  unless (open(DLIB, "<$dpath/$dfile")) {
    print STDERR " can't open $dpath/$dfile \n" if $debug;
		return &putNoResults("Error reading results data", 1);
		}
  unless (open(DIDX, ">$dpath/$dfile.idx")) {
    print STDERR " can't write $dpath/$dfile.idx \n" if $debug;
		return &putNoResults("Error writing results index", 1);
		}
  
  local $nrecords= 0; ##?? line count of $dfile
	## while ($_ = <DLIB>) { $nrecords++; } ## no need to read thru twice
  
  	## toprec -- nrecords && sortkey
	print DIDX pack("L", $nrecords);
	print DIDX pack("L", 0); # sort hash key
	
	seek(DLIB, 0, 0); ## rewind
	local  $at= 0;
	while ($_ = <DLIB>) { 
	  $nrecords++;
		print DIDX pack("L", $at);
	  $at= tell(DLIB);
		}
	print DIDX pack("L", $at);

	## do we need add this to $dfile ?
	## fprintf( outf, "0\tLISTINFO|matches=%d\tstart=%d\tend=%d\tquery=%s\n", 
	## 			maxN, startN, lastN, sQuery);  
	## oat= ftell( outf);
	## fwrite( &oat, sizeof(Int4), 1, oidx);  
	## fprintf( outf, "0\tLISTKEYS|%s\n", keys);  

	seek(DIDX, 0, 0); ## rewind
	print DIDX pack("L", $nrecords);
	
	close(DLIB);
	close(DIDX);
}


sub openResultList {
	local( $dpath, $dfile) = @_;
	$dataFile= $dfile;
	$dataPath= undef; ## if ($dpath =~ /tmp/) ???
	($dataPath= $dpath) =~ s/^$gopath// if ($dpath !~ /tmp/);
	
	$kIdxrecsize= 4;
	local($record)= pack("L", 5000);  # dummy to get fixed rec size
	$reslistIndexRecsize= length($record); ## 8 * 1 = 8

  unless (open(RLIB, "<$dpath/$dfile")) {
    print STDERR " can't open $dpath/$dfile \n" if $debug;
		return &putNoResults("Error reading results data", 1);
		}
		
	if (!open(RIDX, "<$dpath/$dfile.idx")) {
		&makeReslistIndex( $dpath, $dfile);
	  unless (open(RIDX, "<$dpath/$dfile.idx")) {
	    print STDERR " can't open $dpath/$dfile.idx \n" if $debug;
			return &putNoResults("Error reading results index", 1);
			}
	}
	
  read(RIDX, $record, $reslistIndexRecsize);
  ($nrecords) = unpack("L", $record);
	$toprecsize= 2 * $kIdxrecsize;
	print STDERR "nrecords= $nrecords\n" if $debug;
	return 0;
}

sub closeResultList {
	close(RLIB); 
	close(RIDX);
}

sub seekResultItem { 
	local($linenum)= @_;
	local($record);
	local($idxseek)= $toprecsize + $kIdxrecsize * ($linenum-1);
	seek(RIDX, $idxseek, 0);
  read(RIDX, $record, $reslistIndexRecsize);
  local($datseek) = unpack("L", $record);
	seek(RLIB, $datseek, 0);
}




sub getResultListInfo {
	local( $dpath, $dfile)= @_;
## at end of RLIB resultlist data -- not now ??
##0	LISTINFO|matches=983	start=1	end=983	query= [fbgenes-org:Dmel] & [fbgenes-all:wing] 
##0	LISTKEYS|ID	CLA	NAM	GSYM	DT	RESZ	PDOM	PTD	DBA	FNC	CEL	WT	CLOC	KLOC	ALESR	SK	REF	GLOC	HG	PDIS	FSQ	
##0	DATANAME|FlyBase Genes
##0	QUERY|  species=[Dmel] <i>and</i> all=[wing]  
##0	FOOTER|<FORM ACTION="/.bin/fbqmore.pl?-hdfbg1092&-f/.bin/fbgenrs" METHOD=POST>	<INPUT TYPE=submit VALUE="Fetch items">:	<INPUT TYPE=radio NAME=returnall VALUE=yes>All	<INPUT TYPE=radio NAME=returnall VALUE=no CHECKED>Items: 	<INPUT NAME=items VALUE=1 SIZE=8> (e.g., '1..5,10..11')	<BR>	Report style: <SELECT name=rstyle>	<option selected>short	<option>long	<option>abstract	<option>custom	<option>reftable		</SELECT>	Format: <SELECT name=format>	<option selected>text/html	<option>text/plain	<option>text/acode	<option>text/acode-pretty	<option>text/flybase-starcode		</SELECT>	</FORM>	<BR>	
	
	$footer= undef;
	$dataname= undef;
	
	&seekResultItem( $nrecords-1); ## seek last data line, to get FBid class !?
	while ($_ = <RLIB>) {
		chop;
		local($key,$val) = split(/\|/,$_,2);
		print STDERR "reslist info: $key | $val\n" if $debug;
		if ($key =~ /LISTINFO/) { 
			if ($val =~ /\tquery=([^\t]+)/) { $prettyquery= $1; }
			}
		elsif ($key =~ /DATANAME/) { $dataname= $val; }
		elsif ($key =~ /QUERY/) { $prettyquery= $val; }
		elsif ($key =~ /FOOTER/) { $footer= $val; $footer =~ tr/\t/\n/; }
		elsif ($key =~ /([A-z]{4})\d/) { $fbidtag=  $1; }
		elsif ($val =~ /([A-z]{4})\d/) { $fbidtag=  $1; }
		}
	if (!$footer) {
		local $ishead= ($dpath =~ m/headlines/);
		$footer = &getResultsSelectManyDialog($dfile,$ishead);
		}
}


sub getColHeader {
##		$sortKinds='KLOC=2|DT=3|RESZ=1|DBA=1|REF=1|SK=1|ALESR=1';
	local($doarray) = @_;
	local($s);
	if ($useBriefFields) { $s= $briefFields; } else { $s= $visibleFields; }
	local(@hd) = split(/\|/,$s);
	unshift(@hd, "#");
	local($nh)= $#hd;
	local($hl)= "";
	@headkeys= ();
	%headsize= ();
	
	%numIsVal= ();  # flag that we use count instead of val (drop val) of key_num_val triplet
	local(@sk) = split(/\|/,$sortKinds);
	foreach (@sk) {
		local($k, $v) = split(/=/, $_);
		$numIsVal{$k}= 1 if ($v == 1); ##? or other #v != 0 ??
		}
		
	for ($i=0; $i<=$nh; $i++) {
		local( $h, $w, $k, $t) ;
		$h= $hd[$i];
		if ($h eq "#") { $k= undef; $w= 4; }
		elsif ($h =~ /([^:]+):(\d+)=?(.+)/) { $k= $1; $w= $2; $t= $3; }	
		if ($t) { 
			$t =~ s/=(.+)//;
			$h= $t; $sortkey= $1 if ($1); 
		 	}
		push(@headkeys, $k) if ($k);
		$headsize{$k}= $w;
		$hd[$i]= $h;
		if (!$doarray && $h ne "#") {
			$hl .= $h . ' ';
			local $len= $w - length($h) - 1;
			if ($len>0) { $hl .=  substr('.....................................................',0,$len); }
			}
		}
	if ($doarray) { return @hd; }
	else { return $hl; }
}



sub getSRSQueryPipesOptions {
    local($idtag)=@_;
    return ''; 	###### not used yet for meow ...

  	local $name= $DBNamesList{$idtag};
  	return "" if (!$name);
  	
  	local $s= "<BR>Search <B>$name </B>, retrieve <SELECT NAME=\"srs_pipe\">\n";
    local $tag;
    foreach $tag ( keys(%DBNamesList) ) {
        if ( $idtag eq $tag ) { $s .= "<OPTION VALUE=\"\" SELECTED> ";  }
     		else { $s .= "<OPTION VALUE=\"$tag\"> Related ";  }
        $s .= $DBNamesList{$tag};
        }
    $s .= "</SELECT> only.\n";
    return $s;
}


sub putbutton {
	local( $label, $filler, $start, $dolink) = @_;
	$label =~ s|>|&gt;|g;
	$label =~ s|<|&lt;|g;

	if ($dolink) { 
		local $url= $reslisturl . '?';
		$url .= "start=" . $start . '&' if ($start>1) ;
		# $url .= "end=" . $enditem . '&' if ($enditem>1) ;
		$url .= "data=" . $dataFile . '&' if ($dataFile) ; 
		$url .= "maxhit=" . $pagesize . '&' if ($pagesize>0) ; 
		if ($dataPath =~ /headline/) { $url .= "head" . '&' ; }
		elsif ($dataPath) { $url .= "path=" . $dataPath . '&'; } 

		print "<A HREF=\"$url\">";
		print $label;
		print "</A>";
		}
	else { print  $label; }
	print $filler;
}



sub putpagebarNoTable {
##Go to item: [1] .. [&lt;&lt;&lt;] .. [&lt;1&lt;] .. <A HREF="/.bin/fbreslist?class=FBgn&start=41&style=16Br&maxhit=40&data=fbg1106.data">[&gt;41&gt;]</A> .. <A HREF="/.bin/fbreslist?class=FBgn&start=265&style=16Br&maxhit=40&data=fbg1106.data">[&gt;&gt;&gt;]</A> .. <A HREF="/.bin/fbreslist?class=FBgn&start=1017&style=16Br&maxhit=40&data=fbg1106.data">[1057]</A><BR>
	local($startN,$maxN,$pageSize)= @_;
	
	return if ($pageSize >= $maxN); 

  local($lastTop) = $maxN - $pageSize + 1; $lastTop= 1 if ($lastTop < 1) ;
  local($fastStep)= int($maxN / 4);
  $fastStep= $pageSize * 4 if ($fastStep < $pageSize * 4);
  
	print "Go to item: ";
  putbutton( "[1]"," .. ", 1, ($startN > 1) );
  
  local $at = $startN - $fastStep; $at= 1 if ($at < 1) ;
  putbutton( "[<<<]"," .. ", $at, ($at < $startN) );

  $at = $startN - $pageSize; $at= 1 if ($at < 1);
  putbutton( "[<" . $at . "<]"," .. ", $at, ($at < $startN) );

  $at = $startN + $pageSize;  $at= $lastTop if ($at > $lastTop);
  putbutton( "[>". $at .">]"," .. ", $at, ($at > $startN) );

  $at = $startN + $fastStep;  $at= $lastTop if ($at > $lastTop);
  putbutton( "[>>>]"," .. ", $at, ($at > $startN) );

  putbutton( "[" . $maxN . "]", "", $lastTop, ($lastTop > $startN ));
  
	print "<BR>\n";
}

sub putbuttonbox {
	local( $label, $clr, $start, $dolink) = @_;
	$label =~ s|>|&gt;|g;
	$label =~ s|<|&lt;|g;

	print "<TD BGCOLOR=\"$clr\">";
	if ($dolink) { 
		local $url= $reslisturl . '?';
		$url .= "start=" . $start . '&' if ($start>1) ;
		# $url .= "end=" . $enditem . '&' if ($enditem>1) ;
		$url .= "data=" . $dataFile . '&' if ($dataFile) ; 
		$url .= "maxhit=" . $pagesize . '&' if ($pagesize>0) ; 
		if ($dataPath =~ /headline/) { $url .= "head" . '&' ; }
		elsif ($dataPath) { $url .= "path=" . $dataPath . '&'; } 

		print "<A HREF=\"$url\">";
		print $label;
		print "</A>";
		}
	else { print  $label; }
	print "</TD>\n";
}

sub putpagebar {
	local($startN,$maxN,$pageSize)= @_;
	return if ($pageSize >= $maxN); 
  if ( $ENV{'FB_LIST_HSTYLE'} eq 'preformat' ) { &putpagebarNoTable($startN,$maxN,$pageSize); return; }
  
  local($lastTop) = $maxN - $pageSize + 1; $lastTop= 1 if ($lastTop < 1) ;
  local($fastStep)= int($maxN / 4);
  $fastStep= $pageSize * 4 if ($fastStep < $pageSize * 4);
  
	print <<EOF;
<A NAME=page>
<TABLE border=1  WIDTH="100%" CELPADDING=4 CELLSPACING=4><TR align=center>
<TD><B>Page to item</B></TD>
EOF
  putbuttonbox( "First page", "#d0d0f0", 1, ($startN > 1) );
  
  local $at = $startN - $fastStep; $at= 1 if ($at < 1) ;
  putbuttonbox( "Fast back\n <<< [$at]", "#e0e0f0", $at,  ($at < $startN) );

  $at = $startN - $pageSize; $at= 1 if ($at < 1);
  putbuttonbox( "Prior page\n < [$at]", "#e8e8f0", $at,  ($at < $startN));

  $at = $startN + $pageSize;  $at= $lastTop if ($at > $lastTop);
  putbuttonbox( "Next page\n > [$at]", "#f0e8e8",  $at, ($at > $startN));

  $at = $startN + $fastStep;  $at= $lastTop if ($at > $lastTop);
  putbuttonbox( "Fast forward\n >>> [$at]", "#f0e0e0",  $at, ($at > $startN));

  putbuttonbox( "Last page\n [$maxN]", "#f0d0d0", $lastTop, ($lastTop > $startN ));
	print "</TR></TABLE>\n";
}



sub printHeader {
		print <<XEOF;
<HTML><HEAD>
<TITLE>$dataname query results</TITLE>
<!-- printer: fbreslist perl module -->
</HEAD><BODY BGCOLOR="#ffffff" TEXT="#000000" >
<TABLE cols=8 WIDTH="100%" CELPADDING=4 CELLSPACING=4>
<TR align=center valign=middle>
<TH colspan=5><BIG>$dataname query results</BIG></TH>
<TD BGCOLOR="#f0d0d0"><A HREF=#page>Select<br>page</A></TD>
<TD BGCOLOR="#f0e8e8"><A HREF=#batch>Batch<br>download</A></TD>
XEOF
	print "<TD BGCOLOR=\"#e8e8f0\"><A HREF=#refine>Refine<br>query</A></TD>\n"
		if ($footer =~ m/refine/);
	print "</TR></TABLE><P>\n";
	print "Query: &nbsp; $prettyquery, &nbsp;" if $prettyquery;
	print "No. matches= $nrecords\n";
}


sub printResultsReports {
	local( $dpath, $dfile, $items, $repstyle, $contype) = @_;

		##? need gopher support
	print STDERR "printResultsReports: path=$dpath data=$dfile items=$items\n" if $debug;
	
	$err= &openResultList( $dpath, $dfile);
	if ($err) { return; }
	&getResultListInfo( $dpath, $dfile);

 	if ($items eq "*") { $items= "1..$nrecords"; }  # faster to just step thru RLIB
	local @list = ("1","2");
	$items =~ tr/ /,/;
	$items =~ s/--/-/g;
	$items =~ s/-/../g; ## let 1-5 work for eval()
	@list = eval("($items);");   # items in format "1,2,3..5,7,9..20"
	local $idlist= undef;
	
 	local ($item, $i);
  foreach $item (@list) {
		&seekResultItem( $item);
  	local $line = <RLIB>;
  	##print STDERR "item=$item line=$line" if $debug;
		if ($line =~ /([A-Za-z]{4}\d+)/) { 
			$idlist .= "+" if ($i>0);
			$idlist .= $1;
			$i++;
		  }
  	}
  	
	&closeResultList();

	if ($idlist) {
		if ($repstyle) { $idlist .=	 "&content=$repstyle"; }
		if ($contype) { $idlist .=	 "&mimetype=$contype"; }
  	## print STDERR "${idurl}?${idlist}\n" if $debug;
		return &redirectToUrl("${idurl}?${idlist}", 1);
		}
	else {
    print STDERR " no ids found in $askdata \n" if $debug;
		return &putNoResults("Error reading results to query '$prettyquery'", 1);
		}
	 
}

sub getCommonOrgName {
	local($val) = @_;
	return 'Fruitfly' if ($val eq 'DM');
        return 'Fruitfly' if ($val =~ /^Drosophila/i);
	return 'Human' if ($val =~ /^Homo sapiens/i);
	return 'Yeast' if ($val =~ /^Sacchar/i);
	return 'Mouse' if ($val =~ /^Mus /i);
	return 'Worm' if ($val =~ / elegans$/i);
	return 'Weed' if ($val =~ /^Arabidopsis/i);
	return 'Fish' if ($val =~ /^Danio/i);
	return $val;
}

sub printResultList {
	local( $dpath, $dfile, $pgsize, $startNum) = @_;
  local($str,$i);
  local($do_table)=0;

	$pagesize= $pgsize if ($pgsize>0);

  if ($javaResList || $ENV{'FB_QUERYLIST_X'}==1 ) {
		local(@myclasses) = ( "fbqueryj.jar", "jgl3.1.0.jar" );
		&initJavaEnv(@myclasses);
		
 		$japp= "flybase.query.FbQuery";
		$jflags= "";
		$javaparms = "debug " . $javaparms if ($debug);
		$javaparms .= " path=$dpath" if ($dpath);
		$javaparms .= " class=$fbidtag" if ($fbidtag);
		$javaparms .= " maxhit=$pagesize";
		$javaparms .= " start=$startNum" if ($startNum);
		local($cmd)= "$javabin $jflags $japp $javaparms kind=querylist data=$dfile";
		print STDERR "printResultList: $cmd\n" if $debug;
		system($cmd);
		unlink $envtemp;
		return;
		}
	
	print STDERR "printResultList: path=$dpath data=$dfile start=$startNum\n" if $debug;
	&putContentType();  
	$err= &openResultList( $dpath, $dfile);
	if ($err) { &printHeader(); return; }
	&getResultListInfo( $dpath, $dfile);
	&setClassVars($fbidtag);
	
  if( !($dohtml) ) { ## GOPHER
    ## for( $i=0; $i <= $#outarray; $i++) { print $outarray[$i]; }
    return; 
    }

  if( !$startNum || $startNum<1 ) { $startNum=1; }

  ## &out_html_hits_page(@outarray);
  
	&printHeader();

  if( $ENV{'FB_LIST_HSTYLE'} ne 'preformat' ) { $do_table=1; }  ## eq 'table' ??
  if( $do_table ) { 
		local(@heads)= &getColHeader(1);
    print "<TABLE WIDTH=\"100%\" CELPADDING=2 CELLSPACING=0>\n";
    print "<TR >"; 
    foreach $hd ( @heads ) { 
      print "<TH ALIGN=LEFT BGCOLOR=\"#DODODO\" >$hd</TH>";
      }
    print "</TR>\n";
    }    
  else { 
		local($colhdr)= &getColHeader(0);
  	print "<OL START=$startNum>\n";
		print "<PRE>$colhdr\n";  
		}

  local($irow, $linenum);
  local($more)= 1;
  while ($more)
  {
  	$lineno= $startNum + $irow;
  	$more= 0 if ($lineno > $nrecords);
  	$more= 0 if ($irow >= $pagesize);
  	last if (!$more);
  	$irow++;
  	
		&seekResultItem( $lineno);
  	$str = <RLIB>;
  	##$more= 0 if (!$str); 
  	
		if ($str) {
			$str =~ s|\n+$||;
			local @tparts = split(/\t/, $str, 999);
  	  if( $do_table ) { 
        $str = ($irow % 2 == 1) ? "<TR>" : "<TR BGCOLOR=\"#F0F0F0\">";
        print $str;
	      print "<TD ALIGN=RIGHT>". $lineno ."</TD>";
	      }
      else { print "<LI> "; }

      local($i);
      %vals= ();
  		$id= undef;
	    for ( $i=0; $i<=$#tparts; $i++ ) { 
				local $part= $tparts[$i];
				$part =~ s/^RETE\|//;
				if ($part =~ /^[A-Za-z]{4}\d/) { $id= $part; }
				else {
					($key,$num,$val)= split(' ',$part,3);
					# print STDERR "key=$key num=$num val=$val\n" if $debug;
					
					$key= 'SYM' if ($key eq "GSYM"); ## hack fix for FBgn
					$val= &getCommonOrgName($val) if ($key eq 'ORG');

					if ($key eq "ID") { $id= $val; }
					elsif (!$val || $numIsVal{ $key }) { $val= $num; }
					else { ($val) = &main'ConvertCodes( ($val) ); }
					}
				if ($headsize{$key}) { $vals{$key}= $val; }
				}
				
	    for ( $i=0; $i<=$#headkeys; $i++ ) { 
	    	local $key= $headkeys[$i];
				local $val= $vals{ $key };
				$val= "-" if (!$val || $val =~ m/^\s+$/); 
				local $dolink= 0;
				if (($key eq $gSymbolKey) && $id) {
					$dolink= 1;
					$url= $idurl . '?' . $id;
					}
				elsif (($key eq $gDbIDKey) && $val =~ /:/) {
					local($dbtag,$dbid)= split(/:/,$val);
					$url= $DBurls{$dbtag};
					$dolink= defined($url);
					$url =~ s/\%s/$dbid/;
					}
					
			  if( $do_table ) { 
					print '<TD>';
					print "<A HREF=\"$url\">" if ($dolink);
					print $val;
					print '</A>' if ($dolink);
					print '</TD>'; 
					}
			  else { 
					print "<A HREF=\"$url\">" if ($dolink);
				  print  $val;
					print '</A>' if ($dolink);
			    local $spc= ' ';
					local $len= $headsize{$key} - length($val) - 1;
					$spc .=  substr('                                         ',0,$len) if ($len>0);
 				  print $spc;
					}
				}
			
      if( $do_table ) {  print "</TR>"; }
		  }
    print " \n";
		}
		
  if ( $do_table ) { print "</TABLE>\n"; }
  else { print "</PRE></OL>\n"; }

	print "<HR align=center width=\"50%\">\n";

	&putpagebar( $startNum, $nrecords, $pagesize);
	
  print $footer if ($footer);

	print "</BODY></HTML>\n";
	
	&closeResultList();
}


sub initJavaEnv {
	local(@classes) = @_;
	
	$jlib = "$gopath/.etc/jlib";
	$envtemp = "$gopath/tmp/fbjava$$.env";
	
	if (!$contenttype) { $contenttype= $ENV{'CGI_CONTYPE'}; }
  if (!$contenttype) { $contenttype= $ENV{'CONTENT_TYPE'}; }
  if (!$contenttype) { $contenttype= "text/html"; }
	if ($contenttype eq "application/x-www-form-urlencoded") { $contenttype= "text/html"; } 
	
	$javapath= "$gopath/.totop/java-local/";
	if (! -d $javapath ) { 
		$javapath= "$gopath/.totop/bin-local/java/"; 
		if (! -d $javapath ) { $javapath= $ENV{"JAVA_HOME"}; }
		}
	if ( -d $javapath ) {  
	  $javabin= "$javapath/bin/java";
	  $javalib= "$javapath/lib/classes.zip";
	  }
	else {
		return &putNoResults("No java runtime available", $noexit);
		}
  ## ?? set $javalib from $ENV{"CLASSPATH"} ??
  
	$classpath= "$jlib";
	local($i);
	for ($i= 0; $i<=$#classes; $i++) {
		$classpath .= ":$jlib/" . $classes[$i];
		}
	$classpath .= ":$javalib";
	$ENV{"CLASSPATH"}= $classpath;
	print STDERR "CLASSPATH='$classpath'\n" if $debug;

	open(ENVF,">$envtemp");
	while (local($key,$val) = each %ENV) { print ENVF "$key=$val\n"; }
  close(ENVF);

	$javaparms= "httpcall mimetype=$contenttype env=${envtemp} ";
}





##
## from ? fbperls_add.pl -- need opt to use that
## 
sub getRefineDialog {
    local($query,$humquery)=@_;
   	$query=&main'URLescape($query);  
 
		local $selfurl= $0;
		if (index($selfurl,$gopath)==0) { 
			$selfurl= substr($selfurl, length($gopath)); 
			}

 		if( $main'srs_pipe2 ne "" ) {
  	  local $tag="\L$srs_pipe2";
 	    local $script= $ScriptsList{$tag};
 			if ($script) {
 				##$fbidtag= $tag;	 ## is this true?
 				$selfurl= "/.bin/" . $script; 
 				} 
 			}
    
    local $s = <<REOF_BEG
<A NAME=refine>
<FORM ACTION="$selfurl" METHOD="POST">
<TABLE BORDER=1 BGCOLOR="#e8e8f0" WIDTH="100%" CELPADDING=4 CELLSPACING=0>
<TR><TH><BIG>Refine query or find items in related data</BIG></TH></TR>
<TR><TD>
<INPUT TYPE="submit" VALUE="Refine query"> 
<I>$humquery</I>
<BR>
<SELECT NAME="common_or">
  <OPTION SELECTED>and
  <OPTION>or
  <OPTION>but not
</SELECT>
REOF_BEG
;
    $s .= &getRefineDialogByClass($fbidtag);
		$s .= &getSRSQueryPipesOptions($fbidtag);  
    
    $s .= <<REOF
<INPUT NAME=oldquery TYPE=hidden VALUE="$query">
<INPUT NAME=maxhit TYPE=hidden VALUE="$main'maxhits">
</TD></TR></TABLE>
</FORM>
REOF
;
    return $s;
}

sub getRefineDialogByClass
{
  local($_)=@_;
	local $s = <<REOF_BEG7
<SELECT NAME="xfieldname1">
<OPTION VALUE="all" >All data
<OPTION VALUE="synonym" SELECTED>Gene symbol/synonym
<OPTION VALUE="name">Gene name
<OPTION VALUE="funct">Gene function
<OPTION VALUE="struct">Gene structure
<OPTION VALUE="homology">Homology
<OPTION VALUE="id">Database ID
<OPTION VALUE="csome">Chromosome no.
<OPTION VALUE="gmap">Genetic map position
</SELECT>
matches <INPUT NAME="xfield1" SIZE=20>
REOF_BEG7
;
 
	return $s;
}



1;