#!/usr/bin/perl
#
# BNCweb: A user-friendly interface to the British National Corpus - Version 4.3
# Copyright (C) 2005-10 Hoffmann/Evert/Lehmann
#
# Updates and information available at http://www.bncweb.info
#
# This file is part of BNCweb.
# 
# BNCweb is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 3 of the License, or
# (at your option) any later version.
# 
# BNCweb is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
# 
# You should have received a copy of the GNU General Public License
# along with this program.  If not, see <http://www.gnu.org/licenses/>.

#
# based on BNCweb Version 2.0:
# © 1996/2004 Lehmann/Hoffmann/Schneider
#

use Socket;

use lib "../lib_files";
use bncLibCQPXML;

### no longer supported -- check if some regexps need //m modifier
# $*=1; 
	
unless (getParams($ENV{'QUERY_STRING'})) {
	barkFull("incomplete transmition of URL<BR>This problem is likely to occur in combination with proxy servers<BR>turn off your web-proxy and try again");
}

# connect to mysql
$bncHandle = DBI->connect("DBI:mysql:$bwMYSQLtable:$bwMYSQLhost:$bwMysqlPort", "$bwMysqlUser", "$bwMysqlPwd");


print "Content-type: text/html\n\n";
print <<END;

<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2 Final//EN">
<HTML>
<HEAD>
	<TITLE>BNC Word-Lookup Result</TITLE>

	<META NAME="generator" CONTENT="BBEdit 4.5">
	<meta http-equiv="content-type" content="text/html; charset=ISO-8859-1">
</HEAD>

<BODY BGCOLOR="#FFFFFF">
<TABLE BORDER="0" WIDTH="100%" CELLPADDING=3 CELLSPACING=2>
END

#setParam("theData", &decURL($params{theData}));

$theDataL = $params{theData};
$theDataL =~ s/</&lt;/g;
$theDataL =~ s/>/&gt;/g;



if ($params{max} ne "INIT") {
	if ( ($params{max} < $params{chunk}) || ($params{chunk} < 1) ) {
		wrongInput();
	}
}

#SETTINGS
$thisProg  = "lookup.pl";
$newQuery  = "BNCquery.pl";
$main      = "main.pl";

# call solve (gets and prints the solutions and more)
solve($params{theData}, $params{chunk}, $params{inst}, $params{searchtype}, $params{lemmaScheme});

# print the end of html
&printFooter();

# say goodbye
exit (0);

sub solve {
	local($input, $chunk, $inst, $searchtype, $lemma)=@_;
	local($query, $response, $numOfSolutions);
	
	
	if ($lemma eq "no") {
		$theTable = "allWordsT";
		$wordOrLemma = "word";
	} elsif ($lemma eq "lancaster") {
		$theTable = "allLemma";
		$wordOrLemma = "lemma";
	}
	
	if ($searchtype eq "beginning") {
		$searchItem = $input . "%";
		$sqlQuery= "SELECT count(*) FROM $theTable where $wordOrLemma like '$searchItem'";
	} elsif ($searchtype eq "containing") {
		$searchItem = "%" . $input . "%";
		$sqlQuery= "SELECT count(*) FROM $theTable where $wordOrLemma like '$searchItem'";
	} elsif ($searchtype eq "end") {
		$searchItem = "%" . $input . "\\_%";
		$sqlQuery= "SELECT count(*) FROM $theTable where $wordOrLemma like '$searchItem'";
	} elsif ($searchtype eq "exact") {
		$searchItem = $input . "\\_%";
		$sqlQuery= "SELECT count(*) FROM $theTable where $wordOrLemma like '$searchItem'";
	} else {

	}



	$sth = $bncHandle->prepare($sqlQuery) or bark("Can't prepare $sqlQuery: " . $bncHandle::errstr);
	$sth->execute or bark("Can't execute $sqlQuery: ". $sth::errstr);
	@rowArray=$sth->fetchrow_array;
	$numOfSolutions=$rowArray[0];

	
	# no words match
	if (! $numOfSolutions) {
		print <<THEBLURB;
			<TR>
				<TD HEIGHT="27" BGCOLOR="#CCCCFF"> <FONT SIZE="4"><B>BNC Word-Lookup Result</B></FONT></TD>
			</TR>

			<TR>
				<TD>
					<B>Your lookup for<B> $theDataL</B> has no solutions</B>
				</TD>
			</TR>
		</TABLE>
THEBLURB
		&printFooter();
		exit(0);
	}
	
	
	print <<END;
	<TR>
		<TD COLSPAN="7" HEIGHT="27" BGCOLOR="#CCCCFF">
			<BIG><B>Your lookup &quot;$theDataL&quot; has $numOfSolutions hits.</B></BIG>&nbsp;&nbsp; [Matches are not case-sensitive]
		</TD>
	</TR>
END



	if ($inst ne "show hits") {
		if ( ($inst ne "show all") || (($numOfSolutions / $inst) > 1))  {
			# set s number of start end end
			$start = ($chunk * $inst) - ($inst);
			$end = (($chunk+1) * $inst) - ($inst);
			$end = $numOfSolutions if ($end > $numOfSolutions);
		} else {
			$start = 0;
			$end = $numOfSolutions;
		}
		
		# create links
		if ( ($inst ne "show all") || (($numOfSolutions / $inst) > 1) ) {
			
			$div = ($numOfSolutions / $inst);
			$divInt = int($div);
			$divInt = $divInt + 1  if ($div > $divInt);
			setParam("max", "$divInt");
			
			$theLink = '<A HREF="/' . $bwCGIalias . '/' . $thisProg . '?XYZ2">';
			$link = "theData\=$paramsEnc{theData}&chunk=XXZ1&inst=$inst&max=$paramsEnc{max}&view=$params{view}&searchtype=$searchtype&lemmaScheme=$lemma&urlTest=yes";
			$theLink =~ s/XYZ2/$link/o;
			$navBar = "";
			$startFont="<FONT SIZE=3 FACE=\"Arial, Helvetica\"><B>";
			$endFont="</B></FONT>";
			
			if (($chunk -1) >= 1) {
				$theLink1 = $theLink;
				$i = $chunk - 1;
				$theLink1 =~ s/XXZ1/$i/;
				$navBar.= "<TD WIDTH=\"3%\" BGCOLOR=\"#DDDDDD\" NOWRAP><P ALIGN=\"CENTER\">${theLink1}$startFont&nbsp;&lt;&lt;&nbsp;$endFont</A></TD>\n";
			} else {
				$navBar.= "<TD WIDTH=\"3%\" BGCOLOR=\"#DDDDDD\" NOWRAP><P ALIGN=\"CENTER\">$startFont&nbsp;&lt;&lt;&nbsp;$endFont</TD>\n";
			}
			if (($chunk +1) <= $divInt) {
				$theLink1 = $theLink;
				$i = $chunk +1;
				$theLink1 =~ s/XXZ1/$i/;
				$navBar.= "<TD WIDTH=\"3%\" BGCOLOR=\"#DDDDDD\" NOWRAP><P ALIGN=\"CENTER\">${theLink1}$startFont&nbsp;&gt;&gt;&nbsp;$endFont</A></TD>\n";
			} else {
				$navBar.= "<TD WIDTH=\"3%\" BGCOLOR=\"#DDDDDD\" NOWRAP><P ALIGN=\"CENTER\">$startFont&nbsp;&gt;&gt;&nbsp;$endFont</TD>\n";
			}
			
			if ($chunk != 1) {
				$theLink1 = $theLink;
				$theLink1 =~ s/XXZ1/1/;
				$navBar = "<TD WIDTH=\"3%\" BGCOLOR=\"#DDDDDD\" NOWRAP><P ALIGN=\"CENTER\">${theLink1}$startFont&nbsp;I&lt;&nbsp;$endFont</A></TD>$navBar\n";
			} else {
				$navBar = "<TD WIDTH=\"3%\" BGCOLOR=\"#DDDDDD\" NOWRAP><P ALIGN=\"CENTER\">$startFont&nbsp;I&lt;&nbsp;$endFont</TD>$navBar\n";
			}
			
			if ($chunk < $divInt) {
				$theLink1 = $theLink;
				$i = $chunk +1;
				$theLink1 =~ s/XXZ1/$divInt/;
				$navBar.= "<TD WIDTH=\"3%\" BGCOLOR=\"#DDDDDD\" NOWRAP><P ALIGN=\"CENTER\">${theLink1}$startFont&nbsp;&gt;I&nbsp;$endFont</A></TD>\n";
			} else {
				$navBar.= "<TD WIDTH=\"3%\" BGCOLOR=\"#DDDDDD\" NOWRAP><P ALIGN=\"CENTER\">$startFont&nbsp;&gt;I&nbsp;$endFont</TD>\n";
			}
			
			&printNavigation();
		}
		
		
		if ($lemma eq "lancaster") {
			$wordCaption="Lemma tag";
			$wordOrLemmaDisplay="Lemma";
		} else {
			$addTD='';
			$wordCaption="Tag(s)";
			$wordOrLemmaDisplay="Word";
		}
		

		print <<END;
		<TABLE WIDTH="100%" CELLPADDING=3>
			<TR>
				<TD ALIGN="MIDDLE" WIDTH="6%" BGCOLOR="#FFCC66">
					<B>No</B>
				</TD>
				<TD BGCOLOR="#FFCC66">
					<B>$wordOrLemmaDisplay</B>
				</TD>
				<TD WIDTH="10%" ALIGN="MIDDLE" BGCOLOR="#FFCC66">
					<B>N in BNC</B>&nbsp;&nbsp;&nbsp;
				</TD>
				<TD BGCOLOR="#FFCC66">
					<B>$wordCaption</B>
				</TD>
			</TR>
END
		$printCount =0;
		$n = $end - $start;
		$sqlQuery = "SELECT $wordOrLemma, freq, SUBSTRING_INDEX($wordOrLemma, '_', 1) as wordOnly FROM $theTable where $wordOrLemma like '$searchItem' order by wordOnly limit $start, $n";
		$sth = $bncHandle->prepare($sqlQuery) or bark("Can't prepare $sqlQuery:" . $bncHandle::errstr);
		$sth->execute or bark("Can't execute $sqlQuery:" . $sth::errstr);
		$resArrayResult=$sth->fetchall_arrayref;
		
		theLoop: foreach $i (0 .. $n-1) {
			$printCount++;
			$solutionNum = $start + $i;
			$counter = ($solutionNum + 1);

			$theWord=$resArrayResult->[$i][0];
			$wordFrequency=$resArrayResult->[$i][1];
			$wordForm = $resArrayResult->[$i][2];
			
			
			$theWord=~m/\A([^_]+)_/;
			$word = $1;
			$pos = $';
			$pos=~s/_/-/;
			$wordshow = $word;
			$wordshow = lc($wordshow);

			$theLink = '<A HREF="/' . $bwCGIalias . '/processQuery.pl?queryType=simple&qMode=Simple+query+(ignore+case)&qtype=0&thMode=INIT&theData=XYZ2&chunk=1&inst=50&max=INIT&qname=INIT&urlTest=yes">';
			$theQuery=~s/(\W)/sprintf("%%%x", ord($1))/eg;
			$theQuery=~s/ /+/g;
			# this has to be fixed for lemma search as well
			$theLink=~s/XYZ2/$word/;
			@posArray=split(/\s/,$pos);
			$counter1=$i+1;
			print <<END;
				<TR VALIGN="Top" BGCOLOR="#DDDDDD">
					<TD ALIGN="RIGHT">
						<B>$counter</B>
					</TD>
					<TD>
						$theLink<B>$wordshow</B></A>
					</TD>
					<TD ALIGN="RIGHT">
						${wordFrequency}&nbsp;&nbsp;&nbsp;
					</TD>
					
					<TD>
END
			$theLink = '<A HREF="/' . $bwCGIalias . '/processQuery.pl?queryType=simple&qMode=Simple+query+(ignore+case)&qtype=0&thMode=INIT&theData=XYZ2&chunk=1&inst=50&max=INIT&qname=INIT&urlTest=yes">';
			if ($lemma eq "lancaster") {
				$theQuery = "\{${word}/$pos\}";
			} else {
				$theQuery = "${word}_$pos";
			}
			$theQuery=~s/(\W)/sprintf("%%%x", ord($1))/eg;
			$theQuery=~s/ /+/g;
			
			$theLink=~s/XYZ2/$theQuery/;
			print " $theLink<B>$pos</B></A> ";
			print "</TD>$showPos</TR>";
		}
		print '</TABLE>';
	}

}


sub printIt {
	# Aufbereiten der s units von sara
	# drucken der Context links
	local($line, $lineIndicator) = @_;
	$lineIndicator++;
	($ok, $text, $num, $offset, $len, $pos, $str)=split(/\s/, $line, 7);
	$ref = "$text $num";
	$theRetrData = substr($str, $offset, $len);
	substr($str, $offset, $len) = "<B>$theRetrData<\/B>";
	$line=$str;
	# clean the result for display
	$line =~ s/\&equo/\"/go;
	$line =~ s/\&bquo/\"/go;
	$line =~ s/\&mdash/\-\-/go;
	$line =~ s/( )+/ /go;
	$line =~ s/<s\s[^>]+>//g;
	$link = "$ref%201%20INIT%20$theRetrData";
	$link =~ s/ /%20/go;
	$link = "<A HREF=\"/$bwCGIalias/${dispClean}?${link}&urlTest=yes\">";
	print '<TR VALIGN="Top"><TD><B>' . "$lineIndicator</B></TD>". '<TD NOWRAP>' . "$link$ref </A></TD>";
	print "<TD>$line</TD></TR>";
	
}

sub printNavigation {
	print <<THETEXT;
			<TR>
				$navBar

				<TD WIDTH="15%" ALIGN="MIDDLE" BGCOLOR="#DDDDDD" NOWRAP>
					Page $chunk / $divInt
				</TD>
				
				<FORM ACTION="/$bwCGIalias/${thisProg}" METHOD="GET">
					<TD WIDTH="26%" BGCOLOR="#DDDDDD" NOWRAP>
						<INPUT TYPE="hidden" NAME="theData" VALUE="$params{theData}">
							&nbsp;Show page number (1 to $divInt):
						<INPUT TYPE="text" NAME="chunk" VALUE="1" SIZE=8>
							&nbsp;
						<INPUT TYPE="hidden" NAME="inst" VALUE="$inst">
						<INPUT TYPE="hidden" NAME="max" VALUE="$params{max}">
						<INPUT TYPE="hidden" NAME="searchtype" VALUE="$searchtype">
						<INPUT TYPE="hidden" NAME="lemma" VALUE="$lemma">
						<INPUT TYPE="hidden" NAME="urlTest" VALUE="yes">
						<INPUT TYPE="submit" VALUE="Do it">
							
					</TD>
				</FORM>

				<FORM ACTION="/$bwCGIalias/dlogs.pl" METHOD=GET>
					<TD NOWRAP BGCOLOR="#DDDDDD">
						<SELECT NAME="selected">
							<OPTION VALUE="HelpLookup">Help</OPTION>
							<OPTION>New Lookup</OPTION>
							<OPTION SELECTED>New Query</OPTION>
						</SELECT>
						<INPUT TYPE="hidden" NAME="urlTest" VALUE="yes">
						<INPUT TYPE="SUBMIT" VALUE="Go!">
		 			</TD>
 				</FORM>

			</TR>
		</TABLE>
THETEXT

}

sub wrongInput {

	print <<FOUL;
	Page $chunk is not a valid page!! Please select a page within the range indicated!<BR>
FOUL
	&printFooter();
	exit(0);
}
