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


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

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

<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2 Final//EN">
<HTML>
<HEAD>
	<TITLE>BNC Title Information</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>
	<TR>
		<TD COLSPAN="3" HEIGHT="27" BGCOLOR="#CCCCFF"> <FONT SIZE="4"><B>BNC Title Information</B></FONT></TD>
	</TR>
END

#settings
$fileInfoCgi = "fileInfo.pl";

$titleShow=$params{key};

$key = $params{key};
$key=lc($key);
setParam("key", "$key");

if ($params{andOr} ne 'phrase') {
	@words=split(/\s+/, $params{key});
	foreach $word (@words) {
		next if $word=~m/\A\s*\Z/;
		#$word=~s/(\W)/sprintf("%%%x", ord($1))/eg;
		$restriction.= "title REGEXP '$word' $params{andOr} ";
	}
} else {
	
	$key = $params{key};
	#$key=~s/(\W)/sprintf("%%%x", ord($1))/eg;
	setParam("key", "$key");
	bark("Empty search string!!\n") if  ($params{key}=~m/\A\s*\Z/);

	$restriction = "title REGEXP '$params{key}'";
}
$restriction=~s/ $params{andOr}\s*\Z//;
bark("Empty search string!\n") if  ($restriction=~m/\A\s*\Z/);


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

$sqlQuery = "SELECT fname, title from headerInfo WHERE $restriction ORDER by fname";
$sth = $bncHandle->prepare($sqlQuery) or bark("Can't prepare $sqlQuery:" . $bncHandle::errstr);
$sth->execute or bark("Can't execute $sqlQuery: $sth::errstr");
$res = $sth->rows;
if (!$res) {
	print "<TR><TD COLSPAN=\"3\"><B>There are no titles that match your input</B></TD></TR></TABLE>\n";
	&printFooter();
	exit(0);
} else {
	$mode=" (all words)" if ($params{andOr} eq "and");
	$mode=" (any word)" if ($params{andOr} eq "or");
	$mode=" (phrase)" if ($params{andOr} eq "phrase");
	if ($res == 1) {
		$printText= "<B>For \'$titleShow\' $mode, the following text was found:</B>";
	} else {
		$printText= "<B>For \'$titleShow\' $mode, the following $res texts were found:</B>";
	}
	
	$subcorpusList="<OPTION SELECTED VALUE=\"new\">New subcorpus\n";
	$sqlQuery = "SELECT subcorpus FROM subcorpora where username = '$username' and textOrSpeaker = 'text' order by subcorpus";
	$sth1 = $bncHandle->prepare($sqlQuery) or bark("Can't prepare $sqlQuery:" . $bncHandle::errstr);
	$sth1->execute or bark("Can't execute $sqlQuery:" . $sth::errstr);
	$resArrayResult=$sth1->fetchall_arrayref;
	
	for $k ( 0 .. ($#{$resArrayResult}) ) {
		$theCorpus=$resArrayResult->[$k][0];
		$subcorpusList .= "<OPTION VALUE=\"$theCorpus\">$theCorpus\n" unless ($theCorpus=~m/\Alast_(written|spoken)\Z/);;
	}
	
	
	print <<END;
	<TR>
		<TD COLSPAN="3" HEIGHT="27" BGCOLOR="#FFCC66">
			$printText
		</TD>
		<FORM ACTION="/$bwCGIalias/subcorpAdmin.pl" METHOD="GET">
	</TR>
	<TR>
		<TD BGCOLOR="#FF9966">
			<B>Text</B>
		</TD>
		<TD BGCOLOR="#FF9966">
			<B>Title</B>
		</TD>
		<TD BGCOLOR="#FF9966">
			<B>Include in subcorpus</B>
		</TD>
	</TR>
END
	$theList="";
	for ($i = 0; $i < $res; $i++) {
		@rowArray=$sth->fetchrow_array;
		($filename, $title)=($rowArray[0], $rowArray[1]);
		$title =~ s/%([\dA-Fa-f][\dA-Fa-f])/pack ("C", hex ($1))/eg;
		$title=~s/\$1\$1\$2/ -- /g;
		$title=~s/ -- an electronic (transcription|version|sample|collection)\Z//g;
		$chunk=$title;
		$chunk = &output2($chunk);
		$link = "<A HREF=\"/$bwCGIalias/${fileInfoCgi}?text=$filename&urlTest=yes\">";
		$fnum = &Filemapping($filename);
		
		print <<END;
		<TR>
			<TD VALIGN=TOP BGCOLOR="#EEEEEE">
				<B>$link$filename</A></B>
			</TD>
			<TD VALIGN=TOP BGCOLOR="#EEEEEE">
				$chunk
			</TD>
			<TD VALIGN=TOP BGCOLOR="#EEEEEE">
				&nbsp;<INPUT TYPE="CHECKBOX" NAME="t" VALUE="$fnum">
			</TD>
		</TR>
END
		$theList .= "·$fnum";
	}
	print <<END;
		<TR>
		<TD COLSPAN="2" BGCOLOR="#DDDDDD">
			Choose subcorpus: &nbsp;&nbsp;&nbsp;&nbsp;
		
			<SELECT NAME="subcorpus">
				$subcorpusList
			</SELECT>
			<INPUT TYPE="SUBMIT" VALUE="Add">
		</TD>
			<TD NOWRAP BGCOLOR="#DDDDDD">
				&nbsp;<INPUT TYPE="CHECKBOX" NAME="all" VALUE="$theList">include all files
			</TD>
		</TR>
		</TABLE>
		<INPUT TYPE="hidden" NAME="textOrSpeaker" VALUE="text">
		<INPUT TYPE="hidden" NAME="username" VALUE="$username">
		<INPUT TYPE="hidden" NAME="urlTest" VALUE="yes">
		</FORM>
END
}
&printFooter();
exit(0);
