#!/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 bncCEQL;
use DBI;
	
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");
}


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

$username = $ENV{'REMOTE_USER'};

# remove trailing spaces and returns from the input
$theData = $params{theData};
$theData=~s/(\r|\s)+\Z//;
$theData=~s/\t/ /g;

$listFiles = 0;
$listFiles = 1 unless ($theData);

## ***DEL***
# if ($theData=~s/\A\(\(longest\)\) *//) {
#   $longest = 1;
# }

if ($params{qMode}=~m/Simple query/) {
	
	if ($params{qMode}=~m/ignore/) {
		$case_sensitive = 0;
		setParam("queryMode", "simple");
	} else {
	        $case_sensitive = 1;
		setParam("queryMode", "simpleC");
	}
	setParam("simpleQuery", "$theData");
	
	$theData = simple_query($theData) unless ($listFiles);
} else {
	setParam("simpleQuery", "");
	setParam("queryMode", "CQP");
}

## ***DEL***
# $theData = "###" . $theData if ($longest);

setParam("theData", "$theData");

if ($params{theAction} eq "Make macro") {

	print "Location: /$bwCGIalias/macroAdmin.pl?theAction=newMacro&theData=$paramsEnc{theData}&username=$username&urlTest=yes\n\n";
	exit(0);
	
}

$theQuery= $ENV{'QUERY_STRING'};


$check = $theQuery=~m/&del=tw/;


if ($check) {
	$rest = $';
} else {
	$rest = "";
}


$rest=~s/\&?wrispo\=(written|spoken)//;
$rest=~s/\&?urlTest\=yes//;


if ($rest=~m/&del=ts(.*?)&del=tv/) {
	$restS = $1;
	$restW = $` . $';
} else {
	$restW = $rest;
}

$restW=~s/(&del\=n)+/&del=n/g;
$restW=~s/&del\=n\Z//;
$restW=~s/\A&?del\=n//;
$restW=~s/\A&?del\=n//;
$restW=~s/\A\s+\Z//;

$restS=~s/(&del\=n)+/&del=n/g;
$restS=~s/&del\=n\Z//;
$restS=~s/\A&?del\=n//;
$restS=~s/\A&?del\=n//;
$restS=~s/\A\s+\Z//;


if ($restW) {
	@wArray=split(/&del=n/, $restW);	
					
	for ($j=0; $j< @wArray; $j++) {	
			
		$wArray[$j]=~s/\A&//;
		@itemArray=split(/\&/, $wArray[$j]);	
			
		for ($i=0; $i< @itemArray; $i++) {	
			
			$check = $itemArray[$i]=~m/t=([^\d]+)(\d+)/;
			$itemArray[$i]="$1=\'$2\' or" if $check;	
				
		}	
			
		$targetList=join ' ', @itemArray;
		$targetList=~s/ or\Z//;
		$sgml = '(' . $targetList . ')';	
		$wArray[$j]= $sgml;	
	}	
	
	$sgml1=join(' & ', @wArray);
	
	# add (spowri=1) for alltim variable;
	$sgml1 = "(spowri=1) & " . $sgml1 if ($sgml1=~m/alltim/);
	
}



if ($restS) {
	@wArray=split(/&del=n/, $restS);
	$hitSomething=0;
	for ($j=0; $j< @wArray; $j++) {
	
		$wArray[$j]=~s/\A&//;
		@itemArray=split(/\&/, $wArray[$j]);
		
		for ($i=0; $i< @itemArray; $i++) {	
			$check = $itemArray[$i]=~m/([^=]+)=(\d+)/;
			$itemArray[$i]="$1=\'$2\' or" if $check;
		}
		$targetList=join ' ', @itemArray;
		$targetList=~s/ or\Z//;
		$sgml = '(' . $targetList . ')';
		$wArray[$j]= $sgml;	
		
	}
	
	$sgml2=join(' & ', @wArray);	
}

# if ($params{lemmaType}) {
# 	if ($params{theData}=~m/\S\s\S/) {
# 		barkFull("Lemma searches are only possible for individual words. Please use the standard query interface if you want to combine several lemmata in one CQL-query.");
# 	}
# 	$theData = '^"' . $params{theData} . "=$params{lemmaType}" . '"'; 
# 	&setParam("theData", "$theData");
# }

$restrictions = "";
$restrictions = "ª" . $sgml1 . "##" . $sgml2 if (($sgml1) || ($sgml2));

$theData="$params{theData}$restrictions" unless (($params{theData}=~m/\A\W*\Z/) || (!$params{theData}));

setParam("theData", "$theData");


if ($params{theData} eq '') {
	$theData=$restrictions;
	setParam("theData", "$theData");
}

print "Location: /$bwCGIalias/main.pl?theData=$paramsEnc{theData}&simpleQuery=$paramsEnc{simpleQuery}&queryMode=$paramsEnc{queryMode}&listFiles=$listFiles&chunk=$paramsEnc{chunk}&inst=$paramsEnc{inst}&max=$paramsEnc{max}&queryID=$paramsEnc{queryID}&qname=$paramsEnc{qname}&thMode=$paramsEnc{thMode}&thin=$paramsEnc{thin}&qtype=$paramsEnc{qtype}&view=$paramsEnc{view}&queryType=$paramsEnc{queryType}&lemmaType=$paramsEnc{lemmaType}&urlTest=yes\n\n";
exit(0);

sub simple_query {
  my $query = shift;
  my $parser = new bncCEQL;

  $parser->SetParam("default_ignore_case", !$case_sensitive);
  $cqp_query = $parser->Parse($query);
  unless (defined $cqp_query) {
    my $theQueryQ = $bncHandle->quote($query);
    $sqlQuery = "insert into history (user, query, hits, simple_query, queryMode)
			values ('$username', $theQueryQ, -1, $theQueryQ, 'simple')";
    $bncHandle->do($sqlQuery) or bark("Can't insert $sqlQuery: " . $bncHandle::errstr);
    cqp_error_handler_full("<b>Error in Simple Query Synatx</b>", $parser->HtmlErrorMessage);
  }
  return $cqp_query;
}


sub wildcards {
	my $pattern = shift;
	$pattern =~ s/([\x00-\x1f]|\s)+//g;			# remove control characters and whitespace
	if ($pattern =~ /[\.\!\"\`\$\%\&\(\)\{\}\[\]\|\\]/) {
 		my $theQueryQ = $bncHandle->quote($query);
		$sqlQuery = "insert into history (user, query, hits, simple_query, queryMode) 
			values ('$username', $theQueryQ, -1, $theQueryQ, 'simple')";
		$bncHandle->do($sqlQuery) or bark("Can't insert $sqlQuery: " . $bncHandle::errstr);			
		cqp_error_handler_full('<H3>Invalid pattern</H3>Sorry, in simple query mode your input may not contain the follwing special characters: . ! " ` $ % & ( ) { } [ ] | \ ');
	}
	$pattern =~ s/\?/./g;
	$pattern =~ s/\*/.*/g;
	$pattern =~ s/\+/.+/g;
	return $pattern;
}

