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.80 and 1.90

version 1.80, 2002/12/19 23:55:55	version 1.90, 2003/02/08 23:37:42
Line 8 use POSIX qw(locale_h);	Line 8 use POSIX qw(locale_h);
use locale;	use locale;
open STDERR, ">/var/tmp/errors1";	open STDERR, ">/var/tmp/errors1";
my $newsurl='http://news.chgk.info/';	my $newsurl='http://news.chgk.info/';
	my ($proxyptext,$proxysstr);
my $printqueries=0;	my $printqueries=0;
my %forbidden=();	my %forbidden=();
my $debug=0; #added by R7	my $debug=0; #added by R7
if (param('debug')) {$debug=1; $printqueries=1}	if (param('debug')) {$debug=1; $printqueries=1}
STDERR=STDOUT if $debug;	STDERR=STDOUT if $debug;
	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', 'Автор',
Line 30 my %metodchar=('rus',1,'old',2);	Line 41 my %metodchar=('rus',1,'old',2);



my $thislocale;

$searchin{$_}=1 foreach param('searchin');	$searchin{$_}=1 foreach param('searchin');
my %TypeName=('children'=>'Д', 'game'=>'Я', 'igp'=>'И',	my %TypeName=('children'=>'Д', 'game'=>'Я', 'igp'=>'И',
Line 145 sub GetTours {	Line 155 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 160 print "timee0=".time.br if $debug;	Line 168 print "timee0=".time.br if $debug;
sub printform	sub printform
{	{

my $submit=submit(-value=>'Поиск');	my $qnumber=(" "x10)."Выводить по ". textfield(-name=>'kvo',
my $inputstring=textfield(-name=>'sstr',
-default=>param('sstr')\|\|'',
-size=>30,
-maxlength=>50);
my $qnumber="Выводить по".br. textfield(-name=>'kvo',
-default=>param('kvo')\|\|'150',	-default=>param('kvo')\|\|'150',
-size=>3,	-size=>3,
-maxlength=>5). br."вопросов";	-maxlength=>5)." вопросов";
	my $sstr=param('sstr');
my @df=keys %searchin;	my @df=keys %searchin;
	my %checked;
@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','igp','game','ehruditka','beskrylka') unless @df;	@df=('chgk','brain','igp','game','ehruditka','beskrylka') unless @df;
	$checked{lc $_}="checked" foreach @df;
	my $all=param('all') && param('all') eq 'yes';

my $types=checkbox_group('type',['chgk','brain','igp','game','ehruditka','beskrylka'], [@df],	$checked{'all'}=$all?"checked":"";
'false',\%rusfieldname);	$checked{'any'}=$all?"":"checked";
my $metod=radio_group(-name=>'metod',-values=>['old','rus'],	$checked{lc param('metod')}="checked";
-default=>(param('metod')\|\|'rus'),	$checked{'russian'}=1 unless $checked{'russian'} \|\| $checked{'old'};
-labels=>\%rusfieldname);
my $all=radio_group(-name=>'all',-values=>['yes','no'],
-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;
$text=~tr/ёЁ/еЕ/;	$text=~tr/ёЁ/еЕ/;
$text=~s/(${RLrl})p(${RLrl})/$1p$2/gom;	$text=~s/(${RLrl})p(${RLrl})/$1p$2/gom;
Line 239 sub proxy	Line 287 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 469 sub Search {	Line 508 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 487 sub Search {	Line 515 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 688 sub PrintList {	Line 713 sub PrintList {
sub PrintSearch {	sub PrintSearch {
my ($dbh, $sstr, $metod,$was) = @_;	my ($dbh, $sstr, $metod,$was) = @_;
my $t=time;	my $t=time;
print h2("Поиск в базе вопросов");	# print h2("Поиск в базе вопросов");
print printform;	print printform;
my @allnf;	my @allnf;
my @Questions;	my @Questions;
Line 1078 sub PrintQuestion {	Line 1103 sub PrintQuestion {
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'};	my $fname=$Tournament{'FileName'};
#return "" if $fname=~/mgp0203/;
$fname=~s/\.txt//;	$fname=~s/\.txt//;
$titles .=	$titles .=
dd(img({src=>"/icons/folder.open.gif"}) . " " .	dd(img({src=>"/icons/folder.open.gif"}) . " " .
Line 1103 sub PrintQuestion {	Line 1127 sub PrintQuestion {
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) {	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;
	$Surname=~s/ё/[её]/g;
	my $sha="(?:$Name\\s+$Surname)\|(?:$Surname\\s+$Name)\|(?:$firstletter\\.\\s*$Surname)\|(?:$Surname\\s+$firstletter\\.)\|(?:$Surname)";
if ($Nicks)	if ($Nicks)
{	{
$Nicks=~s/^\\|//;	$Nicks=~s/^\\|//;
Line 1127 sub PrintQuestion {	Line 1153 sub PrintQuestion {
}	}
}	}
$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 1170 EOTT	Line 1200 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>0 && !$text;	my $qid=param('tour') ? (param('tour').".$Question{'Number'}" ): '';

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

Line 1338 sub PrintQOfAuthor	Line 1373 sub PrintQOfAuthor
{	{

my ($dbh, $id) = @_;	my ($dbh, $id) = @_;
$id=$dbh->quote($id);	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 1360 sub PrintQOfAuthor	Line 1403 sub PrintQOfAuthor
} else {	} else {
$suffix = 'я';	$suffix = 'я';
}	}
print h2("Поиск в базе вопросов");	# print h2("Поиск в базе вопросов");
print printform;	print printform;
print p({align=>"center"}, "Автор ".strong("$name $surname. ")	print p({align=>"center"}, "Автор ".strong("$name $surname. ")
. " : $hits попадани$suffix.");	. " : $hits попадани$suffix.");
Line 1582 sub WriteFile {	Line 1625 sub WriteFile {

MAIN:	MAIN:
{	{

setlocale(LC_CTYPE,'russian');	setlocale(LC_CTYPE,'russian');
my($i, $tour);	my($i, $tour);
my($text) = (param('text')) ? 1 : 0;	my($text) = (param('text')) ? 1 : 0;
	if ($text) {
	print header('text/plain');
	} else {print header;}

my($dbh) = DBI->connect("DBI:mysql:chgk", "piataev", "")	my($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("../dimrub/db/reklama.html");
print end_html;	print end_html;
die "Can't connect to DB chgk\n";	die "Can't connect to DB chgk\n";
};	};
	my $sstr=param('sstr');
	if (param('qid')) {
	my $sth;
	my $qid=param('qid');
	if ($qid !~ /^[0-9]*$/) {
	my ($fname,$t,$n)= split /\./ , $qid;
	$n=$t,$t='' unless $n;
	if ($n)
	{
	$sth = $dbh->prepare(
	"SELECT t2.Id FROM Tournaments as t1,
	Tournaments as t2
	WHERE t1.FileName = '$fname.txt'
	AND t1.Id=t2.ParentId AND t2.Number=$t");
	}
	else
	{
	$sth = $dbh->prepare("SELECT Id FROM Tournaments
	WHERE FileName = '$fname.txt'");
	}
	$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) {	if (!param('comp') and !param('sqldump') and !$text) {
print header;	my $title="Результаты поиска на \"". ($proxysstr\|\|$sstr) .'"'
print start_html(-"title"=>'Database of the questions',	if ($proxysstr\|\|$sstr);
	$title\|\|="База вопросов";

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

print &Include_virtual("../dimrub/db/reklama.html");	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 ($text) {
print header('text/plain');
}

if (param('hideequal')) {	if (param('hideequal')) {
my ($sth)= $dbh -> prepare("select first, second FROM equalto");	my ($sth)= $dbh -> prepare("select first, second FROM equalto");
$sth -> execute;	$sth -> execute;
Line 1691 EOT	Line 1779 EOT
(time_to_sec(now())-time_to_sec(t) >3600)")	(time_to_sec(now())-time_to_sec(t) >3600)")
}	}
elsif (param('qid')) {	elsif (param('qid')) {
my $qid=param('qid');
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');	&PrintSearch($dbh, $sstr, 'proxy');
}	}
elsif (param('getfile')){	elsif (param('getfile')){
Line 1774 function toggle(e) {	Line 1850 function toggle(e) {
</SCRIPT>	</SCRIPT>
EEE	EEE
;	;
print end_html;	# print end_html;
}	}
$dbh->disconnect;	$dbh->disconnect;
}	}

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

Removed from v.1.80
changed lines
	Added in v.1.90