#!/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 lib "../lib_files";
use bncLibCQPXML;
use DBI;

# connect to mysql
$bncHandle = DBI->connect("DBI:mysql:$bwMYSQLtable:$bwMYSQLhost:$bwMysqlPort", "$bwMysqlUser", "$bwMysqlPwd") or bark("Can't connect to mysql on $bwMYSQLhost at port: $bwMysqlPort <BR>$bncHandle::errstr\n");
$userHandle = DBI->connect("DBI:mysql:$bwMYSQLusertable:$bwMYSQLhost:$bwMysqlPort", "$bwMysqlUser", "$bwMysqlPwd") or bark("Can't connect to mysql on $bwMYSQLhost at port: $bwMysqlPort <BR>" . $userHandle::errstr);

$username = $ENV{'REMOTE_USER'};
$thisProg="sort_freqList.pl";

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");
}

# get default view from settings database (for link of individual items)
$sqlQuery = "SELECT view FROM settings where user='$username'";
$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;
$view = $rowArray[0];

# get where-part of the SQL-query
$check = $params{SQL} =~ m/\ASELECT .*? FROM .*? (WHERE .*?) ORDER BY/;
if ($check) {
	$whereStatement = $1;
} else {
	$whereStatement = "";
}

if ($params{ot}=~m/refnum·(\S+)/) {
	$ot=$1;
} else {
	$ot = $params{ot};
}

$SQLfreq = $params{SQL};
if ($params{display} eq "word") {
	$sql = "select distinct($ot) from $params{dbname} $whereStatement";
	$SQLfreq=~s/ORDER BY .*?\Z/GROUP BY $ot ORDER BY sum DESC/;
	$SQLfreq=~s/\ASELECT .*? FROM/SELECT $ot, count(*) as sum FROM/;
	$showType = "Lexical items";
	$FBshow = "lexical items";
} elsif ($params{display} eq "tag") {
	$sql = "select distinct(tag$ot) from $params{dbname} $whereStatement";
	$SQLfreq=~s/ORDER BY .*?\Z/GROUP BY tag$ot ORDER BY sum DESC/;
	$SQLfreq=~s/\ASELECT .*? FROM/SELECT tag$ot, count(*) as sum FROM/;
	$showType = "POS-tag";
	$FBshow = "tags";
} elsif ($params{display} eq "both") {
	$sql = "select distinct(CONCAT($ot, tag$ot)) from $params{dbname} $whereStatement";
	$SQLfreq=~s/ORDER BY .*?\Z/GROUP BY $ot, tag$ot ORDER BY sum DESC/;
	$SQLfreq=~s/\ASELECT .*? FROM/SELECT CONCAT($ot, "_", tag$ot), count(*) as sum FROM/;
	$showType = "Word and POS-tags";
	$FBshow = "word and tag combinations";
}
$begin = ($params{pager} * 50);

%positions = (
	"before5" => "5 left",
	"before4" => "4 left",
	"before3" => "3 left",
	"before2" => "2 left",
	"before1" => "1 left",
	"node" => "node",
	"after1" => "1 right",
	"after2" => "2 right",
	"after3" => "3 right",
	"after4" => "4 right",
	"after5" => "5 right"
);
$showPosition = $positions{$ot};

# determine types and tokens of the db (depending on which restrictions are valid)
$sth = $userHandle->prepare($sql) or barkfull("Can't prepare $sql: " . $userHandle::errstr);
$sth->execute or bark("Can't execute $sql: $sth::errstr");
$totalRows = $sth->rows;

$sql = "select count(*) from $params{dbname} $whereStatement";
$sth = $userHandle->prepare($sql) or barkfull("Can't prepare $sql: " . $userHandle::errstr);
$sth->execute or bark("Can't execute $sql: $sth::errstr");
@rowArray=$sth->fetchrow_array;
$total=$rowArray[0];

$lastPage = int($totalRows / 50);

$downloadSQL = $SQLfreq;

$sql = $SQLfreq . " LIMIT $begin, 50";
$sth = $userHandle->prepare($sql) or barkfull("Can't prepare $sql: " . $userHandle::errstr);
$sth->execute or bark("Can't execute $sql: $sth::errstr");
$resArrayResult=$sth->fetchall_arrayref or barkfull("Can't fetch $sqlQuery: " . $sth::errstr);

$theString=$resArrayResult->[0][0];
if (($theString=~m/ /) && ($params{display} eq "both")) {
	print "Content-type: text/html\n\n";
	print <<END;
	<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2 Final//EN">
	<HTML>
	<HEAD>
	
	<TITLE>Frequency Breakdown Error</TITLE>
	
	<META NAME="generator" CONTENT="BBEdit 4.5">
	<meta http-equiv="content-type" content="text/html; charset=ISO-8859-1">
	</HEAD>
	<BODY BGCOLOR="#FFFFFF">
		<H2>
			The node consists of more than one word.
		</H2>
		<B>Sorting on word - tag combinations is therefore impossible.</B>
END
	&printFooter();
	exit(0);
}
	
$optionSelector="";

$history=$params{thMode};
$history=~s/(\W)/sprintf("%%%x", ord($1))/eg;

# pager and $params{ot}

$originalDisplay = $params{display};
unless ($params{display} eq "tag") {
	setParam("display", "tag");
	$theURL = getURLparams();
	$thing = 'Location: /' . $bwCGIalias . '/' . $thisProg . '?' . $theURL . "&urlTest=yes\n\n";
	$optionSelector .= "<OPTION SELECTED VALUE=\"$thing\">Frequency breakdown of tags only";
	setParam("display", "$originalDisplay");
}
unless ($params{display} eq "both") {
	setParam("display", "both");
	$theURL = getURLparams();
	$thing = 'Location: /' . $bwCGIalias . '/' . $thisProg . '?' . $theURL . "&urlTest=yes\n\n";
	$optionSelector .= "<OPTION VALUE=\"$thing\">Frequency breakdown of word and tag combinations";
	setParam("display", "$originalDisplay");
}
unless ($params{display} eq "word") {
	setParam("display", "word");
	$theURL = getURLparams();
	$thing = 'Location: /' . $bwCGIalias . '/' . $thisProg . '?' . $theURL . "&urlTest=yes\n\n";
	$optionSelector .= "<OPTION VALUE=\"$thing\">Frequency breakdown of lexical items only";
	setParam("display", "$originalDisplay");
}
$theURL = getURLparams();

if ($params{sorttype} eq "direct") {
	$thing = 'Location: /' . $bwCGIalias . '/main.pl?' . $theURL . "&urlTest=yes\n\n";
	$optionSelector .= "<OPTION VALUE=\"$thing\">Show hits sorted by node";
} else {
	$thing = 'Location: /' . $bwCGIalias . '/main.pl?' . $theURL . "&urlTest=yes\n\n";
	$optionSelector .= "<OPTION VALUE=\"$thing\">Back to sorted result";
}

$thing = 'Location: /' . $bwCGIalias . '/BNCquery.pl?theQuery=search&urlTest=yes';
$optionSelector .= "<OPTION VALUE=\"$thing\">New Query";

# print navigation
$startFont="<FONT SIZE=3 FACE=\"Arial, Helvetica\"><B>";
$endFont="</B></FONT>";
$navBar="";
$beg = '<A HREF="/' . $bwCGIalias . "/${thisProg}?";

$originalPager = $params{pager};
if ($params{pager} > 0) {
	$navBar .= "<TD WIDTH=5%\" BGCOLOR=\"#DDDDDD\" NOWRAP><P ALIGN=\"CENTER\">";
	setParam("pager", "0");
	$theURL = getURLparams();
	$navBar .= $beg . $theURL . '&urlTest=yes">' . ${startFont} . '&nbsp;l&lt;&nbsp;' . $endFont . '</A></TD>';
	
	$newPager = $originalPager - 1;
	setParam("pager", "$newPager");
	$theURL = getURLparams();
		
	$navBar .= "<TD WIDTH=5%\" BGCOLOR=\"#DDDDDD\" NOWRAP><P ALIGN=\"CENTER\">";
	$navBar .= $beg . $theURL . '&urlTest=yes">' . ${startFont} . '&nbsp;&lt;&lt;&nbsp;' . $endFont . '</A></TD>';
} else {
	$navBar .= "<TD WIDTH=5%\" BGCOLOR=\"#DDDDDD\" NOWRAP><P ALIGN=\"CENTER\">${startFont}&nbsp;l&lt;&nbsp;</TD>";
	$navBar .= "<TD WIDTH=5%\" BGCOLOR=\"#DDDDDD\" NOWRAP><P ALIGN=\"CENTER\">${startFont}&nbsp;&lt;&lt;&nbsp;</TD>";
}

if (($begin + 50) < $totalRows) {
	$newPager = $originalPager + 1;
	setParam("pager", "$newPager");
	$theURL = getURLparams();
	$navBar .= "<TD WIDTH=5%\" BGCOLOR=\"#DDDDDD\" NOWRAP><P ALIGN=\"CENTER\">";
	$navBar .= $beg . $theURL . '&urlTest=yes">' . ${startFont} . '&nbsp;&gt;&gt;&nbsp;' . $endFont . '</A></TD>';
	
	setParam("pager", "$lastPage");
	$theURL = getURLparams();
	$navBar .= "<TD WIDTH=5%\" BGCOLOR=\"#DDDDDD\" NOWRAP><P ALIGN=\"CENTER\">";
	$navBar .= $beg . $theURL . '&urlTest=yes">' . ${startFont} . '&nbsp;&gt;I&nbsp;' . $endFont . '</A></TD>';
} else {
	$navBar .= "<TD WIDTH=5%\" BGCOLOR=\"#DDDDDD\" NOWRAP><P ALIGN=\"CENTER\">${startFont}&nbsp;&gt;&gt;&nbsp;</TD>";
	$navBar .= "<TD WIDTH=5%\" BGCOLOR=\"#DDDDDD\" NOWRAP><P ALIGN=\"CENTER\">${startFont}&nbsp;&gt;I&nbsp;</TD>";
}

setParam("pager", "$originalPager");

$theURL = getURLparams();
$downloadSQL = &encodeForm($downloadSQL);

$thing = 'Location: /' . $bwCGIalias . '/sort_freqList_download.pl?downloadSQL=' . $downloadSQL . "&total=" . $total . "&showPosition=" . $showPosition .  "&" . $theURL . "&urlTest=yes\n\n";
$download = "<INPUT TYPE=\"HIDDEN\" NAME=\"forDownload\" SIZE=\"-1\" VALUE=\"$thing\"> ";


if ($totalRows == 1) {
	$showRows = "type";
} else {
	$showRows = "types";
}
if ($total == 1) {
	$showTokens = "token";
} else {
	$showTokens = "tokens";
}

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

<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2 Final//EN">
<HTML>
<HEAD>

<TITLE>Frequency Breakdown</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" CELLPADDING=3 CELLSPACING=2 WIDTH="100%">
		<TR>
			<TD HEIGHT="21" BGCOLOR="#CCCCFF" COLSPAN="6">
				<BIG><B>Frequency breakdown of $FBshow for position \"$showPosition\" ($totalRows $showRows and $total $showTokens)</B></BIG> 
			</TD>
		</TR>
		<TR WIDTH="100%">
			$navBar
			<FORM ACTION="/$bwCGIalias/dlogs2.pl" METHOD=GET>
			<TD BGCOLOR="#DDDDDD" ALIGN="CENTER">
				
					<SELECT NAME="selected">
						$optionSelector
					</SELECT>
					<INPUT TYPE="SUBMIT" VALUE="Go!">
				
			</TD>
			</FORM>
			<FORM ACTION="/$bwCGIalias/dlogs2.pl" METHOD=GET>
			<TD BGCOLOR="#DDDDDD" ALIGN="CENTER">
				
					$download
					<INPUT TYPE="Submit" VALUE="Download whole table">
				
			</TD>
			</FORM>
		</TR>
	</TABLE>
	<TABLE BORDER="0" CELLPADDING=3 CELLSPACING=2 WIDTH="100%">
	<TR BGCOLOR="#FFCC66">
		<TD WIDTH="6%">
			<B>No.</B>
		</TD>
		<TD>
			<B>$showType</B>
		</TD>
		<TD ALIGN="MIDDLE">
			<B>No. of occurrences</B>
		</TD>
		<TD ALIGN="MIDDLE">
			<B>Percent</B>
		</TD>
	</TR>
END

if ($params{display} eq "word") {
	$add1 = "$ot = \'·ª¨\' ORDER BY beginPosition";
} elsif ($params{display} eq "tag") {
	$add1 = "tag$ot = \'·ª¨\' ORDER BY beginPosition";
} elsif ($params{display} eq "both") {
	$add1 = "$ot = \'·ª¨\' and tag$ot = \' ½¡\' ORDER BY beginPosition";
}

if (!$whereStatement) {
	$sql2 = "select $bwMYSQLusertable.$params{dbname}.beginPosition, $bwMYSQLusertable.$params{dbname}.endPosition INTO OUTFILE '/$bwMySQLTempPath/$params{dbname}_new' from $params{dbname} WHERE " . $add1;
} else {
	$sql2 = "select $bwMYSQLusertable.$params{dbname}.beginPosition, $bwMYSQLusertable.$params{dbname}.endPosition INTO OUTFILE '/$bwMySQLTempPath/$params{dbname}_new' from $params{dbname} $whereStatement AND " . $add1;
}

loop: for $k ( 0 .. ($#{$resArrayResult}) ) {
	$theString=$resArrayResult->[$k][0];
	$theFrequency=$resArrayResult->[$k][1];
	if ($theString) {
		$sql3=$sql2;
		$thing=$theString;
		$thing =~ s/\*( \*)?//;
		$thing =~ s/\s{2,}/ /g;
		$thing=~s/'/\\'/g;
		if ($params{display} eq "both") {
			$thing=~m/\A([^_]+)_(\S+)/;
			$thing = $1;
			$thing2 = $2;
		} else {
			$thing2="";
		}
		
		$sql3 =~ s/\·\ª\¨/$thing/;
		$sql3 =~ s/\ \½\¡/$thing2/;
		$sql3 =~ s/(\W)/sprintf("%%%x", ord($1))/eg;
		
		if (!$theString) {
			$theString = "&lt;NO ITEM&gt;";
		}
		
		$history=$params{thMode};
		$history .= "##U$theString#$theFrequency#$params{display}";
		$history =~ s/(\W)/sprintf("%%%x", ord($1))/eg;

		$theLink = "<A HREF=\"/$bwCGIalias/main.pl?program=complex&theData=$paramsEnc{theData}&dbname=$paramsEnc{dbname}&chunk=1&inst=$paramsEnc{inst}&max=INIT&qname=$paramsEnc{qname}&queryID=$paramsEnc{queryID}&SQL=$sql3&view=$view&thMode=$history&theID=$paramsEnc{theID}&urlTest=yes\">$theString<\/A>";
		$number = ($params{pager} * 50) + $k + 1;
		$percent = int((($theFrequency / $total) * 10000) + 0.5)/ 100;
		print <<END;
			<TR>
				<TD BGCOLOR="#DDDDDD">
					$number
				</TD>
				<TD BGCOLOR="#DDDDDD">
					$theLink
				</TD>
				<TD ALIGN="MIDDLE" BGCOLOR="#DDDDDD">
					$theFrequency
				</TD>
				<TD ALIGN="MIDDLE" BGCOLOR="#DDDDDD">
					${percent}%
				</TD>
			</TR>
END

	}
}
print "</TABLE>\n";

&printFooter();
exit(0);
