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

## ***DEL***
# use CWB;
# use CQP;
# use CL;

$username = $ENV{'REMOTE_USER'};
$host = $ENV{'REMOTE_HOST'};
$host = "localhost" unless ($host);

### no longer supported -- check if some regexps need //m modifier
# $*=1; 

CQPconnect(full);

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);
$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);
	
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");
}
print "Content-Type: text/text\n";
print "Content-disposition: attachment; filename=$params{saveName}.txt\n\n";


# get the query string for the multiple cat and catsp choices
$theQuery= $ENV{'QUERY_STRING'};
$theQuery=~s/%([\dA-Fa-f][\dA-Fa-f])/pack ("C", hex ($1))/eg;

$theData=$params{theData};
$theData=~s/¨·/"/g;


$crlf = &linefeed();


$count= -1;
$categories = "";

while ($theQuery=~m/cat=(\w+)/g) {
	$count++;
	$cat[$count]=$1;
	$categories .= "$1, ";
}
$categories =~ s/,\s\Z//;

$count= -1;
$SPcategories = "";
while ($theQuery=~m/catsp=(\w+)/g) {
	$count++;
	$SPcat[$count]=$1;
	$SPcategories .= "$1, ";
}
$SPcategories =~ s/,\s\Z//;

$SPdefault{age}=7;
$SPdefault{sex}=3;
$SPdefault{class}=5;
$SPdefault{firstLanguage}=6;
$SPdefault{education}=6;
$SPdefault{dialect}=30;

$qName = $params{qname};

$CQP->exec("set DataDirectory '/$bwTempPath/'");
$CQP->exec("$bwCorpus");

($numOfSolutions) = $CQP->exec("size $qName");

@lines = $CQP->exec("group $qName match text_id");
$numOfFiles2 = @lines;

$check = $params{thMode}=~m/\AM(\d+)(#(\d+))?#/;
if ($check) {
	$numRes = $1;
	$numOfFiles=$3;
}
$information = &createTitle($params{thMode}, $theData, $numRes, $numOfFiles);
$information=~s/\&quot\;/\"/g;
$information=~s/<[^>]+>//g;

print "$information.$crlf" if ($params{info} == 1);
	
if ($numRes != $numOfSolutions) {
	print "$numOfSolutions solutions (found in $numOfFiles2 different texts) selected for downloading.$crlf" if ($params{info} == 1);
}
	
if ($params{info}) {
	if ($params{info} == 1) {
		$delimiter = $crlf;
	} else {
		$delimiter = "\t";
	}
	
	# print information about what is being downloaded
	if ($params{info} == 1) {
		print "Processed for $username at ${host}.$crlf$crlf";
		print "Order of tab-delimited text:$crlf";
		print "1. Number of hit$crlf";
		print "2. Textname$crlf";
		print "3. S-unit number$crlf";
		print "4. Speaker-ID (if applicable)$crlf";
	} else {
		print "Number of hit\tTextname\tS-unit number\tSpeaker-ID (if applicable)\t";
	}
	
	if ($params{view} eq "kwic") {
		if ($params{info} == 1) {
			print "5. Left context$crlf";
			print "6. Query item$crlf";
			print "7. Right context$crlf";
		} else {
			print "Left context\tQuery item\tRight context\t";
		}
	} else {
		if ($params{info} == 1) {
			print "5. Concordance line$crlf";
			$counter = 5;
		} else {
			print "Concordance line\t";
		}
	}
	
	
	if ($params{tagged}) {

		if ($params{view} eq "kwic") {
			if ($params{info} == 1) {
				print "8. Tagged Left context$crlf";
				print "9. Tagged Query item$crlf";
				print "10. Tagged Right context$crlf";
				$counter = 10;
			} else {
				print "Tagged Left context\tTagged Query item\tTagged Right context\t";
			}
		} else {
			if ($params{info} == 1) {
				print "6. Tagged Concordance line$crlf";
				$counter = 6;
			} else {
				print "Tagged Concordance line\t";
			}
		}


	}
	
	if (($categories) || ($SPcategories) || ($DBcategories)) {
		foreach $cat (@cat) {
			$counter++;
			if ($params{info} == 1) {
				print "${counter}. $typeValues{$cat}$crlf";
			} else {
				print "$typeValues{$cat}\t";
			}
		}
		foreach $cat (@SPcat) {
			$counter++;
			if ($params{info} == 1) {
				print "${counter}. $typeValues{$cat}$crlf";
			} else {
				print "$typeValues{$cat}\t";
			}
		}
	}
	
	if ($params{server}) {
		$counter++;
		if ($params{info} == 1) {
			print "${counter}. URL$crlf";
		} else {
			print "URL\t";
		}
	} 
	
	if ($params{corpusPositions}) {
		if ($params{info} == 1) {
			$counter++;
			print "${counter}. Matchbegin corpus position$crlf";
			$counter++;
			print "${counter}. Matchend corpus position$crlf";
		} else {
			print "Matchbegin corpus position\tMatchend corpus position\t";
		}
	}
	
	if ($params{info} == 1) {
		print "$crlf$crlf";
	} else {
		print "$crlf";
	}
}
if ($params{contSize} < 5) {
	$CQP->exec("set Context $params{contSize} s");
} else {
	$contextSize = $params{contSize} - 4;
	$CQP->exec("set Context $contextSize words");
}
if ($params{tagged}) {
	$CQP->exec("show -cpos +pos");
} else {
	$CQP->exec("show -cpos -pos");
}
$CQP->exec("set LD '--<<>>--'");	
$CQP->exec("set RD '--<<>>--'");	

if ($params{mark}) {
	$mLeft = "<<< ";
	$mRight = " >>>";

} else {
	$mLeft = "";
	$mRight = "";
}


for ($batch_start = 0; $batch_start < $numOfSolutions; $batch_start += 100) {
	$batch_end = $batch_start + 99;
	$batch_end = $numOfSolutions - 1 if ($batch_end >= $numOfSolutions);
	
	
	@kwic = $CQP->exec("cat $qName $batch_start $batch_end");
	@table = $CQP->dump($qName, $batch_start, $batch_end); 
	$n = @kwic;

	foreach $i (0 .. $n-1) {
		$lineIndicator = $batch_start + $i + 1;
		
		($kwic_lc, $kwic_match, $kwic_rc) = split /--<<>>--/, $kwic[$i];
		($match, $matchend, $target, $keyword) = @{$table[$i]}; 
		$text = $TEXT_ID->cpos2str($match);
		$spid = $U_WHO->cpos2str($match);
		$lineNumber = $S_N->cpos2str($match);
		
		if ($params{tagged}) {
			$tagged = $kwic_lc . "Û" . $mLeft . $kwic_match . $mRight . "Û" . $kwic_rc;
			$untagged = $tagged;
			$untagged =~s/(\S+)\/\w{3}(-\w{3})?\b/$1/g;
			$tagged =~s/(\S+)\/(\w{3}(-\w{3})?)\b/$1_$2/g;
		} else {
			$untagged = $kwic_lc . "Û" . $mLeft . $kwic_match . $mRight . "Û" . $kwic_rc;
			$untagged =~s/(\S+)\/\w{3}(-\w{3})?\b/$1/g;
		}
		if ($params{view} eq "kwic") {
			$tagged =~s/Û/\t/g;
			$untagged =~s/Û/\t/g;
		} else {
			$tagged =~s/Û//g;
			$untagged =~s/Û//g;
		}


		$values="";
		$SPvalues="";
		# prepare default BNC text categories
		if ($categories) {
			$sqlQuery = "SELECT $categories FROM headerInfo where fname='$text'";
			$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;
			$count = @rowArray;

			$counter = -1;
			foreach $cat (@rowArray) {
				$counter++;
				if ($params{codes}) {
					$value=$cat[$counter] . "=" . $cat;
					$cat = $catValues{$value};
				}
				$values .= $cat . "\t";
			}
		}
		$values=~s/\t\Z//;
		
		# prepare default BNC speaker categories
		if ($SPcategories) {
			if ($spoken{$text}) {
				
				# this will work with the speakers database when PS000 etc. are included.
				$sqlQuery = "SELECT $SPcategories FROM speakers where spid='$spid'";
				$sth = $bncHandle->prepare($sqlQuery) or bark("Can't prepare $sqlQuery: $bncHandle::errstr");
				$sth->execute or bark("Can't execute $sqlQuery: $sth::errstr");
				@rowArraySpeakers=$sth->fetchrow_array;
				$counter = -1;
				foreach $cat (@rowArraySpeakers) {
					if ($params{codes}) {
						$counter++;
						$value=$SPcat[$counter] . "=" . $cat;
						$cat = $catValues{$value};
					}
					$SPvalues .= $cat . "\t";
				}
				chop ($SPvalues);
			} else {
				$SPvalues = $SPcategories;
				$SPvalues =~ s/, /\t/g;
				if (!$params{codes}) {
					@allCodes = split("\t", $SPvalues);
					$SPvalues="";
					foreach $indCode (@allCodes) {
						$SPvalues .= $SPdefault{$indCode} . "\t";
					}
					$SPvalues=~s/\t\Z//;
				} else {
					$SPvalues =~ s/\w+/n\/a/g;
				}
			}
		}
		$out = "$lineIndicator\t$text\t$lineNumber\t$spid\t$untagged";
		
		$out .= "\t$tagged" if ($params{tagged});
		$out .= "\t$values" if ($values);
		$out .= "\t$SPvalues" if ($SPvalues);
		
		if ($params{server}) {
			$out .= "\t$bwWebServer/$bwCGIalias/context.pl?text=${text}&qname=nosol&refnum=0&theData=0&len=0&showTheTag=0&color=0&begin=${lineNumber}&spids=1&interval=11&first=yes&urlTest=yes";
		} 
		$out .= "\t$match\t$matchend" if ($params{corpusPositions});
		
		
		$out .= "$crlf";
		
		#$out =~ s/\t+/\t/g;
		$out =~ s/(\t)+$crlf\Z/$crlf/;
		print $out;

		
	}
}


&CQPdisconnect();

