#!/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;
### no longer supported -- check if some regexps need //m modifier
# $*=1; 

$speakerInfoCgi = "speakerInfo_new.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");
}

# 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>$userHandle::errstr\n");

# print header and title (to save space...)
print "Content-type: text/html\n\n";
print <<END;

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

<TITLE>BNC File 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" CELLPADDING="4" CELLSPACING="2" WIDTH="100%">
	<TR WIDTH="100%">
		<TD HEIGHT="26" COLSPAN="3" BGCOLOR="#CCCCFF">
			<P ALIGN="LEFT"><B>BNC header information for file $params{text}</B>
		</TD>
	</TR>
END

$sqlQuery = "SELECT title, num_orthogr_words, numtokens, numwords, numPuns, numSentences, 
		alltim, alltyp, scgdom, sdeage, sdecla, sdesex, spolog, sporeg, wriaag, wriad, wriase, wriaty, wriaud, wridom, wrilev, wrimed, 
		wripp, wrisam, wrista, writas, allava, spowri, derivedTextType, genre  
		FROM headerInfo WHERE fname = '$params{text}'";
$sth = $bncHandle->prepare($sqlQuery) or bark("Can't prepare $sqlQuery: " . $bncHandle::errstr);
$sth->execute or bark("Can't execute $sqlQuery: " . $sth::errstr);

($title, $num_orthogr_words, $numtokens, $numwords, $numPuns, $numSentences, $alltim, $alltyp, 
$scgdom, $sdeage, $sdecla, $sdesex, $spolog, $sporeg, $wriaag, $wriad, $wriase, $wriaty, 
$wriaud, $wridom, $wrilev, $wrimed, $wripp, $wrisam, $wrista, $writas, $allava, $spowri, $derivedTextType, $genre) = $sth->fetchrow_array;

$averageSentenceLength = int((($numwords / $numSentences) * 10000) + 0.5)/ 10000;

print "<TR BGCOLOR=\"#DDDDDD\"><TD>Title:</TD><TD COLSPAN=\"2\">$title</TD></TR>\n";
$value = "spowri=$spowri";
print "<TR BGCOLOR=\"#DDDDDD\"><TD>Spoken or Written:</TD><TD COLSPAN=\"2\">$catValues{$value}</TD></TR>\n";

$numwordsDecimal = makeDecimals($numwords);
print "<TR BGCOLOR=\"#DDDDDD\"><TD>Number of Words (tagged items):</TD><TD COLSPAN=\"2\">$numwordsDecimal</TD></TR>\n";
print "<TR BGCOLOR=\"#DDDDDD\"><TD>Average sentence length (&lt;w&gt;-tags per &lt;s&gt;-unit):</TD><TD COLSPAN=\"2\">$averageSentenceLength</TD></TR>\n";
print "<TR BGCOLOR=\"#FFF2DE\"><TD COLSPAN=\"2\"></TD></TR>";

$value = "derivedtexttype=$derivedTextType";
print "<TR BGCOLOR=\"#DDDDDD\"><TD>$typeValues{derivedtexttype}:</TD><TD COLSPAN=\"2\">$catValues{$value}</TD></TR>\n";
$value = "genre=$genre";
print "<TR BGCOLOR=\"#DDDDDD\"><TD>$typeValues{genre}:</TD><TD COLSPAN=\"2\">$catValues{$value}</TD></TR>\n";
$value = "alltyp=$alltyp";
print "<TR BGCOLOR=\"#DDDDDD\"><TD>$typeValues{alltyp}:</TD><TD COLSPAN=\"2\">$catValues{$value}</TD></TR>\n";
$value = "alltim=$alltim";
print "<TR BGCOLOR=\"#DDDDDD\"><TD>$typeValues{alltim}:</TD><TD COLSPAN=\"2\">$catValues{$value}</TD></TR>\n";
if ($spowri == 2) {
	if ($alltyp == 2) {
		$value="scgdom=$scgdom";
		print "<TR BGCOLOR=\"#DDDDDD\"><TD>$typeValues{scgdom}:</TD><TD COLSPAN=\"2\">$catValues{$value}</TD></TR>\n";
	} else {
		$value="sdeage=$sdeage";
		print "<TR BGCOLOR=\"#DDDDDD\"><TD>$typeValues{sdeage}:</TD><TD COLSPAN=\"2\">$catValues{$value}</TD></TR>\n";
		$value="sdecla=$sdecla";
		print "<TR BGCOLOR=\"#DDDDDD\"><TD>$typeValues{sdecla}:</TD><TD COLSPAN=\"2\">$catValues{$value}</TD></TR>\n";
		$value="sdesex=$sdesex";
		print "<TR BGCOLOR=\"#DDDDDD\"><TD>$typeValues{sdesex}:</TD><TD COLSPAN=\"2\">$catValues{$value}</TD></TR>\n";
	}
	$value="spolog=$spolog";
	print "<TR BGCOLOR=\"#DDDDDD\"><TD>$typeValues{spolog}:</TD><TD COLSPAN=\"2\">$catValues{$value}</TD></TR>\n";
	$value="sporeg=$sporeg";
	print "<TR BGCOLOR=\"#DDDDDD\"><TD>$typeValues{sporeg}:</TD><TD COLSPAN=\"2\">$catValues{$value}</TD></TR>\n";
	print <<END;
		<TR WIDTH="100%">
			<TD COLSPAN="3" BGCOLOR="#FFCC99">
				<P ALIGN="LEFT"><B>Speakers</B>
			</TD>
		</TR>
END
	
	$sqlQuery = "SELECT spid, nameFull FROM speakers WHERE filename = '$params{text}'";
	$sth= $bncHandle->prepare($sqlQuery) or bark("Can't prepare $sqlQuery: " . $sth::errstr);
	$sth->execute or bark("Can't execute $sqlQuery: " . $sth::errstr);
	$resArrayResult=$sth->fetchall_arrayref or bark("Can't fetch $sqlQuery: " . $sth::errstr);
	for $k ( 0 .. ($#{$resArrayResult}) ) {
		$spid=$resArrayResult->[$k][0];
		$nameFull=$resArrayResult->[$k][1];
		
		$Person = "<A HREF=\"/$bwCGIalias/${speakerInfoCgi}?text=$paramsEnc{text}&spid=$spid&urlTest=yes\"<B>$spid</B></A> ";
		print "<TR BGCOLOR=\"#DDDDDD\"><TD>$Person</TD><TD COLSPAN=\"2\">$nameFull</TD></TR>\n";
		
	}
} else {
	$value="wriaag=$wriaag";
	print "<TR BGCOLOR=\"#DDDDDD\"><TD>$typeValues{wriaag}:</TD><TD COLSPAN=\"2\">$catValues{$value}</TD></TR>\n";
	$value="wriad=$wriad";
	print "<TR BGCOLOR=\"#DDDDDD\"><TD>$typeValues{wriad}:</TD><TD COLSPAN=\"2\">$catValues{$value}</TD></TR>\n";
	$value="wriase=$wriase";
	print "<TR BGCOLOR=\"#DDDDDD\"><TD>$typeValues{wriase}:</TD><TD COLSPAN=\"2\">$catValues{$value}</TD></TR>\n";
	$value="wriaty=$wriaty";
	print "<TR BGCOLOR=\"#DDDDDD\"><TD>$typeValues{wriaty}:</TD><TD COLSPAN=\"2\">$catValues{$value}</TD></TR>\n";
	$value="wriaud=$wriaud";
	print "<TR BGCOLOR=\"#DDDDDD\"><TD>$typeValues{wriaud}:</TD><TD COLSPAN=\"2\">$catValues{$value}</TD></TR>\n";
	$value="wridom=$wridom";
	print "<TR BGCOLOR=\"#DDDDDD\"><TD>$typeValues{wridom}:</TD><TD COLSPAN=\"2\">$catValues{$value}</TD></TR>\n";
	$value="wrilev=$wrilev";
	print "<TR BGCOLOR=\"#DDDDDD\"><TD>$typeValues{wrilev}:</TD><TD COLSPAN=\"2\">$catValues{$value}</TD></TR>\n";
	$value="wrimed=$wrimed";
	print "<TR BGCOLOR=\"#DDDDDD\"><TD>$typeValues{wrimed}:</TD><TD COLSPAN=\"2\">$catValues{$value}</TD></TR>\n";
	$value="wripp=$wripp";
	print "<TR BGCOLOR=\"#DDDDDD\"><TD>$typeValues{wripp}:</TD><TD COLSPAN=\"2\">$catValues{$value}</TD></TR>\n";
	$value="wrisam=$wrisam";
	print "<TR BGCOLOR=\"#DDDDDD\"><TD>$typeValues{wrisam}:</TD><TD COLSPAN=\"2\">$catValues{$value}</TD></TR>\n";
	$value="wrista=$wrista";
	print "<TR BGCOLOR=\"#DDDDDD\"><TD>$typeValues{wrista}:</TD><TD COLSPAN=\"2\">$catValues{$value}</TD></TR>\n";
	$value="writas=$writas";
	print "<TR BGCOLOR=\"#DDDDDD\"><TD>$typeValues{writas}:</TD><TD COLSPAN=\"2\">$catValues{$value}</TD></TR>\n";
}
#$value="allava=$allava";
#print "<TR BGCOLOR=\"#DDDDDD\"><TD>$typeValues{allava}:</TD><TD COLSPAN=\"2\">$catValues{$value}</TD></TR>\n";

print "<\/TABLE>\n";

# print the end of html
&printFooter();

#say goodbye
exit (0);


