db/prgsrc/db.cgi - diff

Return to db.cgi CVS log

Up to [Local Repository] / db / prgsrc

Diff for /db/prgsrc/db.cgi between versions 1.76 and 1.121

version 1.76, 2002/10/22 04:23:13	version 1.121, 2003/06/23 02:09:35
Line 6 use strict;	Line 6 use strict;
use Time::Local;	use Time::Local;
use POSIX qw(locale_h);	use POSIX qw(locale_h);
use locale;	use locale;
	use vars qw($opt_z);
	use Getopt::Std;
	getopts('z');
	$opt_z\|\|=param("makehtml");
	my $timestamp="_timestamp.tmp";
	my $paramtour;
	my $withanswers=param('answer')\|\|param('answers');
open STDERR, ">/var/tmp/errors1";	open STDERR, ">/var/tmp/errors1";
	my $newsurl='http://news.chgk.info/';
	my $reklama="../dimrub/db/reklama.html";
	my $footer="../dimrub/db/footer.html";

	my $datefooter="../dimrub/db/date";

	my $fname;
	$reklama="../reklama.html" if $opt_z;
	$footer="../footer.html" if $opt_z;
	$datefooter="../date" if $opt_z;
	my $HTMLDIR="/znatoki/dimrub/db/baza/";
	$HTMLDIR="/files/";
	my $realHTMLDIR;
	if ($^O =~ /win/i) {
	$realHTMLDIR="/html/znatoki/baza/";
	} else
	{
	$realHTMLDIR="/home/piataev/public_html/dimrub/db/files/";
	}
	my $usehtml=$opt_z\|\|0;
	$usehtml=1;
	my $usewas=0;
	my $cashednumber=500;
	my $outputnumber=10;
	my ($proxyptext,$proxysstr);
my $printqueries=0;	my $printqueries=0;
	my $url=url\|\|'';
	my $qs=query_string;
	my $globaloutput;
my %forbidden=();	my %forbidden=();
my $debug=0; #added by R7	my $debug=0; #added by R7
	my $outputkvo=param('kvo') \|\|$outputnumber;
	$outputkvo=100 if $outputkvo>100;

if (param('debug')) {$debug=1; $printqueries=1}	if (param('debug')) {$debug=1; $printqueries=1}
STDERR=STDOUT if $debug;	STDERR=STDOUT if $debug;
	if ($url !~ /db\.chgk\.info/ && $url !~ /localhost/ && $url !~ /bilbo/) {
	my $u="http://db.chgk.info/cgi-bin/db.cgi?$qs";
	Redirect ($u);
	exit;
	}
	#if (!param('sstr') && param('all')) {
	# my $destination='http://db.chgk.info/all.html';
	# Redirect($destination);
	# exit;
	#}
	my $thislocale;
	if ($^O =~ /win/i) {
	$thislocale = "Russian_Russia.20866";
	} else {
	$thislocale = "ru_RU.KOI8-R";
	}
	POSIX::setlocale( &POSIX::LC_ALL, $thislocale );

	if ((uc 'а') ne 'А') {print STDERR "Koi8-r locale not installed!\n"};

my %fieldname= (0,'Question', 1, 'Answer', 2, 'Comments', 3, 'Authors', 4, 'Sources');	my %fieldname= (0,'Question', 1, 'Answer', 2, 'Comments', 3, 'Authors', 4, 'Sources');
my %rusfieldname=('Question','Вопрос', 'Answer', 'Ответ',	my %rusfieldname=('Question','Вопрос', 'Answer', 'Ответ',
'Comments', 'Комментарии', 'Authors', 'Автор',	'Comments', 'Комментарии', 'Authors', 'Автор',
'Sources', 'Источник','old','Старый','rus','Новый',	'Sources', 'Источник','old','Старый','rus','Новый',
'chgk', 'ЧГК', 'brain', 'Брейн-ринг','game', 'Своя игра',	'chgk', 'ЧГК', 'brain', 'Брейн-ринг','game', 'Своя игра',
'ehruditka', 'Эрудитка', 'beskrylka', 'Бескрылка'	'ehruditka', 'Эрудитка', 'beskrylka', 'Бескрылка', 'igp', 'Интернет'
);	);
my %searchin;	my %searchin;
my $rl=qr/[йцукенгшщзхъфывапролджэячсмитьбюё]/;	my $rl=qr/[йцукенгшщзхъфывапролджэячсмитьбюё]/;
Line 29 my %metodchar=('rus',1,'old',2);	Line 87 my %metodchar=('rus',1,'old',2);



my $thislocale;

$searchin{$_}=1 foreach param('searchin');	$searchin{$_}=1 foreach param('searchin');
my %TypeName=('children'=>'Д', 'game'=>'И',	my %TypeName=('children'=>'Д', 'game'=>'Я', 'igp'=>'И',
'chgk'=>'Ч', 'brain'=>'Б', 'beskrylka'=>'Л','ehruditka'=>'Э');	'chgk'=>'Ч', 'brain'=>'Б', 'beskrylka'=>'Л','ehruditka'=>'Э');



my $all=param('all');	my $all=param('all');
$all=0 if lc $all eq 'no';	$all=0 if lc $all eq 'no';
my ($PWD) = `pwd`;	my ($PWD) = `pwd` if $^O!~/win/i;
chomp $PWD;	chomp $PWD if $PWD;
my ($SRCPATH) = "/home/piataev/public_html/dimrub/src";	my ($SRCPATH) = "/home/piataev/public_html/dimrub/src";
my ($ZIP) = "/usr/local/bin/zip";	my ($ZIP) = "/usr/local/bin/zip";
my $DUMPFILE = "/tmp/chgkdump";	my $DUMPFILE = "/tmp/chgkdump";
Line 62 my @months=('000','Jan',"Feb","Mar","Apr	Line 119 my @months=('000','Jan',"Feb","Mar","Apr
sub NewEnough {	sub NewEnough {
my ($a) = @_;	my ($a) = @_;
my ($year, $month, $day) = split('-', $a);	my ($year, $month, $day) = split('-', $a);
	$month=1 if ($month<=0);
	$day=1 if ($day<=0);
return (time - timelocal(0, 0, 0, $day, $month -1, $year) < $TMSECS);	return (time - timelocal(0, 0, 0, $day, $month -1, $year) < $TMSECS);
}	}

# Reads one question from the DB. Gets DB handler and Question ID.	# Reads one question from the DB. Gets DB handler and Question ID.

	sub Redirect {
	my ($destination) = @_;
	print header.<<EndOfHTML;
	<head><meta http-equiv="refresh" content="0; URL=$destination"></head>
	EndOfHTML
	;
	=head

	print <<EndOfHTML;
	Content-type: text/html
	Location: $destination

	<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">
	<HTML><HEAD><TITLE>Redirection</TITLE></HEAD>
	<BODY BGCOLOR="#FFFFFF">
	<H1>Redirection</H1>
	<P>It appears that your browser cannot handle redirections
	automatically. You can proceed to the randomly-selected page
	by clicking <A HREF="$destination">here</A>.</P>
	</BODY>
	</HTML>
	EndOfHTML
	;
	=cut
	}




sub GetTournament {	sub GetTournament {
my ($dbh, $Id) = @_;	my ($dbh, $Id) = @_;
my (%Tournament, $field, @arr);	my (%Tournament, $field, @arr);
Line 85 sub GetTournament {	Line 173 sub GetTournament {
return %Tournament;	return %Tournament;
}	}

	sub fetchquestion {
	my ($sth,$q,$WithTour)=@_;
	if ($WithTour) {
	($$q{'QuestionId'}, $$q{'Question'},$$q{'Answer'},$$q{'Comments'},$$q{'Authors'},
	$$q{'Number'},
	$$q{'Title'}, $$q{'TourTitle'}, $$q{'FileName'},$$q{'PlayedAt'},$$q{'TourNumber'}) =
	$sth->fetchrow;
	} else {
	($$q{'QuestionId'}, $$q{'Question'},$$q{'Answer'},$$q{'Comments'},$$q{'Authors'},
	$$q{'Number'})=
	$sth->fetchrow;
	}
	}




	sub SelectQuestions {
	my ($dbh,$q,$WithTour) = @_;
	my %q=();
	# $_ = "QuestionId=$_" foreach @$q;
	# my $where=join " OR ",@$q;
	my $where=join ',',@$q;
	$where &&= "QuestionId IN (".(join ',',$where).")";
	$where\|\|=1;
	$where="($where) AND Questions.ParentId=t1.Id AND t1.ParentId=t2.Id"
	if $WithTour;

	my $query;
	if ($WithTour) {
	$query="SELECT QuestionId, Questions.Question, Answer, Comments, Authors,
	Questions.Number
	, t2.Title, t1.Title, t2.FileName, t2.PlayedAt,t1.Number
	from Questions,Tournaments as t1, Tournaments as t2
	WHERE $where";
	} else {
	$query="SELECT QuestionId, Questions.Question, Answer, Comments, Authors,
	Questions.Number from Questions
	WHERE $where";
	}

	my $sth;
	$sth=$dbh->prepare($query);
	$sth->execute;
	return $sth;
	}


# Reads one question from the DB. Gets DB handler and Question ID.	# Reads one question from the DB. Gets DB handler and Question ID.
sub GetQuestion {	sub GetQuestion {
my ($dbh, $QuestionId) = @_;	my ($dbh, $QuestionId) = @_;
Line 106 sub GetQuestion {	Line 242 sub GetQuestion {
return %Question;	return %Question;
}	}

	sub tourhref {
	my ($t,$a,$gr)=@_;
	my $res;
	if ($usehtml) {
	$res=$t;
	$res.=$a?"-a":"-q" unless $gr;
	$res.=".html";
	$res=~s/(\#\d+)(.*)$/$2$1/;
	$res="$HTMLDIR$res" unless $opt_z;
	return $res;
	} else {
	$res=$url;
	$res.="?tour=$t";
	$res.=$a?"&answers=1":"";
	return $res;
	}

	}

# Gets numbers of all the questions from the given tour.	# Gets numbers of all the questions from the given tour.
sub GetTourQuestions {	sub GetTourQuestions {
my ($dbh, $ParentId) = @_;	my ($dbh, $ParentId) = @_;
my (@arr, @Questions);	my (@arr, @Questions);

my ($sth) = $dbh->prepare("SELECT QuestionId FROM Questions	my ($sth) = $dbh->prepare("SELECT QuestionId FROM Questions
WHERE ParentId=$ParentId order by Number");	WHERE ParentId=$ParentId order by Number");

Line 144 sub GetTours {	Line 298 sub GetTours {
sub count	sub count
{	{
my ($dbh,$word)=@_;	my ($dbh,$word)=@_;
print "timeb=".time.br if $debug;
$word=$dbh->quote(uc $word);	$word=$dbh->quote(uc $word);
my $query="SELECT number from nests,nf where $word=w1 AND w2=nf.id";	my $query="SELECT number from nests,nf where $word=w1 AND w2=nf.id";
my $sth=$dbh->prepare($query);	my $sth=$dbh->prepare($query);
$sth->execute;	$sth->execute;
my @a=$sth->fetchrow;	my @a=$sth->fetchrow;
print "timee0=".time.br if $debug;
$sth->finish;	$sth->finish;
$a[0]\|\|0;	$a[0]\|\|0;
}	}
Line 159 print "timee0=".time.br if $debug;	Line 311 print "timee0=".time.br if $debug;
sub printform	sub printform
{	{

my $submit=submit(-value=>'Поиск');	my $qnumber=(" "x10)."Выводить по
my $inputstring=textfield(-name=>'sstr',	<input type=\"text\" name=\"kvo\" value=$outputkvo size=\"3\" maxlength=\"5\">";
-default=>param('sstr')\|\|'',	#textfield(-name=>'kvo',
-size=>30,	# -default=>6,
-maxlength=>50);	# -size=>3,
my $qnumber="Выводить по".br. textfield(-name=>'kvo',	# -maxlength=>5)." вопросов";
-default=>param('kvo')\|\|'150',	my $sstr=param('sstr');
-size=>3,
-maxlength=>5). br."вопросов";

my @df=keys %searchin;	my @df=keys %searchin;
	my %checked;
	$checked{lc $_}="" foreach ('Question','Answer','Comments','Authors','Sources','old','rus',
	'chgk','brain','igp','game','ehruditka','beskrylka');
@df=('Question', 'Answer') unless @df;	@df=('Question', 'Answer') unless @df;
	$checked{lc $_}="checked" foreach @df;
my $fields=checkbox_group('searchin',['Question','Answer','Comments','Authors','Sources'], [@df],	my $fields=checkbox_group('searchin',['Question','Answer','Comments','Authors','Sources'], [@df],
'false',\%rusfieldname);	'false',\%rusfieldname);
@df=param('type');	@df=param('type');
@df=('chgk','brain','game','ehruditka','beskrylka') unless @df;	@df=('chgk','brain','igp','game','ehruditka','beskrylka') unless @df;
	$checked{lc $_}="checked" foreach @df;
my $types=checkbox_group('type',['chgk','brain','game','ehruditka','beskrylka'], [@df],	my $all=param('all') && param('all') eq 'yes';
'false',\%rusfieldname);
my $metod=radio_group(-name=>'metod',-values=>['old','rus'],	$checked{'all'}=$all?"checked":"";
-default=>(param('metod')\|\|'rus'),	$checked{'any'}=$all?"":"checked";
-labels=>\%rusfieldname);	$checked{lc param('metod')}="checked";
my $all=radio_group(-name=>'all',-values=>['yes','no'],	$checked{'rus'}=1 unless $checked{'rus'} \|\| $checked{'old'};
-default=>(param('all')\|\|'no'),
-labels=>{'yes'=>'Все','no'=>'Любое'});

#################################################	#################################################
return start_form(-method=>'get',	return
-action=>url,	<<EOT
-enctype=>	<form method="get" enctype="application/x-www-form-urlencoded"
"application/x-www-form-urlencoded"	action="/znatoki/cgi-bin/db.cgi">
).br.	<h2>Поиск в базе вопросов</h2>
table(Tr
(	<input type="text" name="sstr" value="$sstr" size="30" maxlength="50">
td({-valign=>'TOP'},$inputstring.$submit.p."Метод: $metod".p."Слова: $all"),	<input type="submit" value="Поиск"> $qnumber
td({-valign=>'TOP'},(' 'x 8).'Поля:'),	<p>
td({-valign=>'TOP'},$fields),
td({-valign=>'TOP'},(' 'x 1).'Типы:'),	<table border="1" cellpadding=4 cellspacing=0>
td({-valign=>'TOP'},$types), td(" "x5),	<tr>
td({-valign=>'TOP'},$qnumber)	<th align="left" rowspan=3 width="20%"> Вариант поиска:
)	</td><td rowspan=2 colspan=2>
)	<input type="radio" $checked{'old'} name="metod" value="old"> Простой (старый)
	</td><td>
#$fields.	<input type="checkbox" $checked{'chgk'} name="type" value="chgk"> "Что? Где? Когда?"
#$inputstring.$submit.br.$metod.$all	</td><td><nobr>
	<input type="checkbox" $checked{'brain'} name="type" value="brain"> "Брейн-Ринг"</nobr>
	</td><td>
	<input type="checkbox" $checked{'igp'} name="type" value="igp"> "Интернет"
	</td>
	</tr><tr>
	<td>
	<input type="checkbox" $checked{'game'} name="type" value="game"> "Своя игра"
	</td><td>
	<input type="checkbox" $checked{'ehruditka'} name="type" value="ehruditka"> "Эрудитка"
	</td><td>
	<input type="checkbox" $checked{'beskrylka'} name="type" value="beskrylka"> "Бескрылка"
	</td>
	</tr><tr>
	<td colspan=5><input type="radio" $checked{'rus'} name="metod" value="rus"> Расширенный (с учетом грамматики, в вопросах всех типов)
	</td>
	</tr><tr>
	<th align="left">Искать:
	</td><td colspan=2>
	<input type="radio" $checked{'all'} name="all" value="yes">Все слова
	</td><td colspan=3>
	<input type="radio" $checked{'any'} name="all" value="no">Любое слово
	</td>
	</tr><tr>
	<th align="left">Поля для поиска:
	</td><td width="15%">
	<input type="checkbox" name="searchin" value="Question" $checked{'question'}>Вопрос
	</td><td width="15%">
	<input type="checkbox" name="searchin" value="Answer" $checked{'answer'}>Ответ<br>
	</td><td width="15%">
	<input type="checkbox" name="searchin" value="Comments" $checked{'comments'}>Комментарии<br>
	</td><td width="15%">
	<input type="checkbox" name="searchin" value="Authors" $checked{'authors'}>Автор<br>
	</td><td width="15%">
	<input type="checkbox" name="searchin" value="Sources" $checked{'sources'}>Источник<br>
	</td>
	</tr>
	</table>
	</center>

	EOT
.endform	.endform
.hr	.hr

}	}

sub proxy	sub proxy
{	{
#print "time0=".time.br if $debug;
my ($dbh,$ptext,$allnf)=@_;	my ($dbh,$ptext,$allnf)=@_;
	my $sstr=makeproxysstr($dbh,$ptext,$allnf);
	return russearch($dbh,$sstr,0,$allnf);
	}

	sub makeproxysstr {
	my ($dbh,$ptext)=@_;
my $text=$$ptext;	my $text=$$ptext;
	POSIX::setlocale( &POSIX::LC_ALL, $thislocale );
$text=~tr/ёЁ/еЕ/;	$text=~tr/ёЁ/еЕ/;
$text=~s/(${RLrl})p(${RLrl})/$1p$2/gom;	$text=~s/(${RLrl})p(${RLrl})/$1p$2/gom;
$text=~s/p(${RLrl})/р$1/gom;	$text=~s/p(${RLrl})/р$1/gom;
Line 222 sub proxy	Line 419 sub proxy
$text=~s/[^йцукенгшщзхъфывапролджэячсмитьбюЙЦУКЕНГШЩЗХЪФЫВАПРОЛДЖЭЯЧСМИТЬБЮQWERTYUIOPASDFGHJKLZXCVBNM0-9]/ /g;	$text=~s/[^йцукенгшщзхъфывапролджэячсмитьбюЙЦУКЕНГШЩЗХЪФЫВАПРОЛДЖЭЯЧСМИТЬБЮQWERTYUIOPASDFGHJKLZXCVBNM0-9]/ /g;
$text=uc $text;	$text=uc $text;
my @list= $text=~m/(?:(?:${RLrl})+)\|(?:[A-Za-z0-9]+)/gom;	my @list= $text=~m/(?:(?:${RLrl})+)\|(?:[A-Za-z0-9]+)/gom;

my (%c, %good,$sstr);	my (%c, %good,$sstr);
foreach (@list)	foreach (@list)
{	{
Line 230 sub proxy	Line 428 sub proxy
my @words=sort {$c{$a}<=> $c{$b}} @list;	my @words=sort {$c{$a}<=> $c{$b}} @list;

# $good{$words[$_]}=1 foreach 0..4;	# $good{$words[$_]}=1 foreach 0..4;

foreach (@words)	foreach (@words)
{	{
$good{$_}=1 if $c{$_}<200;	$good{$_}=1 if $c{$_}<200;
Line 238 sub proxy	Line 435 sub proxy

$good{$words[$_]}=0 foreach 16..$#words;	$good{$words[$_]}=0 foreach 16..$#words;

# foreach (@list)
# {
# if ($good{$_})
# {
# $good{$_}=0;
# $sstr.=" $_";
# }
# }
$sstr.=" $_" foreach grep {$good{$_}} @list;	$sstr.=" $_" foreach grep {$good{$_}} @list;
print "time05=".time.br if $debug;
$$ptext=$sstr;	$$ptext=$sstr;
return russearch($dbh,$sstr,0,$allnf);	return $sstr;
}	}


Line 269 sub russearch {	Line 457 sub russearch {
my %relevance;	my %relevance;
my @blob;	my @blob;
my %count;	my %count;
	POSIX::setlocale( &POSIX::LC_ALL, $thislocale );
$sstr=~tr/йцукенгшщзхъфывапролджэячсмитьбю/ЙЦУКЕНГШЩЗХЪФЫВАПРОЛДЖЭЯЧСМИТЬБЮ/;	$sstr=~tr/йцукенгшщзхъфывапролджэячсмитьбю/ЙЦУКЕНГШЩЗХЪФЫВАПРОЛДЖЭЯЧСМИТЬБЮ/;
@qw=@w =split (' ', uc $sstr);	# @qw=@w =split (' ', uc $sstr);
	my $ts=uc $sstr;
	@qw=@w= $ts=~m/(?:(?:${RLrl})+)\|(?:[A-Za-z0-9]+)/gom;


#-----------	#-----------
foreach $i (0..$#w) # заполняем массив @nf начальных форм	foreach $i (0..$#w) # заполняем массив @nf начальных форм
Line 281 $sstr=~tr/йцукенгшщзхъфывапролджэячсмить	Line 472 $sstr=~tr/йцукенгшщзхъфывапролджэячсмить
$qw= $dbh->quote (uc $w[$i]);	$qw= $dbh->quote (uc $w[$i]);
$query=" select distinct w2 from nests	$query=" select distinct w2 from nests
where w1=$qw";	where w1=$qw";
print "$query",br if $printqueries;
$sth=$dbh -> prepare($query);	$sth=$dbh -> prepare($query);
$sth -> execute;	$sth -> execute;
@{$nf[$i]}=();	@{$nf[$i]}=();
Line 312 print "$query",br if $printqueries;	Line 502 print "$query",br if $printqueries;

my $kvo=0;	my $kvo=0;
push @$allnf, @{$_} foreach @nf;	push @$allnf, @{$_} foreach @nf;
print "nf=@$allnf" if $printqueries;

foreach $i (0..$#w) #запросы в базу...	foreach $i (0..$#w) #запросы в базу...
{	{
Line 322 print "$query",br if $printqueries;	Line 511 print "$query",br if $printqueries;



$_= " word2question.word=".$_. ' ' foreach @arr;	$_= " word2question.word=$_" foreach @arr;
$_= " nf.id=".$_. ' ' foreach @arr1;	$_= " nf.id=".$_. ' ' foreach @arr1;
# @arr=(0) unless @arr;	# @arr=(0) unless @arr;
$query="select questions from word2question where". (join ' OR ', @arr);	$query="select questions from word2question where (". (join ' OR ', @arr).") AND length(questions)<80000";
print STDERR "!$query\n",br if $printqueries;

$sth=$dbh -> prepare($query);	$sth=$dbh -> prepare($query);
$sth->execute;	$sth->execute;
Line 338 print STDERR "!$query\n",br if $printque	Line 526 print STDERR "!$query\n",br if $printque
}	}
$sth->finish;	$sth->finish;
$query="select number from nf where ".(join ' OR ', @arr1);	$query="select number from nf where ".(join ' OR ', @arr1);
print "$query\n",br if $printqueries;
$sth=$dbh -> prepare($query);	$sth=$dbh -> prepare($query);
$sth->execute;	$sth->execute;

Line 386 print "$query\n",br if $printqueries;	Line 573 print "$query\n",br if $printqueries;
}	}
} #foreach $i	} #foreach $i

#print "keys tasksof", join ' ', keys %{$tasksof{0}};
#Ищем пересечение или объединение списков вопросов (значений %tasksof)	#Ищем пересечение или объединение списков вопросов (значений %tasksof)
foreach $sf (keys %tasksof)	foreach $sf (keys %tasksof)
{	{
Line 396 print "$query\n",br if $printqueries;	Line 582 print "$query\n",br if $printqueries;
keys %count) ;	keys %count) ;


print "\n\$#tasks=",$#tasks,br if $printqueries;
############ Сортировка найденных вопросов	############ Сортировка найденных вопросов

foreach (keys %wordsof)	foreach (keys %wordsof)
Line 406 foreach (keys %wordsof)	Line 591 foreach (keys %wordsof)

@tasks=sort {$relevance{$b}<=>$relevance{$a}} @tasks;	@tasks=sort {$relevance{$b}<=>$relevance{$a}} @tasks;


############	############

print "tasks=@tasks" if $printqueries;

#print "$_ $relevance{$_} \| " foreach @tasks;
#print br;
print "allnf=@$allnf",br if $printqueries;
return @tasks;	return @tasks;
}	}

Line 468 sub Search {	Line 648 sub Search {
my $sstr=$$s;	my $sstr=$$s;
my (@arr, @Questions, @fields);	my (@arr, @Questions, @fields);
my (@sar, $i, $sth,$where,$query);	my (@sar, $i, $sth,$where,$query);
# my $ip=$ENV{'REMOTE_ADDR'};

# $ip=$dbh->quote($ip);
# $query=
# "INSERT into queries (query,metod,searchin,ip)
# values (". $dbh->quote($sstr).', '.
# $dbh->quote($metod) . ', ' .
# $dbh->quote(join ' ', grep $searchin{$_}, keys %searchin) .
# ", $ip)";
#print $query if $printqueries;
# $dbh -> do ($query);
if ($metod eq 'rus')	if ($metod eq 'rus')
{	{
my @tasks=russearch($dbh,$sstr,$all,$allnf);	my @tasks=russearch($dbh,$sstr,$all,$allnf);
Line 486 sub Search {	Line 655 sub Search {
}	}
elsif ($metod eq 'proxy')	elsif ($metod eq 'proxy')
{	{
# $searchin{'question'}=1;
# $searchin{'answer'}=1;
my @task=proxy($dbh,$s,$allnf);	my @task=proxy($dbh,$s,$allnf);
# $$s=$sstr;
return @task	return @task
}	}

Line 516 sub Search {	Line 682 sub Search {
$where= $$q{'matchexp'};	$where= $$q{'matchexp'};
$query= "SELECT Questionid FROM Questions	$query= "SELECT Questionid FROM Questions
WHERE $where";	WHERE $where";
print br."Query is: $query".br if $debug;

$sth = $dbh->prepare($query);	$sth = $dbh->prepare($query);
} else	} else
Line 548 sub Search {	Line 713 sub Search {
WHERE ($f LIKE $sstr) AND (".&makewhere.") ORDER BY QuestionId";	WHERE ($f LIKE $sstr) AND (".&makewhere.") ORDER BY QuestionId";


print $query if $printqueries;
$sth = $dbh->prepare($query)	$sth = $dbh->prepare($query)
} #else -- processing old-style query (R7)	} #else -- processing old-style query (R7)

Line 557 print $query if $printqueries;	Line 721 print $query if $printqueries;
push @Questions, $arr[0] unless $forbidden{$arr[0]};	push @Questions, $arr[0] unless $forbidden{$arr[0]};
}	}
$sth->finish;	$sth->finish;
print "@Questions" if $printqueries;

return @Questions;	return @Questions;
}	}
Line 592 sub NoCase {	Line 755 sub NoCase {

sub PrintList {	sub PrintList {
my ($dbh,$Questions,$shablon,$was)=@_;	my ($dbh,$Questions,$shablon,$was)=@_;
	my $Output;
my $first=param('first') \|\|1;	my $first=param('first') \|\|1;
my $kvo=param('kvo') \|\|150;	$first=$first-($first-1)%$outputkvo;
	my $fkvo=param('fkvo')\|\|($#$Questions+1);
$first=$first-($first-1)%$kvo;	my $last=$first+$outputkvo-1;
my $last=$first+$kvo-1;	$last=$fkvo if $fkvo<$last;
$last=scalar @$Questions if scalar @$Questions <$last;
my($f,$l);	my($f,$l);
my $nav='';	my $nav='';
my $qs=query_string;	my $qs=query_string;
Line 606 sub PrintList {	Line 768 sub PrintList {
$qs=~s/\&first\=[^\&]+//g;	$qs=~s/\&first\=[^\&]+//g;
my $sstr=param('sstr')\|\|'';	my $sstr=param('sstr')\|\|'';
$qs=~s/sstr=[^\&]+/sstr=$sstr/;	$qs=~s/sstr=[^\&]+/sstr=$sstr/;
$qs=~s/\&was=[^\&]+//;	if ($usewas) {
$qs.="&was=$was"\|\|'';	$qs=~s/\&was=[^\&]+//;
if ($first>$kvo*3+1)	$qs.="&was=$was" if $was;
	$qs.="&fkvo=$fkvo" if $was;
	}
	if ($first>$outputkvo*3+1)
{	{
$nav.=	$nav.=
(" "x4).	(" "x4).
a({href=>url."?".$qs."\&first=1"},"<<").(" "x4).	a({href=>$url."?".$qs."\&first=1"},"<<").(" "x4).
a({href=>(url."?".$qs."\&first=".($first-$kvo))},"<").(" "x4)	a({href=>($url."?".$qs."\&first=".($first-$outputkvo))},"<").(" "x4)
}	}

else {$nav.=' 'x15;}	else {$nav.=' 'x15;}

my ($fprint,$lprint);	my ($fprint,$lprint);
my $llprint=$#$Questions- ($#$Questions+1)%$kvo+2;	my $llprint=$fkvo- ($fkvo)%$outputkvo+1; #
if ($#$Questions+1<=$kvo*7)	if ($fkvo<=$outputkvo*7)
{ $fprint=1;	{ $fprint=1;
$lprint=$llprint;	$lprint=$llprint;
}	}
elsif ($first>$kvo3 && $#$Questions+1-$first>$kvo3)	elsif ($first>$outputkvo3 && $fkvo-$first>$outputkvo3)
{	{
$fprint=$first-$kvo*3;	$fprint=$first-$outputkvo*3;
$lprint=$first+$kvo*3;	$lprint=$first+$outputkvo*3;
}	}
elsif ($first<=$kvo*3)	elsif ($first<=$outputkvo*3)
{	{
$fprint=1; $lprint=6*$kvo+1;	$fprint=1; $lprint=6*$outputkvo+1;
}	}
else	else
{	{
$lprint=$llprint;	$lprint=$llprint;
$fprint=$lprint-$kvo*6	$fprint=$lprint-$outputkvo*6
}	}

# my $fprint=($first>$kvo3) ? $first-$kvo3 : 1;	# my $fprint=($first>$outputkvo3) ? $first-$outputkvo3 : 1;
# my $lprint=$#$Questions+1-$fprint>$kvo7 ? $kvo7 :$#$Questions+1;	# my $lprint=$#$Questions+1-$fprint>$outputkvo7 ? $outputkvo7 :$#$Questions+1;
# if ($lprint-$fprint<$kvo*6 && $fprint>1)	# if ($lprint-$fprint<$outputkvo*6 && $fprint>1)
# {	# {
# $fprint=$lprint-$kvo*6;	# $fprint=$lprint-$outputkvo*6;
# $fprint=1 if ($fprint<=0)	# $fprint=1 if ($fprint<=0)
# }	# }



for($f=$fprint; $f<=$lprint; $f+=$kvo)	for($f=$fprint; $f<=$lprint; $f+=$outputkvo)
{	{
# next if $first-$f>$kvo*3;	# next if $first-$f>$outputkvo*3;
$l=$f+$kvo-1;	$l=$f+$outputkvo-1;
$l=$#$Questions+1 if $l>$#$Questions+1;	$l=$fkvo if $l>$fkvo+1;
if ($f==$first) {$nav.="[$f-$l] ";}	if ($f==$first) {$nav.="[$f-$l] ";}
else {	else {
$nav.= "[".a({href=>(url."?".$qs."\&first=$f")},"$f-$l")."] ";}	$nav.= "[".a({href=>($url."?".$qs."\&first=$f")},"$f-$l")."] ";}
}	}
if ($lprint+$kvo<$#$Questions)	if ($lprint+$outputkvo<$fkvo)
{	{
$nav.=	$nav.=
(" "x4).	(" "x4).
a({href=>(url."?".$qs."\&first=".($first+$kvo))},">").(" "x4).	a({href=>($url."?".$qs."\&first=".($first+$outputkvo))},">").(" "x4).
a({href=>url."?".$qs."\&first=$llprint"},">>").(" "x4)	a({href=>$url."?".$qs."\&first=$llprint"},">>").(" "x4)
}	}
	$Output.= "$nav".br."\n";
	my @q=@$Questions[$first-1..$last-1];
	my %q=();
	my $sth=SelectQuestions($dbh,\@q,1);
	my $qq;
	my @Q;
	for (0..$#q) {
	%{$Q[$_]}=();
	fetchquestion($sth,$Q[$_],1);
	$q{$Q[$_]{'QuestionId'}}=$Q[$_];
	}


print "$nav".br."\n";
for (my $i = $first; $i <= $last; $i++) {	for (my $i = $first; $i <= $last; $i++) {
my $output = &PrintQuestion($dbh, $$Questions[$i-1], 1, 0, 1);	my $q=$q{$$Questions[$i-1]};
if (param('metod') && (param('metod') eq 'rus' \|\| param('metod') eq 'proxy'))	my $output;
	$output = &PrintQuestion($dbh, $q, 1, 0, 1,0,1 );
	# if (param('metod') && (param('metod') eq 'rus' \|\| param('metod') eq 'proxy'))
{	{
$output=~s/\b($shablon)\b/\<strong\>$1\<\/strong\>/gi;	$output=~s/\b($shablon)\b/\<strong\>$1\<\/strong\>/gi;
} else {
$output=~s/($shablon)/\<strong\>$1\<\/strong\>/gi;	$output=~s/($shablon)/\<strong\>$1\<\/strong\>/gi;
}	}
print $output;	$Output.= $output;
}	}
	$sth->finish;

	$Output.= "$nav".br."\n";
print "$nav".br."\n";	return $Output;

}	}

sub PrintSearch {	sub PrintSearch {
	my $Output='';
my ($dbh, $sstr, $metod,$was) = @_;	my ($dbh, $sstr, $metod,$was) = @_;
my $t=time;	my $t=time;
print h2("Поиск в базе вопросов");	$Output.= printform;
print printform;
my @allnf;	my @allnf;
my @Questions;	my @Questions;
if ($was)	$was=0 if $metod eq 'proxy';
	if ($usewas && $was && ($metod ne 'proxy'))
{	{
my $sth=$dbh->prepare ("select sstr,questions,allnf from lastqueries where id=".param('was'));	my $sth=$dbh->prepare ("select sstr,questions,allnf from lastqueries where id=".param('was'));
$sth->execute;	$sth->execute;
Line 700 sub PrintSearch {	Line 875 sub PrintSearch {
@Questions=unpack 'L*',$q;	@Questions=unpack 'L*',$q;
@allnf=unpack 'L*',$nf;	@allnf=unpack 'L*',$nf;
$sth->finish;	$sth->finish;
} else	}
	if (!$was \|\| ($metod eq 'proxy') \|\| (param('first')+$outputkvo>$cashednumber))
{	{
@Questions=&Search($dbh, \$sstr,$metod,$all,\@allnf);	@Questions=&Search($dbh, \$sstr,$metod,$all,\@allnf);
my $tmp=$dbh->quote(pack("L*",@Questions));	$cashednumber=$#Questions if $cashednumber>$#Questions;
	my $tmp=$dbh->quote(pack("L*",@Questions[0..$cashednumber]));
my $qsstr=$dbh->quote($sstr);	my $qsstr=$dbh->quote($sstr);
my $nf=$dbh->quote(pack("L*", @allnf));	my $nf=$dbh->quote(pack("L*", @allnf));
my $ss=200;	my $ss=200;
do	if ($usewas) {
{	do
$was=int rand(32000);	{
}	$was=int rand(32000);
while (--$ss && (!$dbh->do ("insert into lastqueries (id,sstr,questions,allnf)	}
	while (--$ss && (!$dbh->do ("insert into lastqueries (id,sstr,questions,allnf)
values ($was, $qsstr,$tmp,$nf)")));	values ($was, $qsstr,$tmp,$nf)")));
print "Something is wrong...".br unless $ss;	$Output.= "Something is wrong...".br unless $ss;
	}
}	}



print p. "Время поиска: " . (time-$t) ." сек.".p;	$Output.= p. "Время поиска: " . (time-$t) ." сек.".p;
my ($output, $i, $suffix, $hits) = ('', 0, '', $#Questions + 1);	my ($output, $i, $suffix, $hits) = ('', 0, '', $#Questions + 1);

my $shablon;	my $shablon;
Line 729 sub PrintSearch {	Line 908 sub PrintSearch {
$where.= " or w2=$_ " foreach @allnf;	$where.= " or w2=$_ " foreach @allnf;
my $query="select w1 from nests where $where";	my $query="select w1 from nests where $where";
my $sth=$dbh->prepare($query);	my $sth=$dbh->prepare($query);
print "$query" if $printqueries;

$sth->execute;	$sth->execute;
my @shablon;	my @shablon;
Line 742 print "$query" if $printqueries;	Line 920 print "$query" if $printqueries;
$shablon=~s/[её]/\[ЕЁ\]/gi;	$shablon=~s/[её]/\[ЕЁ\]/gi;
# $shablon=~s/([йцукенгшщзхъфывапролджэячсмитьбюЙЦУКЕНГШЩЗХЪФЫВАПРОЛДЖЭЯЧСМИТЬБЮ])/&NoCase($1)/ge;	# $shablon=~s/([йцукенгшщзхъфывапролджэячсмитьбюЙЦУКЕНГШЩЗХЪФЫВАПРОЛДЖЭЯЧСМИТЬБЮ])/&NoCase($1)/ge;
$shablon=qr/$shablon/i;	$shablon=qr/$shablon/i;
print "!$shablon!",br if $printqueries;

}	}

	$hits=param("fkvo")\|\|$hits;

if ($hits =~ /1.$/ \|\| $hits =~ /[5-90]$/) {	if ($hits =~ /1.$/ \|\| $hits =~ /[5-90]$/) {
$suffix = 'й';	$suffix = 'й';
Line 756 print "$query" if $printqueries;	Line 933 print "$query" if $printqueries;
$suffix = 'я';	$suffix = 'я';
}	}

print p({align=>"center"}, "Результаты поиска на " . strong($sstr)	$Output.= p({align=>"center"}, "Результаты поиска на " . strong($sstr)
. " : $hits попадани$suffix.");	. " : $hits попадани$suffix.");

if (param('word')) {	if (param('word')) {
Line 773 print "$query" if $printqueries;	Line 950 print "$query" if $printqueries;
s/(\W)/\\$1/g foreach (@sar);	s/(\W)/\\$1/g foreach (@sar);
$shablon=join "\|",@sar;	$shablon=join "\|",@sar;
}	}
PrintList($dbh,\@Questions,$shablon,$was);	$Output.=PrintList($dbh,\@Questions,$shablon,$was);
	return $Output;
}	}

sub PrintRandom {	sub PrintRandom {
my ($dbh, $type, $num, $text) = @_;	my ($dbh, $type, $num, $text) = @_;
	my $razd=param('razd');
	my %q;
	my $answer=$razd?0:1;
	my @answers;
my (@Questions) = &Get12Random($dbh, $type, $num);	my (@Questions) = &Get12Random($dbh, $type, $num);
my ($output, $i) = ('', 0);	my ($output, $i) = ('', 0);

Line 787 sub PrintRandom {	Line 969 sub PrintRandom {
$output .=	$output .=
h2({align=>"center"}, "$num случайных вопросов.");	h2({align=>"center"}, "$num случайных вопросов.");
}	}
	my $sth=SelectQuestions($dbh,\@Questions,0);
for ($i = 0; $i <= $#Questions; $i++) {	for ($i = 0; $i <= $#Questions; $i++) {
# Passing DB handler, question ID, print answer, question	fetchquestion($sth,\%q,0);
# number, print title, print text/html
$output .=	$output .=
&PrintQuestion($dbh, $Questions[$i], 1, $i + 1, 0, $text);	&PrintQuestion($dbh, \%q, $answer, $i + 1, 0, $text,1);
	push @answers, $q{'Answer'};
}	}
	$sth->finish;
	unless ($answer )
	{
	$output.=$text?"\n".('-'x 20)."\nОтветы\n~~~~~~\n\n":h2('Ответы');
	$sth=SelectQuestions($dbh,\@Questions,0);
	for ($i = 0; $i <= $#Questions; $i++) {
	# fetchquestion($sth,\%q,0);
	# $output .=
	# &PrintQuestion($dbh, \%q, -1, $i + 1, 0, $text,1);
	$output.=$text?("Ответ ". ($i+1).": $answers[$i]\n\n"):
	b("Ответ ". ($i+1).": "). $answers[$i].p;
	}
	}

return $output;	return $output;
}	}

Line 812 sub PrintTournament {	Line 1008 sub PrintTournament {

%Tournament = &GetTournament($dbh, $Id) if ($Id);	%Tournament = &GetTournament($dbh, $Id) if ($Id);

my ($URL) = $Tournament{'URL'};	my ($URL) = $Tournament{'URL'}\|\|'';
	$URL=~s/http:\/znatoki\/boris\/reports\//$newsurl/ if $url=~/kulichki/ \|\| $url=~/db.chgk.info/;
	$URL=~s/\/znatoki\/boris\/reports\//$newsurl/ if url=~/kulichki/ \|\| $url=~/db.chgk.info/;
my ($Info) = $Tournament{'Info'};	my ($Info) = $Tournament{'Info'};
my ($Copyright) = $Tournament{'Copyright'};	my ($Copyright) = $Tournament{'Copyright'};
my $fname=$Tournament{'FileName'};	my $fname=$Tournament{'FileName'};
Line 866 sub PrintTournament {	Line 1064 sub PrintTournament {
} else {	} else {
$qnum = '';	$qnum = '';
}	}
if ($Tournament{'Type'} =~ /Г/) {	if ($Tournament{'Type'} !~ /[ТЧ]/) {
$SingleTour=0;	$SingleTour=0;
$imgsrc = "/icons/folder.gif";	$imgsrc = "/icons/folder.gif";
$alt = "[*]";	$alt = "[*]";
Line 888 sub PrintTournament {	Line 1086 sub PrintTournament {
else {$textid=$Tournament{'Id'}};	else {$textid=$Tournament{'Id'}};


if ($SingleTour or $Tournament{'Type'} =~ /Т/) {	if ($SingleTour or ($Tournament{'Type'} =~ /Т/)) {
$list .= dd(img({src=>$imgsrc, alt=>$alt})	$list .= dd(img({src=>$imgsrc, alt=>$alt})
. " " . $Tournament{'Title'} . " " .	. " " . $Tournament{'Title'} . " " .
$Tournament{'PlayedAt'} . $qnum) .	($Tournament{'PlayedAt'}\|\|"") . $qnum) .
dl(	dl(
dd("["	dd("["
. a({href=>url . "?tour=$textid&answer=0"},	. a({href=>tourhref($textid,0)},
"вопросы") . "] ["	"вопросы") . "] ["
. a({href=>url . "?tour=$textid&answer=1"},	. a({href=>tourhref($textid,1)},
"вопросы + ответы") . "]")	"вопросы + ответы") . "]")
);	);
} else {	} else {
$list .= dd(a({href=>url . "?tour=$textid&comp=1"},	$list .= dd(a({href=>
img({src=>'/icons/compressed.gif', alt=>'[ZIP]', border=>1})). " " .	$url . "?tour=$textid&comp=1"},
	img({src=>'/icons/compressed.gif', alt=>'[ZIP]', border=>1})) .
	" " .
img({src=>$imgsrc, alt=>$alt})	img({src=>$imgsrc, alt=>$alt})
. " " . a({href=>url . "?tour=$textid&answer=0"},	. " " . a({href=>tourhref($textid,0,1)},
$Tournament{'Title'}. " ".	$Tournament{'Title'}. " ".
$Tournament{'PlayedAt'}\|\|'') . $qnum);	($Tournament{'PlayedAt'}\|\|'')) . $qnum);
}	}
}	}
$output .= dl($list);	$output .= dl($list);

if ($URL) {	if ($URL) {
if (url=~/zaba\.ru/ && $URL=~/^\//){$URL="http://info.chgk.info$URL"}	if ($url=~/zaba\.ru/ && $URL=~/^\//){$URL="http://info.chgk.info$URL"}
$output .=	$output .=
p("Дополнительная информация об этом турнире - по адресу " .	p("Дополнительная информация об этом турнире - по адресу " .
a({-'href'=>$URL}, $URL));	a({-'href'=>$URL}, $URL));
Line 966 sub PrintTour {	Line 1166 sub PrintTour {
my (%Tour) = &GetTournament($dbh, $Id);	my (%Tour) = &GetTournament($dbh, $Id);
my (@Tours) = &GetTours($dbh, $Tour{'ParentId'});	my (@Tours) = &GetTours($dbh, $Tour{'ParentId'});
my (%Tournament) = &GetTournament($dbh, $Tour{'ParentId'});	my (%Tournament) = &GetTournament($dbh, $Tour{'ParentId'});
	my %q;

return 0	return 0
if ($Tour{'Type'} !~ /Т/);	if ($Tour{'Type'} !~ /Т/);
Line 982 sub PrintTour {	Line 1183 sub PrintTour {
$output .=&PrintEditor(\%Tour);	$output .=&PrintEditor(\%Tour);

my (@Questions) = &GetTourQuestions($dbh, $Id);	my (@Questions) = &GetTourQuestions($dbh, $Id);
	my $sth=SelectQuestions($dbh,\@Questions,0);
for ($q = 0; $q <= $#Questions; $q++) {	for ($q = 0; $q <= $#Questions; $q++) {
$output .= &PrintQuestion($dbh, $Questions[$q], $answer, 0);	fetchquestion($sth,\%q,0);
	$output .= &PrintQuestion($dbh, \%q, $answer, 0,0,0,1);
}	}
	$sth->finish;
$output .= hr({-'align'=>'center', -'width'=>'80%'});	$output .= hr({-'align'=>'center', -'width'=>'80%'});

if ($Tournament{'URL'}) {	if ($Tournament{'URL'}) {
Line 1004 sub PrintTour {	Line 1207 sub PrintTour {

my $n=$Tour{'Number'};	my $n=$Tour{'Number'};
if ($answer == 0) {	if ($answer == 0) {
	my $nn=".$n";
	$nn="" if ($n==1 && !&IsTour($dbh, $Tour{'ParentId'}, $n + 1));

$bottom .=	$bottom .=
"[" . a({href=>url . "?tour=$fname.$n&answer=1"}, "ответы") . "] " . br;	"[" . a({href=>tourhref("$fname$nn",1)},
	"ответы") . "] " . br;
}	}
if ($n>1) {	if ($n>1) {
$bottom .=	$bottom .=
"[" . a({href=>url . "?tour=$fname." . ($n - 1) . "&answer=0"},	"[" . a({href=>tourhref("$fname.".($n-1),0)},
"предыдущий тур") . "] ";	"предыдущий тур") . "] ";
$bottom .=	$bottom .=
"[" . a({href=>url . "?tour=$fname." . ($n - 1) . "&answer=1"},	"[" . a({href=>tourhref("$fname.".($n-1),1)},
"предыдущий тур с ответами") . "] " . br;	"предыдущий тур с ответами") . "] " . br;
}	}
if (&IsTour($dbh, $Tour{'ParentId'}, $n + 1)) {	if (&IsTour($dbh, $Tour{'ParentId'}, $n + 1)) {
$bottom .=	$bottom .=
"[" . a({href=>url . "?tour=$fname." . ($n + 1) . "&answer=0"},	"[" . a({href=>tourhref("$fname.".($n+1),0)},
"следующий тур") . "] ";	"следующий тур") . "] ";
$bottom .=	$bottom .=
"[" . a({href=>url . "?tour=$fname." . ($n + 1) . "&answer=1"},	"[" . a({href=>tourhref("$fname.".($n+1),1)},
"следующий тур с ответами") . "] ";	"следующий тур с ответами") . "] ";
}	}

Line 1038 sub PrintField {	Line 1245 sub PrintField {
$value =~ s/^\s+/<br>    /mg;	$value =~ s/^\s+/<br>    /mg;
$value =~ s/^\\|([^\n]*)/<pre>$1<\/pre>/mg;	$value =~ s/^\\|([^\n]*)/<pre>$1<\/pre>/mg;
$value =~ s/\s+-+\s+/  /mg;	$value =~ s/\s+-+\s+/  /mg;
	$value =~ s/(http:\/\/\S+[^\s\)\(\,\.])/<a href="$1">$1<\/a>/g if $header !~ /^Авто/;
	# $value =~ s/(http:\/\/(?:\w+.)+[\w\\\~]+(\?[^\s.]+)?)/<a href="$1">$1<\/a>/g if $header !~ /^Авто/;
# $value =~ s/(\s)"/$1/mg;	# $value =~ s/(\s)"/$1/mg;
# $value =~ s/^"//mg;	# $value =~ s/^"//mg;
# $value =~ s/"//mg;	# $value =~ s/"//mg;
Line 1051 sub PrintField {	Line 1260 sub PrintField {
# Gets a DB handler (ofcourse) and a question Id. Prints	# Gets a DB handler (ofcourse) and a question Id. Prints
# that question, according to the options.	# that question, according to the options.
sub PrintQuestion {	sub PrintQuestion {
my ($dbh, $Id, $answer, $qnum, $title, $text) = @_;	my ($dbh, $Id, $answer, $qnum, $title, $text,$h) = @_;
my ($output, $titles) = ('', '');	my ($output, $titles) = ('', '');
my (%Question) = &GetQuestion($dbh, $Id);	my (%Question);
$qnum = $Question{'Number'}	if ($h) {
if ($qnum == 0);	%Question=%$Id;
if (!$text) {	} else {
$output .= hr({width=>"50%"});	%Question = &GetQuestion($dbh, $Id);
if ($title) {	if ($title) {
my (%Tour) = GetTournament($dbh, $Question{'ParentId'});	my (%Tour) = GetTournament($dbh, $Question{'ParentId'});
my (%Tournament) = GetTournament($dbh, $Tour{'ParentId'});	my (%Tournament) = GetTournament($dbh, $Tour{'ParentId'});
my $fname=$Tournament{'FileName'};	$Question{'FileName'}=$Tournament{'FileName'};
	$Question{'Title'}=$Tournament{'Title'};
	$Question{'PlayedAt'}=$Tournament{'PlayedAt'};
	$Question{'TourNumber'}=$Tour{'Number'};
	$Question{'TourTitle'}=$Tour{'Title'};
	}

	}
	$qnum = $Question{'Number'}
	if ($qnum == 0);
	if (!$text) {
	$output .= hr({width=>"50%"}) if $answer>=0;
	if ($title) {
	my $fname=$Question{'FileName'};
$fname=~s/\.txt//;	$fname=~s/\.txt//;
$titles .=	$titles .=
dd(img({src=>"/icons/folder.open.gif"}) . " " .	dd(img({src=>"/icons/folder.open.gif"}) . " " .
a({href=>url . "?tour=$fname"}, $Tournament{'Title'}, $Tournament{'PlayedAt'}\|\|''));	a({href=>tourhref($fname,0,1)},
	$Question{'Title'}, $Question{'PlayedAt'}\|\|''));
$titles .=	$titles .=
dl(dd(img({src=>"/icons/folder.open.gif"}) . " " .	dl(dd(img({src=>"/icons/folder.open.gif"}) . " " .
a({href=>url . "?tour=$fname.$Tour{Number}#$qnum"}, $Tour{'Title'})));	a({href=>tourhref("$fname.$Question{'TourNumber'}#$qnum",1)},
	$Question{'TourTitle'})));
}	}
$output .= dl(strong($titles));	$output .= dl(strong($titles));
}	}


$output.= "<a NAME=\"$qnum\">";	$output.= "<a NAME=\"$qnum\">" unless $text;

$output .=
&PrintField("Вопрос $qnum", $Question{'Question'}, $text);

if ($answer==1) {	if ($answer>=0) {$output .=
	&PrintField("Вопрос $qnum", $Question{'Question'}, $text);}
	else {$output .="$qnum. "}
	if ($answer==1\|\| $answer==-1) {
$output .=	$output .=
&PrintField("Ответ", $Question{'Answer'}, $text);	&PrintField("Ответ", $Question{'Answer'}, $text);

if ($Question{'Authors'}) {	if ($Question{'Authors'} ) {
my $q=$Question{'Authors'};	my $q=$Question{'Authors'};
###АВТОРА!!	###АВТОРА!!
my $sth=$dbh->prepare("select Authors.Id,Name, Surname, Nicks from Authors, A2Q	# my $sth=$dbh->prepare("select Authors.CharId,Name, Surname, Nicks from Authors, A2Q
where Authors.Id=Author And Question=$Id");	# where Authors.Id=Author And Question=$Id");
$sth->execute;	# $sth->execute;
my ($AuthorId,$Name, $Surname,$other,$Nicks);	# my ($AuthorId,$Name, $Surname,$other,$Nicks);
	# if (!$text) {
while ((($AuthorId,$Name, $Surname,$Nicks)=$sth->fetchrow),$AuthorId)	# while ((($AuthorId,$Name, $Surname,$Nicks)=$sth->fetchrow),$AuthorId)
{	# {
my ($firstletter)=$Name=~m/^./g;	# my ($firstletter)=$Name=~m/^./g;
$Name=~s/\./\\\./g;	# $Name=~s/\./\\\./g;
my $sha="(?:$Name\\s+$Surname)\|(?:$Surname\\s+$Name)\|(?:$firstletter\\.\\s*$Surname)\|(?:$Surname\\s+$firstletter\\.)\|(?:$Surname)\|(?:$Name)";	# $Name=~s/ё/[её]/g;
if ($Nicks)	# $Surname=~s/ё/[её]/g;
{	# my $sha="(?:$Name\\s+$Surname)\|(?:$Surname\\s+$Name)\|(?:$firstletter\\.\\s*$Surname)\|(?:$Surname\\s+$firstletter\\.)\|(?:$Surname)";
$Nicks=~s/^\\|//;	# if ($Nicks)
foreach (split /\\|/, $Nicks)	# {
{	# $Nicks=~s/^\\|//;
s/\s+/ /g;	# foreach (split /\\|/, $Nicks)
s/\s+$//;	# {
s/ /\\s+/g;	# s/\s+/ /g;
s/\./\\\./g;	# s/\s+$//;
if (s/>$//) {$sha="$sha\|(?:$_)"}	# s/ /\\s+/g;
else {$sha="(?:$_)\|$sha"}	# s/\./\\\./g;
}	# if (s/>$//) {$sha="$sha\|(?:$_)"}
}	# else {$sha="(?:$_)\|$sha"}
$q=~s/($sha)/a({href=>url."?qofauthor=$AuthorId"},$1)/ei;	# }
}	# }
	# $q=~s/($sha)/a({href=>url."?qofauthor=$AuthorId"},$1)/ei;
	# unless ($1)
	# {
	# $q=~s/$Name/a({href=>url."?qofauthor=$AuthorId"},$1)/ei;
	# }
	# }
	# }
$output .= &PrintField("Автор(ы)", $q, $text);	$output .= &PrintField("Автор(ы)", $q, $text);

}	}
Line 1153 EOTT	Line 1383 EOTT
}	}



$output.="</span>"	$output.="</span>"

}	}
$output.=br.a({href=> url."?metod=proxy&qid=$Id"}, 'Близкие вопросы').p	$output=~s/$pic: ([^$]*)\)/<p><img src="\/znatoki\/images\/db\/$1"><p>/g unless $text;
if $answer;	$paramtour\|\|=param("tour");
	my $qid=$paramtour ? ($paramtour.".$Question{'Number'}" ): '';

	$output.=br.a({href=> $url."?metod=proxy&
	qid=$qid"}, 'Близкие вопросы').p
	if $answer>0 && !$text && $qid;
return $output;	return $output;
}	}

Line 1196 sub Get12Random {	Line 1432 sub Get12Random {
}	}
$where.= "OR (Type='ЧБ')" if ($type=~/Ч\|Б/);	$where.= "OR (Type='ЧБ')" if ($type=~/Ч\|Б/);

$q="select QuestionId, QuestionId/$r-floor(QuestionId/$r) as val	# $q="select QuestionId, QuestionId/$r-floor(QuestionId/$r) as val
from Questions where $where order by val limit $num";	# from Questions where $where order by val limit $num";
# Когда на куличках появится mysql >=3.23 надо заменить на order by rand();	# Когда на куличках появится mysql >=3.23 надо заменить на order by rand();
	$q="select QuestionId from Questions where $where order by rand() limit $num";


$sth=$dbh->prepare($q);	$sth=$dbh->prepare($q);
$sth->execute;	$sth->execute;
Line 1216 sub Get12Random {	Line 1454 sub Get12Random {

sub Include_virtual {	sub Include_virtual {
my ($fn, $output) = (@_, '');	my ($fn, $output) = (@_, '');
	return "\n<!--#include virtual=\"$fn\"-->\n" if ($opt_z);
open F , $fn	open F , $fn
or return; #die "Can't open the file $fn: $!\n";	or return ""; #die "Can't open the file $fn: $!\n";

while (<F>) {	while (<F>) {
if (/<!--#include/o) {	if (/<!--#include/o) {
s/<!--#include virtual="\/(.*)" -->/&Include_virtual($1)/e;	s/<!--#include virtual="\/?([^\/].*)" -->/&Include_virtual($1)/e;
}	}
if (/<!--#exec/o) {	if (/<!--#exec/o) {
s/<!--#exec.cmd\s=\s"([^"])".*-->/`$1`/e;	s/<!--#exec.cmd\s=\s"([^"])".*-->/`$1`/e;
}	}
$output .= $_;	$output .= $_;
}	}
return $output;	return $output\|\|"";
}	}

sub PrintArchive {	sub PrintArchive {
Line 1254 sub PrintAll {	Line 1492 sub PrintAll {

my (%Tournament) = &GetTournament($dbh, $Id);	my (%Tournament) = &GetTournament($dbh, $Id);
my (@Tours) = &GetTours($dbh, $Id);	my (@Tours) = &GetTours($dbh, $Id);
	my $SingleTour = $#Tours == 0;

my ($New) = ($Id and $Tournament{'Type'} eq 'Ч' and	my ($New) = ($Id and $Tournament{'Type'} eq 'Ч' and
&NewEnough($Tournament{"CreatedAt"})) ?	&NewEnough($Tournament{"CreatedAt"})) ?
img({src=>"/znatoki/dimrub/db/new-sml.gif", alt=>"NEW!"}) : "";	img({src=>"/znatoki/dimrub/db/new-sml.gif", alt=>"NEW!"}) : "";
Line 1275 sub PrintAll {	Line 1515 sub PrintAll {


$output .= dd(img({src=>"/icons/folder.gif", alt=>"[*]"}) .	$output .= dd(img({src=>"/icons/folder.gif", alt=>"[*]"}) .
" " . a({href=>url . "?tour=$textid&answer=0"},	" " . a({href=>tourhref($textid,0,!$SingleTour)},
$Tournament{'Title'}) ." " . ($Tournament{'PlayedAt'}\|\|'') . " $New");	$Tournament{'Title'}) ." " . ($Tournament{'PlayedAt'}\|\|'') . " $New");
}	}
if ($Id == 0 or $Tournament{'Type'} =~ /Г/ or $Tournament{'Type'} eq '') {	if ($Id == 0 or $Tournament{'Type'} =~ /Г/ or $Tournament{'Type'} eq '') {
Line 1309 sub PrintDates {	Line 1549 sub PrintDates {
if (!$array[0]);	if (!$array[0]);
%Tournament = &GetTournament($dbh, $array[0]);	%Tournament = &GetTournament($dbh, $array[0]);
$list .= dd(img({src=>"/icons/folder.gif", alt=>"[*]"}) .	$list .= dd(img({src=>"/icons/folder.gif", alt=>"[*]"}) .
" " . a({href=>url . "?tour=$Tournament{'Id'}&answer=0"},	" " . a({href=>tourhref($Tournament{'FileName'},0,1)},
$Tournament{'Title'}, $Tournament{'PlayedAt'}\|\|''));	$Tournament{'Title'}, $Tournament{'PlayedAt'}\|\|''));
}	}
$sth->finish;	$sth->finish;
Line 1321 sub PrintQOfAuthor	Line 1561 sub PrintQOfAuthor
{	{

my ($dbh, $id) = @_;	my ($dbh, $id) = @_;
$id=$dbh->quote($id);	my $Output='';
	unless ($id=~/^\d+$/) {
	$id=$dbh->quote($id);
	my $sth = $dbh->prepare("SELECT Id FROM Authors WHERE CharId=$id");
	$sth->execute;
	($id)=$sth->fetchrow;
	$sth->finish;
	}
	$id=$dbh->quote($id);

my $sth = $dbh->prepare("SELECT Name, Surname FROM Authors WHERE Id=$id");	my $sth = $dbh->prepare("SELECT Name, Surname FROM Authors WHERE Id=$id");
$sth->execute;	$sth->execute;
my ($name,$surname)=$sth->fetchrow;	my ($name,$surname)=$sth->fetchrow;
Line 1343 sub PrintQOfAuthor	Line 1592 sub PrintQOfAuthor
} else {	} else {
$suffix = 'я';	$suffix = 'я';
}	}
print h2("Поиск в базе вопросов");	$Output.= printform;
print printform;	$Output.= p({align=>"center"}, "Автор ".strong("$name $surname. ")
print p({align=>"center"}, "Автор ".strong("$name $surname. ")
. " : $hits попадани$suffix.");	. " : $hits попадани$suffix.");


Line 1353 sub PrintQOfAuthor	Line 1601 sub PrintQOfAuthor
# $output = &PrintQuestion($dbh, $Questions[$i], 1, $i + 1, 1);	# $output = &PrintQuestion($dbh, $Questions[$i], 1, $i + 1, 1);
# print $output;	# print $output;
# }	# }
PrintList($dbh,\@Questions,'gdfgdfgdfgdfg');	$Output.=PrintList($dbh,\@Questions,'gdfgdfgdfgdfg');
}	}


Line 1382 sub PrintAuthors	Line 1630 sub PrintAuthors


$sth->execute;	$sth->execute;
$output.=Tr(th[a({href=>url."?authors=name"},"Имя")	$output.=Tr(th[a({href=>$url."?authors=name"},"Имя")
.", ".	.", ".
a({href=>url."?authors=surname"},"фамилия")	a({href=>$url."?authors=surname"},"фамилия")
, a({href=>url."?authors=kvo"},"Количество вопросов")]);	, a({href=>$url."?authors=kvo"},"Количество вопросов")]);

$out1='';	$out1='';

Line 1398 a({href=>url."?authors=surname"},"фамили	Line 1646 a({href=>url."?authors=surname"},"фамили
{	{

my ($id,$name,$surname,$kvo)=@$arr;	my ($id,$name,$surname,$kvo)=@$arr;
if (!$name \|\| !$surname) {#print "Opanki at $id\n"	if (!$name \|\| !$surname) {
} else	} else
{	{
my $add=Tr(td([a({href=>url."?qofauthor=$id"},"$name $surname"), $kvo]))."\n";	my $add=Tr(td([a({href=>$url."?qofauthor=$id"},"$name $surname"), $kvo]))."\n";
print STDERR $add;
$output.=$add;	$output.=$add;
}	}
}	}
Line 1421 sub WriteFile {	Line 1668 sub WriteFile {

my $query= "SELECT Id, Title, Copyright, Info, URL,	my $query= "SELECT Id, Title, Copyright, Info, URL,
Editors, EnteredBy, PlayedAt, CreatedAt	Editors, EnteredBy, PlayedAt, CreatedAt
from Tournaments where FileName=".$dbh->quote("$fname.txt");	from Tournaments where FileName=
	'$fname' OR FileName=".$dbh->quote("$fname.txt");
my $sth=$dbh->prepare($query);	my $sth=$dbh->prepare($query);
my (%Question,%editor,%qnumber,%copyright,%author,%vid,%tourtitle);	my (%Question,%editor,%qnumber,%copyright,%author,%vid,%tourtitle);
$sth->execute;	$sth->execute;
Line 1562 sub WriteFile {	Line 1810 sub WriteFile {

}	}

	sub Bottom
	{
	my $output.=&Include_virtual("$footer")\|\|"";
	$output.=p."<center><font size=-2>Обновление: ".&Include_virtual("$datefooter")."</center></font>";
	$output.=<<EEE
	<SCRIPT LANGUAGE="JavaScript">
	function toggle(e) {
	if (e.style.display == "none") {
	e.style.display="";
	} else {
	e.style.display = "none";
	}
	}
	</SCRIPT>
	EEE
	;
	$output.=end_html;
	return $output;
	}


MAIN:	MAIN:
{	{

setlocale(LC_CTYPE,'russian');	setlocale(LC_CTYPE,'russian');
	POSIX::setlocale( &POSIX::LC_ALL, $thislocale );
my($i, $tour);	my($i, $tour);
my($text) = (param('text')) ? 1 : 0;	my($text) = (param('text')) ? 1 : 0;
	$tour = (param('tour')) ? param('tour') : 0;
my($dbh) = DBI->connect("DBI:mysql:chgk", "piataev", "")	my $texttour=$tour;
	my ($sth,$dbh);
	$dbh = DBI->connect("DBI:mysql:chgk", "piataev", "")
or do {	or do {
print h1("Временные проблемы") . "База данных временно не	print h1("Временные проблемы") . "База вопросов временно не
работает. Заходите попозже.";	работает. Заходите попозже.";
print &Include_virtual("../dimrub/db/reklama.html");	print &Include_virtual("$reklama") if $url!~/localhost/;
print end_html;	print end_html;
die "Can't connect to DB chgk\n";	die "Can't connect to DB chgk\n";
};	};
if (!param('comp') and !param('sqldump') and !$text) {
print header;
print start_html(-"title"=>'Database of the questions',
-author=>'dimrub@icomverse.com',
-bgcolor=>'#fff0e0',
-vlink=>'#800020');
print &Include_virtual("../dimrub/db/reklama.html");
}


if ($^O =~ /win/i) {
$thislocale = "Russian_Russia.20866";
} else {
$thislocale = "ru_RU.KOI8-R";
}
POSIX::setlocale( &POSIX::LC_ALL, $thislocale );

if ((uc 'а') ne 'А') {print "Koi8-r locale not installed!\n"};

	if (param('qid') && (param('qid')=~/^\d+$/) \|\| $tour && $tour=~/^\d+$/) {
	my $destination='http://db.chgk.info/search.html';
	# print header (-'Content-Type' => 'text/html',
	# -'Location:'=> 'http:\\db.chgk.info');
	Redirect($destination);
	exit
	}

	if ($tour && (!param('answers')\|\|!param('answers')<=1))
	{
	my $n=param('tour');
	$n=~s/.txt$//;
	my $gr=($n=~/^[A-Z]/) \|\| (-e "$realHTMLDIR$n.html");
	my $destination=tourhref($tour,param('answers')\|\|0,$gr);
	my $d=$destination;
	$d=~s/$HTMLDIR/$realHTMLDIR/;
	# print header.$destination;
	print header."$d\|".(-e "$realHTMLDIR$n.html");
	if (-e $d) {
	Redirect($destination);
	exit
	}
	$d=~s/\.\d+//;
	$destination=~s/\.\d+//;
	print br.br.$d;
	if (-e $d) {
	Redirect($destination);
	exit
	}

if ($text) {
print header('text/plain');
}	}

if (param('hideequal')) {	if ($tour !~ /^[0-9]*$/) {
my ($sth)= $dbh -> prepare("select first, second FROM equalto");
$sth -> execute;
while ( my ($first, $second)=$sth -> fetchrow)
{
$forbidden{$first}=1;
}
$sth->finish;
}
$tour = (param('tour')) ? param('tour') : 0;
my $sth;
if ($tour !~ /^[0-9]*$/) {
if ($tour=~/\./)	if ($tour=~/\./)
{	{
my ($fname,$n)= split /\./ , $tour;	my ($fname,$n)= split /\./ , $tour;
Line 1620 if ((uc 'а') ne 'А') {print "Koi8-r loca	Line 1891 if ((uc 'а') ne 'А') {print "Koi8-r loca
$sth = $dbh->prepare(	$sth = $dbh->prepare(
"SELECT t2.Id FROM Tournaments as t1,	"SELECT t2.Id FROM Tournaments as t1,
Tournaments as t2	Tournaments as t2
WHERE t1.FileName = '$fname.txt'	WHERE (t1.FileName = '$fname.txt' OR t1.FileName='$fname')
AND t1.Id=t2.ParentId AND t2.Number=$n");	AND t1.Id=t2.ParentId AND t2.Number=$n");
}	}
else	else
{	{
$sth = $dbh->prepare("SELECT Id FROM Tournaments	$sth = $dbh->prepare("SELECT Id FROM Tournaments
WHERE FileName = '$tour.txt'");	WHERE FileName = '$tour.txt' OR
	FileName = '$tour'");
}	}
$sth->execute;	$sth->execute;
$tour = ($sth->fetchrow)[0];	$tour = ($sth->fetchrow)[0];
$sth->finish;	$sth->finish;
	}


	if ($text && !param ('comp')) {
	print header('text/plain');
	} elsif (!param('comp')) {print header;}
	my $sstr=param('sstr');
	$opt_z\|\|=param("makehtml");
	if (param('qid')) {
	my $sth;
	my $qid=param('qid');
	# if ($qid !~ /^[0-9]+$/)
	{
	my ($fname,$t,$n)= split /\./ , $qid;
	$n=$t,$t='' unless $n;
	$t\|\|=1;
	if ($t)
	{
	$sth = $dbh->prepare(
	"SELECT t2.Id FROM Tournaments as t1,
	Tournaments as t2
	WHERE (t1.FileName = '$fname.txt' OR t1.FileName='$fname')
	AND t1.Id=t2.ParentId AND t2.Number=$t");
	}
	# else
	# {
	# $sth = $dbh->prepare("SELECT Id FROM Tournaments
	# WHERE FileName = '$fname.txt' OR FileName = '$fname'" );
	# }
	$sth->execute;
	$tour = ($sth->fetchrow)[0];
	$sth->finish;
	$sth = $dbh->prepare(
	"SELECT QuestionId FROM
	Questions
	WHERE ParentId=$tour AND
	Questions.Number=$n");
	$sth->execute;
	$qid = ($sth->fetchrow)[0];
	my $query="SELECT Question, Answer from Questions where QuestionId=$qid";
	$sth=$dbh->prepare($query);
	$sth->execute;
	$sstr= join ' ',$sth->fetchrow;
	$sth->finish;
	$searchin{'Question'}=1;
	$searchin{'Answer'}=1;
	$sstr=~tr/ёЁ/еЕ/;
	$sstr=~s/[^йцукенгшщзхъфывапролджэячсмитьбюЙЦУКЕНГШЩЗХЪФЫВАПРОЛДЖЭЯЧСМИТЬБЮa-zA-Z0-9]/ /gi;
	$proxysstr=$sstr;
	$proxysstr=makeproxysstr($dbh,\$proxysstr);
	}

	}


	if (!param('comp') and !param('sqldump') and !$text) {
	my $title="Результаты поиска на \"". ($proxysstr\|\|$sstr) .'"'
	if ($proxysstr\|\|$sstr);
	$title\|\|="База вопросов";

	$globaloutput.=start_html(-"title"=>$title,
	-author=>'dimrub@icomverse.com',
	-bgcolor=>'#fff0e0',
	-vlink=>'#800020');
	$globaloutput.="<style>
	td {font-size: x-small; font-family : sans-serif}
	th {font-size: x-small; font-family : sans-serif}
	</style>\n";

	$globaloutput.=&Include_virtual("$reklama")\|\|'';
	}

	if (!$opt_z && length ($qs)<=255 && $qs !~ /(sstr)\|(rand)\|(comp)\|(all=)/i) {
	my $sth=$dbh->prepare("SELECT page,times,t from hash where query=".$dbh->quote($qs));
	$sth->execute();
	my ($p,$times,$t)=$sth->fetchrow();
	$sth->finish;
	if ($p) {
	print ".$p";
	$dbh->disconnect;
	exit ;
}	}
	}




	if (param('hideequal')) {
	my ($sth)= $dbh -> prepare("select first, second FROM equalto");
	$sth -> execute;
	while ( my ($first, $second)=$sth -> fetchrow)
	{
	$forbidden{$first}=1;
	}
	$sth->finish;
	}


if (param('rand')) {	if (param('rand')) {
Line 1655 Content-type: text/$mime_type; charset="	Line 2022 Content-type: text/$mime_type; charset="
EOT	EOT
print F &PrintRandom($dbh, $type, $qnum, $text);	print F &PrintRandom($dbh, $type, $qnum, $text);
close F;	close F;
print "Пакет случайно выбранных вопросов послан по адресу $Email. Нажмите	$globaloutput.= "Пакет случайно выбранных вопросов послан по адресу $Email. Нажмите
на <B>Reload</B> для получения еще одного пакета";	на <B>Reload</B> для получения еще одного пакета";
} else {	} else {
print &PrintRandom($dbh, $type, $qnum, $text);	$globaloutput.= &PrintRandom($dbh, $type, $qnum, $text);
}	}
}	}
elsif (param('authors')){	elsif (param('authors')){
print &PrintAuthors($dbh,param('authors'));	$globaloutput.= &PrintAuthors($dbh,param('authors'));
}	}
elsif (param('qofauthor')){	elsif (param('qofauthor')){
&PrintQOfAuthor($dbh,param('qofauthor'));	$globaloutput.= &PrintQOfAuthor($dbh,param('qofauthor'));
}	}
elsif (param('sstr')\|\|param('was')) {	elsif (param('sstr')\|\|param('was')) {
&PrintSearch($dbh, param('sstr'), param('metod'),param('was'));	$globaloutput.=&PrintSearch($dbh, $sstr\|\|' ', param('metod')\|\|'',param('was'));
$dbh->do("delete from lastqueries where	$dbh->do("delete from lastqueries where
(TO_DAYS(NOW()) - TO_DAYS(t) >= 2) OR	(TO_DAYS(NOW()) - TO_DAYS(t) >= 2) OR
(time_to_sec(now())-time_to_sec(t) >3600)")	(time_to_sec(now())-time_to_sec(t) >3600)") if $usewas && random(30)==0;
}	}
elsif (param('qid')) {	elsif (param('qid')) {
my $qid=param('qid');	$globaloutput.=&PrintSearch($dbh, $sstr\|\|'', 'proxy');
my $query="SELECT Question, Answer from Questions where QuestionId=$qid";
print $query if $printqueries;
my $sth=$dbh->prepare($query);
$sth->execute;
my $sstr= join ' ',$sth->fetchrow;
$sth->finish;
$searchin{'Question'}=1;
$searchin{'Answer'}=1;
$sstr=~tr/ёЁ/еЕ/;
$sstr=~s/[^йцукенгшщзхъфывапролджэячсмитьбюЙЦУКЕНГШЩЗХЪФЫВАПРОЛДЖЭЯЧСМИТЬБЮa-zA-Z0-9]/ /gi;
# print &PrintQuestion($dbh,$qid, 1, '!');
&PrintSearch($dbh, $sstr, 'proxy');
}	}
elsif (param('getfile')){	elsif (param('getfile')){
print &writefile	$globaloutput.=&writefile
} elsif (param('all')) {	} elsif (param('all')) {
print &PrintAll($dbh, 0);	# my $destination='http://db.chgk.info/all.html';
	# Redirect($destination);
	# exit;
	$globaloutput.=&PrintAll($dbh, 0);
} elsif (param('from_year') && param('to_year')) {	} elsif (param('from_year') && param('to_year')) {
print &PrintDates($dbh);	$globaloutput.=&PrintDates($dbh);
} elsif (param('comp')) {	} elsif (param('comp')) {
print "Content-Type: application/octet-stream\n";	print "Content-Type: application/octet-stream\n";
print "Content-Type: application/force-download\n";	print "Content-Type: application/force-download\n";
print "Content-Type: application/download\n";	print "Content-Type: application/download\n";
print "Content-Type: application/x-zip-compressed; name=db.zip\n";	print "Content-Type: application/x-zip-compressed; name=$texttour.zip\n";
print "Content-Disposition: attachment; filename=db.zip \n\n";	print "Content-Disposition: attachment; filename=$texttour.zip \n\n";
# print header(
# -'Content-Type' => 'application/x-zip-compressed; name="db.zip"',
# -'Content-Type' => 'application/zip',
# -'Content-Disposition' => 'attachment; filename="db.zip"'
# );
$tour \|\|= 0;	$tour \|\|= 0;
my (@files) = &PrintArchive($dbh, $tour);	my (@files) = &PrintArchive($dbh, $tour);
WriteFile($dbh,$_) foreach @files;	WriteFile($dbh,$_) foreach @files;
# open F, "$ZIP -j - $SRCPATH/COPYRIGHT @files \|";
open F, "$ZIP -j - @files \|";	open F, "$ZIP -j - @files \|";
binmode(F);	binmode(F);
binmode(STDOUT);	binmode(STDOUT);
print (<F>);	print join "",<F>;
close F;	close F;
$dbh->disconnect;	$dbh->disconnect;
exit;	exit;
Line 1727 $sstr=~s/[^йцукенгшщзхъфывапролджэячсмит	Line 2079 $sstr=~s/[^йцукенгшщзхъфывапролджэячсмит
$dbh->disconnect;	$dbh->disconnect;
exit;	exit;

} else {	}
	elsif (!$opt_z && !param("makehtml")) {
my $QuestionNumber=0;	my $QuestionNumber=0;
my $qnum;	my $qnum;
if ($qnum=param('qnumber')){	if ($qnum=param('qnumber')){
Line 1737 $sstr=~s/[^йцукенгшщзхъфывапролджэячсмит	Line 2090 $sstr=~s/[^йцукенгшщзхъфывапролджэячсмит
$QuestionNumber=($sth->fetchrow)[0]\|\|0;	$QuestionNumber=($sth->fetchrow)[0]\|\|0;
}	}
if ($QuestionNumber) {	if ($QuestionNumber) {
print &PrintQuestion($dbh, $QuestionNumber, param('answer')\|\|0, $qnum, 1);	$globaloutput.= &PrintQuestion($dbh, $QuestionNumber, $withanswers\|\|0, $qnum, 1,0,0);
# $dbh, $Id, $answer, $qnum, $title, $text	# $dbh, $Id, $answer, $qnum, $title, $text
} else {	} else {
print &PrintTournament($dbh, $tour, param('answer'));	$globaloutput.=&PrintTournament($dbh, $tour, $withanswers);
}	}
}	}
	else {
	$opt_z=1;
	$url="http://db.chgk.info/cgi-bin/db.cgi";
	open TS, $timestamp;
	my $d=$dbh->quote(<TS>);
	close TS;
	open FF, ">${realHTMLDIR}index.html" or die "ERROR! - ${HTMLDIR}index.html\n";
	my $o=$globaloutput;
	$o.=&PrintTournament($dbh, 0, 0);
	$o.=&Bottom;
	print FF $o;
	close FF;
	open FF, ">${realHTMLDIR}all.html" or die "ERROR! - ${HTMLDIR}all.html\n";
	$o=$globaloutput;
	$o.=&PrintAll($dbh,0);
	$o.=&Bottom;
	print FF $o;
	close FF;


	# my ($sth) = $dbh->prepare("SELECT t1.Id, t1.FileName, t1.Type,
	# count(t2.Id)
	# FROM Tournaments as t1, Tournaments as t2
	# WHERE t1.CreatedAt>$d AND t2.ParentId=t1.Id GROUP BY t1.Id");
	my ($sth) = $dbh->prepare("SELECT t1.Id, t1.FileName, t1.Type, count(t2.Id) FROM Tournaments as t1 LEFT JOIN Tournaments as t2
	ON t2.ParentId=t1.id WHERE t1.CreatedAt>$d GROUP BY t1.Id");
	$sth->execute;
	my ($Id,$fname,$type,$c);
	while (($Id,$fname,$type,$c)=$sth->fetchrow,$Id) {
	next unless $fname;
	print "$fname\n";
	$fname=~s/\.txt$//;
	if ($type=~/Т/ \|\| $c<=1)
	{
	open FF, ">$realHTMLDIR$fname-q.html" or die "ERROR! - $fname-q.html\n";
	my $o=$globaloutput;
	$paramtour=$fname;
	$o.=&PrintTournament($dbh, $Id, 0);
	$o.=&Bottom;
	print FF $o;
	close FF;
	open FF, ">$realHTMLDIR$fname-a.html";
	$o=$globaloutput;
	$o.=&PrintTournament($dbh, $Id, 1);
	$o.=&Bottom;
	print FF $o;
	close FF;
	}
	else {
	open FF, ">$realHTMLDIR$fname.html" or die "ERROR! - $fname-q.html\n";
	my $o=$globaloutput;
	$o.=&PrintTournament($dbh, $Id, 0);
	$o.=&Bottom;
	print FF $o;
	close FF;

	}
	}
	}
if (!$text) {	if (!$text) {
print &Include_virtual("../dimrub/db/footer.html");	$globaloutput.=&Bottom;
print <<EEE
<SCRIPT LANGUAGE="JavaScript">
function toggle(e) {
if (e.style.display == "none") {
e.style.display="";
} else {
e.style.display = "none";
}
}
</SCRIPT>
EEE
;
print end_html;
}	}
	if (!$opt_z){
	print $globaloutput;
	if (($qs!~ /(rand)\|(sstr)\|(comp)/i) && (length $qs<=255)) {
	$globaloutput= $dbh->quote($globaloutput);
	$dbh->do("insert into hash (query,page) values (".
	$dbh->quote($qs).
	",$globaloutput)");
	}
	}

$dbh->disconnect;	$dbh->disconnect;
}	}

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>

Removed from v.1.76
changed lines
	Added in v.1.121