--- db/prgsrc/db.cgi 2004/03/16 12:03:38 1.131 +++ db/prgsrc/db.cgi 2008/02/09 10:40:59 1.146 @@ -3,15 +3,18 @@ use DBI; use CGI ':all'; #use strict; +my @softfields=("От Олега Степанова"); use Time::Local; -my $proxyredirect=0; +my $proxyredirect=1; use POSIX qw(locale_h); use locale; use vars qw($opt_z); use Getopt::Std; #my ($dbuser,$dbname,$dbpass,$dbhost); -require "dbdefs.pl"; +eval {require "dbdefs.pl";} ; my $url=url||''; +my @used_stop=(); +my $showNearQuestions=0; $dbuser||="piataev"; $dbname||="chgk"; $dbpass||=""; @@ -26,7 +29,8 @@ open STDERR, ">/var/tmp/errors1"; my $newsurl='http://news.chgk.info/'; my $reklama="../dimrub/db/reklama.html"; my $footer="../dimrub/db/footer.html"; - +$footer="../../chgk/footer.html" if $url=~/zaba/; +$reklama="../../chgk/reklama.html" if $url=~/zaba/; my $datefooter="../dimrub/db/date"; $datefooter="../../chgk/date" if $url=~/zaba/; @@ -41,13 +45,13 @@ if ($^O =~ /win/i) { $realHTMLDIR="/html/znatoki/baza/"; } else { - $realHTMLDIR="/home/piataev/public_html/dimrub/db/files/"; + $realHTMLDIR="/home/znatoki/chgk-db/public_html/dimrub/db/files/"; } my $usehtml=$opt_z||0; $usehtml=1; -$usehtml=0 if $url=~/zaba/; +$usehtml=0 if $url=~/zaba/ || $url=~/localhost/; my $usewas=0; my $cashednumber=500; @@ -64,7 +68,7 @@ $outputkvo=100 if $outputkvo>100; if (param('debug')) {$debug=1; $printqueries=1} *STDERR=*STDOUT if $debug; -if ($url !~ /db\.chgk\.info/ && $url !~ /localhost/ && $url !~ /bilbo/ && $url !~ /zaba/) { +if ($url !~ /db\.chgk\.info/ && $url !~ /localhost/ && $url !~ /bilbo/ && $url !~ /zaba/ && $url !~ /question\.chgk\.info/ ) { my $u="http://db.chgk.info/cgi-bin/db.cgi?$qs"; Redirect ($u); exit; @@ -91,8 +95,8 @@ POSIX::setlocale( &POSIX::LC_ALL, $thisl if ((uc 'а') ne 'А') {print STDERR "Koi8-r locale not installed!\n"}; -my %fieldname= (0,'Question', 1, 'Answer', 2, 'Comments', 3, 'Authors', 4, 'Sources'); -my %rusfieldname=('Question','Вопрос', 'Answer', 'Ответ', +my %fieldname= (0,'Question', 1, 'Answer', 2, 'PassCriteria', 3, 'Comments', 4, 'Authors', 5, 'Sources'); +my %rusfieldname=('Question','Вопрос', 'Answer', 'Ответ', 'PassCriteria','Зачёт', 'Comments', 'Комментарии', 'Authors', 'Автор', 'Sources', 'Источник','old','Старый','rus','Новый', 'chgk', 'ЧГК', 'brain', 'Брейн-ринг','game', 'Своя игра', @@ -127,8 +131,8 @@ my $all=param('all'); $all=0 if lc $all eq 'no'; my ($PWD) = `pwd` if $^O!~/win/i; chomp $PWD if $PWD; -my ($SRCPATH) = "/home/piataev/public_html/dimrub/src"; -my ($ZIP) = "/usr/local/bin/zip"; +my ($SRCPATH) = "/home/db-chgk/public_html/dimrub/src"; +my ($ZIP) = "/usr/bin/zip"; my $DUMPFILE = "/tmp/chgkdump"; my ($SENDMAIL) = "/usr/sbin/sendmail"; my ($TMPDIR) = "/var/tmp"; @@ -205,12 +209,12 @@ sub GetTournament { sub fetchquestion { my ($sth,$q,$WithTour)=@_; if ($WithTour) { - ($$q{'QuestionId'}, $$q{'Question'},$$q{'Answer'},$$q{'Comments'},$$q{'Authors'},$$q{'Sources'}, + ($$q{'QuestionId'}, $$q{'Question'},$$q{'Answer'},$$q{'PassCriteria'},$$q{'Comments'},$$q{'Authors'},$$q{'Sources'}, $$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{'Sources'}, + ($$q{'QuestionId'}, $$q{'Question'},$$q{'Answer'},$$q{'PassCriteria'},$$q{'Comments'},$$q{'Authors'},$$q{'Sources'}, $$q{'Number'})= $sth->fetchrow; } @@ -232,13 +236,13 @@ sub SelectQuestions { my $query; if ($WithTour) { - $query="SELECT QuestionId, Questions.Question, Answer, Comments, Authors, Sources, + $query="SELECT QuestionId, Questions.Question, Answer, PassCriteria, Comments, Authors, Sources, 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, Sources, + $query="SELECT QuestionId, Questions.Question, Answer, PassCriteria, Comments, Authors, Sources, Questions.Number from Questions WHERE $where"; } @@ -276,21 +280,24 @@ sub tourhref { my $res; if ($usehtml) { $res=$t; + $res=~s/\-q$//; + $res=~s/\-a$//; $res.=$a?"-a":"-q" unless $gr; $res.=".html"; $res=~s/(\#\d+)(.*)$/$2$1/; my $t=$res; $t=~s/\#.*$//; - $res=~s/\.1// unless -e "$realHTMLDIR$t"; +# $res=~s/\.1// unless $gr ||$res=~/\.\d+$/;#-e "$realHTMLDIR$t"; $t=$res; $t=~s/\#.*$//; - $res=~s/\.html/-q\.html/ unless -e "$realHTMLDIR$t"; +# $res=~s/\.html/-q\.html/ unless -e "$realHTMLDIR$t"; $res="$HTMLDIR$res" unless $opt_z; return $res; } else { $res=$url; - $res.="?tour=$t"; - $res.=$a?"&answers=1":""; + $res.=$a?"?answers=1&":"?"; + $res.="tour=$t"; + return $res; } @@ -355,11 +362,11 @@ sub printform my $sstr=param('sstr'); my @df=keys %searchin; my %checked; - $checked{lc $_}="" foreach ('Question','Answer','Comments','Authors','Sources','old','rus', + $checked{lc $_}="" foreach ('Question','Answer','PassCriteria','Comments','Authors','Sources','old','rus', 'chgk','brain','igp','game','ehruditka','beskrylka'); @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','PassCriteria','Comments','Authors','Sources'], [@df], 'false',\%rusfieldname); @df=param('type'); @df=('chgk','brain','igp','game','ehruditka','beskrylka') unless @df; @@ -385,7 +392,7 @@ action="/znatoki/cgi-bin/db.cgi">
Вариант поиска: - | + | Простой (старый) | "Что? Где? Когда?" @@ -403,11 +410,11 @@ action="/znatoki/cgi-bin/db.cgi"> "Бескрылка" | |||||||||
---|---|---|---|---|---|---|---|---|---|---|---|---|
Расширенный (с учетом грамматики, в вопросах всех типов) + | Расширенный (с учетом грамматики, в вопросах всех типов) | |||||||||||
Искать: - | + | Все слова | Любое слово @@ -419,6 +426,8 @@ action="/znatoki/cgi-bin/db.cgi"> |
Ответ |
+Зачёт + |
Комментарии |
Автор @@ -427,9 +436,9 @@ action="/znatoki/cgi-bin/db.cgi"> |
Если при попытке поиска выдаётся сообщение об ошибке,
+
EOT
@@ -468,7 +477,7 @@ sub makeproxysstr {
# $good{$words[$_]}=1 foreach 0..4;
foreach (@words)
{
- $good{$_}=1 if $c{$_}<200;
+ $good{$_}=1 if $c{$_}<200 && length $_>2;
}
$good{$words[$_]}=0 foreach 16..$#words;
@@ -495,19 +504,31 @@ sub russearch {
my %relevance;
my @blob;
my %count;
+ my %stop_word;
POSIX::setlocale( &POSIX::LC_ALL, $thislocale );
$sstr=~tr/йцукенгшщзхъфывапролджэячсмитьбю/ЙЦУКЕНГШЩЗХЪФЫВАПРОЛДЖЭЯЧСМИТЬБЮ/;
# @qw=@w =split (' ', uc $sstr);
my $ts=uc $sstr;
@qw=@w= $ts=~m/(?:(?:${RLrl})+)|(?:[A-Za-z0-9]+)/gom;
-
+ $query="select nf.word from nf where number>=50000";
+ $sth=$dbh->prepare($query);
+ $sth->execute();
+ %stop_word=();
+ while (@arr = $sth->fetchrow)
+ {
+ $stop_word{$arr[0]}=1;
+ }
+ $sth->finish;
+
#-----------
foreach $i (0..$#w) # заполняем массив @nf начальных форм
# $nf[$i] -- ссылка на массив возможных
# начальных форм словоформы $i
{
+ (push @used_stop, uc $w[$i]),next if $stop_word{uc $w[$i]};
$qw= $dbh->quote (uc $w[$i]);
+
$query=" select distinct w2 from nests
where w1=$qw";
$sth=$dbh -> prepare($query);
@@ -552,7 +573,7 @@ $sstr=~tr/йцукенгшщзхъфывапролджэячсмить
$_= " word2question.word=$_" foreach @arr;
$_= " nf.id=".$_. ' ' foreach @arr1;
# @arr=(0) unless @arr;
- $query="select questions from word2question where (". (join ' OR ', @arr).") AND length(questions)<80000";
+ $query="select questions from word2question where (". (join ' OR ', @arr).") ";
$sth=$dbh -> prepare($query);
$sth->execute;
@@ -614,7 +635,12 @@ $sstr=~tr/йцукенгшщзхъфывапролджэячсмить
#Ищем пересечение или объединение списков вопросов (значений %tasksof)
foreach $sf (keys %tasksof)
{
- $count{$_}++ foreach keys %{$tasksof{$sf}};
+ foreach (keys %{$tasksof{$sf}})
+ {
+ next if $forbidden{$_};
+ $count{$_}++
+ }
+
}
@tasks= ($all ? (grep {$count{$_}==$kvo} keys %count) :
keys %count) ;
@@ -702,13 +728,13 @@ sub Search {
###Simple and advanced query processing. Added by R7
if ($metod eq 'simple' || $metod eq 'advanced')
{
- foreach (qw/Question Answer Sources Authors Comments/) {
+ foreach (qw/Question Answer PassCriteria Sources Authors Comments/) {
if (param($_)) {
push @fields, $_;
}
}
- @fields=(qw/Question Answer Sources Authors Comments/) unless scalar @fields;
+ @fields=(qw/Question Answer PassCriteria Sources Authors Comments/) unless scalar @fields;
my $fields=join ",", @fields;
my $q=new Text::Query($sstr,
-parse => 'Text::Query::'.
@@ -726,7 +752,6 @@ sub Search {
######
{
-# foreach (qw/Question Answer Sources Authors Comments/) {
foreach (param('searchin')) {
# if (param($_)) {
push @fields, "IFNULL($_, '')";
@@ -882,7 +907,7 @@ sub PrintList {
for (my $i = $first; $i <= $last; $i++) {
my $q=$q{$$Questions[$i-1]};
my $output;
- $output = &PrintQuestion($dbh, $q, 1, 0, 1,0,1 );
+ $output = &PrintQuestion($dbh, $q, 1, 0, 1,$text,1 );
# if (param('metod') && (param('metod') eq 'rus' || param('metod') eq 'proxy'))
{
$output=~s/\b($shablon)\b/\$1\<\/strong\>/gi;
@@ -936,6 +961,8 @@ sub PrintSearch {
$Output.= p. "Время поиска: " . (time-$t) ." сек.".p;
+ $_="\"$_\"" foreach @used_stop;
+ $Output.= p. (join ', ',@used_stop) ." ignored".p if @used_stop;
my ($output, $i, $suffix, $hits) = ('', 0, '', $#Questions + 1);
my $shablon;
@@ -1167,7 +1194,6 @@ sub PrintTournament {
p("Дополнительная информация об этом турнире - по адресу " .
a({-'href'=>$URL}, $URL));
}
-
if ($Copyright) {
$output .= p("Копирайт: " . $Copyright);
}
@@ -1177,6 +1203,10 @@ sub PrintTournament {
if ($Info) {
$output .= p($Info);
}
+
+ $output.=p("XML");
+
+
return $output;
}
@@ -1254,7 +1284,7 @@ sub PrintTour {
my $sth=SelectQuestions($dbh,\@Questions,0);
for ($q = 0; $q <= $#Questions; $q++) {
fetchquestion($sth,\%q,0);
- $output .= &PrintQuestion($dbh, \%q, $answer, 0,0,0,1);
+ $output .= &PrintQuestion($dbh, \%q, $answer, 0,0,$text,1);
}
$sth->finish;
$output .= hr({-'align'=>'center', -'width'=>'80%'});
@@ -1272,6 +1302,7 @@ sub PrintTour {
if ($Tournament{'Info'}) {
$output .= p($Tournament{'Info'});
}
+ $output.=p("XML");
my $n=$Tour{'Number'};
if ($answer == 0) {
@@ -1310,6 +1341,11 @@ sub PrintField {
if ($text) {
$value =~ s/<[\/\w]*?>//sg;
} else {
+ if ($header=~/Комментар/)
+ {
+ $value=~s/^\s*$_[\.:]/p."\n".strong("$_").":"/me foreach @softfields;
+ }
+
$value =~ s/^\s+/ /g unless $text;
+ $output=~s/⌡/\ï/g;
+ $output=~s/⌠/\Ï/g;
+
$paramtour||=param("tour");
- my $qid=$paramtour ? ($paramtour.".$Question{'Number'}" ): '';
+ $fname=$fname.".$Question{'TourNumber'}" if $fname && $Question{'TourNumber'};
+$fname||=param('tour');
+ my $qid=$fname ? ($fname.".$Question{'Number'}" ): '';
- $output.=br.a({href=> $url."?metod=proxy&
+ $output.=br.a({href=> "/search/"."?metod=proxy&
qid=$qid"}, 'Близкие вопросы').p
- if $answer>0 && !$text && $qid;
+ if $answer>0 && !$text && $qid && $showNearQuestions;
return $output;
}
@@ -1686,7 +1739,7 @@ sub PrintQOfAuthor
$suffix = 'я';
}
$Output.= printform;
- $Output.= p({align=>"center"}, "Автор ".strong("$name $surname. ")
+ $Output.= p({align=>"center"}, "Автор ".strong("$name $surname ")
. " : $hits попадани$suffix.");
@@ -1885,6 +1938,7 @@ sub WriteFile {
{
print OUT "Вопрос $q:\n".$Question{$tour}[$q]{'Question'}."\n\n";
print OUT "Ответ:\n".$Question{$tour}[$q]{'Answer'}."\n\n";
+ print OUT "Зачёт:\n".$Question{$tour}[$q]{'PassCriteria'}."\n\n";
print OUT "Автор:\n".$Question{$tour}[$q]{'Authors'}."\n\n"
if !$tourauthor && !$eqauthor && $Question{$tour}[$q]{'Authors'};
print OUT "Комментарий:\n".$Question{$tour}[$q]{'Comments'}."\n\n"
@@ -1935,7 +1989,7 @@ MAIN:
my $texttour=$tour;
my ($sth,$dbh);
my($dsn) = "DBI:mysql:database=$dbname;host=$dbhost";
- $dbh = DBI->connect($dsn, $dbuser, $dbpass)
+ $dbh = DBI->connect($dsn, $dbuser, $dbpass)
# $dbh = DBI->connect("DBI:mysql:$dbname", $username, $dbpass)
or do {
print header.h1("Временные проблемы") . "База вопросов временно не
@@ -1947,14 +2001,14 @@ MAIN:
if (param('qid') && (param('qid')=~/^\d+$/) || $tour && $tour=~/^\d+$/) {
- my $destination='http://chgk.zaba.ru/search.html';
+# my $destination='http://chgk.zaba.ru/search.html';
# print header (-'Content-Type' => 'text/html',
# -'Location:'=> 'http:\\db.chgk.info');
Redirect($destination);
exit
}
- if ($tour && !param('qnumber') && (!param('answers')||(param('answers')<=1)))
+ if (0 && $tour && !param('qnumber') && (!param('answers')||(param('answers')<=1)))
{
my $n=param('tour');
$n=~s/.txt$//;
@@ -2057,17 +2111,10 @@ MAIN:
my $title="Результаты поиска на \"". ($proxysstr||$sstr) .'"'
if ($proxysstr||$sstr);
$title||="База вопросов";
- if ($url=~/zaba/) {
- $globaloutput.=
-"
/mg;
$value =~ s/(\s+)-+(\s+)/$1$2/mg;
$value =~ s/\s+\/ \/mg
@@ -1322,7 +1358,10 @@ sub PrintField {
# $value =~ s/"//mg;
}
-
+ if ($value=~/^\s*(