#!/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;

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

$username = $ENV{'REMOTE_USER'};
	
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");
}

$theQuery= $params{input};

$crlf = &linefeed();


#$bncHandle->disconnect;

if ($params{freqType} eq "word") {
	$theTags="";
	$tagLink="";
	$Text = "Words tagged as ";
	while ($theQuery =~ m/&tag=([^&]+)/g) {
		$tag=$1;
		$tagLink .= $&;
		$tag =~ s/%([\dA-Fa-f][\dA-Fa-f])/pack ("C", hex ($1))/eg;
		
 		# This list implements some rather odd decisions in the BNC!
		$check = 0;
		if ($tag eq "VERB") {
			$Text .= "any verb, ";
			$theTag = "V..";
		} elsif ($tag eq "SUBST") {
			$Text .= "any noun, ";
			$theTag = "(N[NP].|ZZ0)";
		} elsif ($tag eq "CONJ") {
			$Text .= "any conjunction, ";
			$theTag = "CJ.";
		} elsif ($tag eq "ADJ") {
			$Text .= "any adjective, ";
			$theTag = "(AJ.|CRD|DT0|ORD)";
		} elsif ($tag eq "ADV") {
			$Text .= "any adverb, ";
			$theTag = "(AV.|XX0)";
		} elsif ($tag eq "PRON") {
			$Text .= "any pronoun, ";
			$theTag = "(DPS|DT[SQ]|EX0|PN.)";
		} elsif ($tag eq "STOP") {
			$Text .= "any punctuation, ";
			$theTag = "(POS|PU.)";
		} elsif ($tag eq "ART") {
			$Text .= "any article, ";
			$theTag = "AT0";
		} elsif ($tag eq "PREP") {
			$Text .= "any preposition, ";
			$theTag = "(PR.|TO0)";
		} else {
			$Text .= "$tag, ";
			$theTag = $tag;
			$check++;
		}

		if ($check) {
			$theTags .="\|\^_$theTag\$";
			$simplified = 0;
		} else {
			$theTags .="\|\^_$theTag";
			$simplified = 1;
		}
		
	}
	if ($theTags=~m/\|/) {
		$Text =~ s/, \Z/##/;
		$theTags =~ s/\A\|//;
		$theTags = "tag REGEXP '" . $theTags . "' ";
	} else {
		$Text = "Words##";
	}
	
} else {
	$theLemma="";
	$lemmaLink="";
	$Text = "Lemmata tagged as ";
	while ($theQuery =~ m/&lemma=([^&]+)/g) {
		$lemma=$1;
		$lemmaLink .= $&;
		$lemma =~ s/%([\dA-Fa-f][\dA-Fa-f])/pack ("C", hex ($1))/eg;
		$theLemma .= "OR lemma regexp '_$lemma' ";
		$Text .= "$lemma, ";
	}
	if ($theLemma=~m/OR/) {
		$Text =~ s/, \Z/##/;
	}
	$Text = "Lemmata##" if ($Text=~/all##/);
	$theLemma =~ s/\AOR //;
	$showLemma = 1;
}

if ((!$params{minValue}) && ($params{maxValue})) {
	setParam("minValue", "$params{maxValue}");
	setParam("maxValue", "");
}


if (($params{minValue} > $params{maxValue}) && ($params{maxValue})) {
	$check=$params{minValue};
	setParam("minValue", "$params{maxValue}");
	setParam("maxValue", "$check");
}

$range = "";
if (($params{minValue}) && (!$params{maxValue}) && ($params{direction} eq "asc")) {
	$range = "HAVING bla >= $params{minValue}";
	$Text .= " occurring at least $params{minValue} times ";
}
if (($params{minValue}) && (!$params{maxValue}) && ($params{direction} eq "desc")) {
	$range = "HAVING bla <= $params{minValue}";
	$Text .= " occurring not more than $params{minValue} times ";
}
if (($params{minValue}) && ($params{maxValue})) {
	$range = "HAVING bla BETWEEN $params{minValue} AND $params{maxValue}";
	$Text .= " occurring between $params{minValue} and $params{maxValue} times ";
}

# connect to mysql
if (($params{spowri} eq "s") || ($params{spowri} eq "w") || ($params{spowri} eq "all")) {
	$bncHandle = DBI->connect("DBI:mysql:$bwMYSQLtable:$bwMYSQLhost:$bwMysqlPort", "$bwMysqlUser", "$bwMysqlPwd");
} else {
	$bncHandle = DBI->connect("DBI:mysql:$bwMYSQLfrequency:$bwMYSQLhost:$bwMysqlPort", "$bwMysqlUser", "$bwMysqlPwd") or bark("Can't connect to mysql on $bwMYSQLhost at port: $bwMysqlPort <BR>" . $frequencyHandle::errstr);
}

if ($params{spowri} ne "all") {
	
	if ($params{spowri} eq "s") {
		$spowri = 2;
		$Text .= "in the spoken component ";
		
		$wordTable = "allWordsS";
		$wordTaggedTable = "allWordsTS";
		$lemmaTable = "allLemmaS";


	} elsif ($params{spowri} eq "w") {
		$spowri = 1;
		$Text .= " in the written component ";

		$wordTable = "allWordsW";
		$wordTaggedTable = "allWordsTW";
		$lemmaTable = "allLemmaW";


	} else {
		# subcorpus frequency list display
		($theName, $subcorpus) = split(/·/, $params{spowri});
		$Text .= " in subcorpus \"$subcorpus\" ";

		$wordTable = "allWords_" . $theName;
		$wordTaggedTable = "allWordsT_" . $theName;
		$lemmaTable = "allLemma_" . $theName;
		$spowri = $subcorpus;
	}
} else {
	$sw="";
	$spowri = 0;
	$Text .= " in the whole BNC ";
	
	$wordTable = "allWords";
	$wordTaggedTable = "allWordsT";
	$lemmaTable = "allLemma";
	
}


if ($showLemma) {
	$range =~ s/HAVING bla /freq /;
	$theLemma='' if ($theLemma=~m/_all/);
	
	if ($params{regexValue}) {
		
		$regexKind = "";
		if ($params{regex} eq "begin") {
			$regex = " AND lemma regexp '\^$params{regexValue}'";
			$insertText = " starting with '$params{regexValue}'";
		} elsif ($params{regex} eq "end") {
			$regex = " AND lemma regexp '$params{regexValue}_'";
			$insertText = " ending in '$params{regexValue}'";
		} else {
			$regex = " AND lemma regexp '$params{regexValue}'";
			$insertText = " containing '$params{regexValue}'";
		}
		$Text=~s/##/$insertText/;
	}
	
	$sqlQuery="SELECT lemma, freq from $lemmaTable WHERE $range AND ($theLemma) $regex ORDER BY freq $params{direction}, lemma  $limit";
	
	
} else {
	
	if ($params{regexValue}) {
		
		$regexKind = "";
		if ($params{regex} eq "begin") {
			$regex = " AND word1 regexp '\^$params{regexValue}'";
			$insertText = " starting with '$params{regexValue}'";
		} elsif ($params{regex} eq "end") {
			$regex = " AND word1 regexp '$params{regexValue}\$\'";
			$insertText = " ending in '$params{regexValue}'";
		} else {
			$regex = " AND word1 regexp '$params{regexValue}'";
			$insertText = " containing '$params{regexValue}'";
		}
		$Text=~s/##/$insertText/;
	}
	
	if ($theTags) {
		$theTags=~s/tag REGEXP/substring(word, LOCATE('_', word)) REGEXP/g;
		$regex=~s/word1 regexp/substring_index(word, '_', 1) REGEXP/g;
		$sqlQuery="SELECT substring_index(word, '_', 1) as word1, sum(freq) as bla, substring_index(word, '_', -1) as tag FROM $wordTaggedTable WHERE ($theTags) $regex GROUP BY word1 $range ORDER BY bla $params{direction}, word1 $limit";
	} else {
		$range =~ s/HAVING bla /freq /;
		if ($params{showTag}) {
			$sqlQuery="SELECT word as word1, freq from $wordTaggedTable WHERE $range $regex ORDER BY freq $params{direction}, word1 $limit";
		} else {
			$sqlQuery="SELECT word as word1, freq from $wordTable WHERE $range $regex ORDER BY freq $params{direction}, word1  $limit";
		}
	}
}

$sqlQuery=~s/AND \(\)//;
$sqlQuery=~s/WHERE\s+AND/ WHERE /;
$sqlQuery=~s/WHERE\s+ORDER/ORDER/;
$Text=~s/##//;
$Text=~s/\A(\w)/uc($1)/e;


print "Content-Type: text/text\n";
print "Content-disposition: attachment; filename=frequency_list.txt\n\n";
print "$Text$crlf";
print "__________________$crlf$crlf";

if ($showLemma) {
	if ($params{showTag}) {
		print "Number\tLemma\tTag\tFrequency$crlf$crlf";
	} else {
		print "Number\tLemma\tFrequency$crlf$crlf";
	}
} else {
	if ($params{showTag}) {
		print "Number\tWord\tTag\tFrequency$crlf$crlf";
	} else {
		print "Number\tWord\tFrequency$crlf$crlf";
	}
}


$sth = $bncHandle->prepare($sqlQuery) or bark("Can't prepare $sqlQuery:" . $bncHandle::errstr);
$sth->execute or bark("Can't execute $sqlQuery:" . $sth::errstr);
$countFRes=$sth->rows;
$resArrayResult=$sth->fetchall_arrayref;

$countTotal=0;
for $k ( 0 .. ($#{$resArrayResult}) ) {
	$theWord=$resArrayResult->[$k][0];
	$theFrequency=$resArrayResult->[$k][1];
	$theTag=$resArrayResult->[$k][2];
	
	if ($showLemma) {
		$theWord=~m/_([A-Z]+)\Z/;
		$theWord= $`;
		$theTag=$1;
	} else {
		$theWord=~s/(~|_)/ /g;
	}
	
	$theWord = lc($theWord);

	$lineIndicator = $k + 1;
	$countTotal += $theFrequency;

	if (($params{showTag}) || ($showLemma)) {
		print "$lineIndicator\t$theWord\t$theTag\t$theFrequency$crlf";
	} else {
		print "$lineIndicator\t$theWord\t$theFrequency$crlf";
	}
	
}

if (!$countFRes) {
	print "There are no words in the BNC that match your requirements";
	exit(0);
}

print "$crlf_________________________$crlf";
if (($params{showTag}) || ($showLemma)) {
	print "Total:\t\t\t$countTotal$crlf";
} else {
	print "Total:\t\t$countTotal$crlf";
}

exit(0);
