version 1.137, 2004/11/08 02:23:18
|
version 1.143, 2006/09/24 19:53:59
|
Line 13 use Getopt::Std;
|
Line 13 use Getopt::Std;
|
#my ($dbuser,$dbname,$dbpass,$dbhost); |
#my ($dbuser,$dbname,$dbpass,$dbhost); |
eval {require "dbdefs.pl";} ; |
eval {require "dbdefs.pl";} ; |
my $url=url||''; |
my $url=url||''; |
|
my @used_stop=(); |
$dbuser||="piataev"; |
$dbuser||="piataev"; |
$dbname||="chgk"; |
$dbname||="chgk"; |
$dbpass||=""; |
$dbpass||=""; |
Line 43 if ($^O =~ /win/i) {
|
Line 44 if ($^O =~ /win/i) {
|
$realHTMLDIR="/html/znatoki/baza/"; |
$realHTMLDIR="/html/znatoki/baza/"; |
} else |
} else |
{ |
{ |
$realHTMLDIR="/home/piataev/public_html/dimrub/db/files/"; |
$realHTMLDIR="/home/znatoki/chgk-db/public_html/dimrub/db/files/"; |
} |
} |
|
|
|
|
Line 66 $outputkvo=100 if $outputkvo>100;
|
Line 67 $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/ && $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"; |
my $u="http://db.chgk.info/cgi-bin/db.cgi?$qs"; |
Redirect ($u); |
Redirect ($u); |
exit; |
exit; |
Line 129 my $all=param('all');
|
Line 130 my $all=param('all');
|
$all=0 if lc $all eq 'no'; |
$all=0 if lc $all eq 'no'; |
my ($PWD) = `pwd` if $^O!~/win/i; |
my ($PWD) = `pwd` if $^O!~/win/i; |
chomp $PWD if $PWD; |
chomp $PWD if $PWD; |
my ($SRCPATH) = "/home/piataev/public_html/dimrub/src"; |
my ($SRCPATH) = "/home/db-chgk/public_html/dimrub/src"; |
my ($ZIP) = "/usr/local/bin/zip"; |
my ($ZIP) = "/usr/bin/zip"; |
my $DUMPFILE = "/tmp/chgkdump"; |
my $DUMPFILE = "/tmp/chgkdump"; |
my ($SENDMAIL) = "/usr/sbin/sendmail"; |
my ($SENDMAIL) = "/usr/sbin/sendmail"; |
my ($TMPDIR) = "/var/tmp"; |
my ($TMPDIR) = "/var/tmp"; |
Line 432 action="/znatoki/cgi-bin/db.cgi">
|
Line 433 action="/znatoki/cgi-bin/db.cgi">
|
</td> |
</td> |
</tr> |
</tr> |
</table> |
</table> |
<p><i>Если при попытке поиска выдаётся сообщение об ошибке, |
<!--p><i>Если при попытке поиска выдаётся сообщение об ошибке, |
попробуйте воспользоваться |
попробуйте воспользоваться |
<a href="http://chgk.zaba.ru/search.html">зеркалом базы</a></i> |
<a href="http://chgk.zaba.ru/search.html">зеркалом базы</a></i--> |
</center> |
</center> |
|
|
EOT |
EOT |
Line 500 sub russearch {
|
Line 501 sub russearch {
|
my %relevance; |
my %relevance; |
my @blob; |
my @blob; |
my %count; |
my %count; |
|
my %stop_word; |
POSIX::setlocale( &POSIX::LC_ALL, $thislocale ); |
POSIX::setlocale( &POSIX::LC_ALL, $thislocale ); |
$sstr=~tr/йцукенгшщзхъфывапролджэячсмитьбю/ЙЦУКЕНГШЩЗХЪФЫВАПРОЛДЖЭЯЧСМИТЬБЮ/; |
$sstr=~tr/йцукенгшщзхъфывапролджэячсмитьбю/ЙЦУКЕНГШЩЗХЪФЫВАПРОЛДЖЭЯЧСМИТЬБЮ/; |
# @qw=@w =split (' ', uc $sstr); |
# @qw=@w =split (' ', uc $sstr); |
my $ts=uc $sstr; |
my $ts=uc $sstr; |
@qw=@w= $ts=~m/(?:(?:${RLrl})+)|(?:[A-Za-z0-9]+)/gom; |
@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 начальных форм |
foreach $i (0..$#w) # заполняем массив @nf начальных форм |
# $nf[$i] -- ссылка на массив возможных |
# $nf[$i] -- ссылка на массив возможных |
# начальных форм словоформы $i |
# начальных форм словоформы $i |
{ |
{ |
|
(push @used_stop, uc $w[$i]),next if $stop_word{uc $w[$i]}; |
$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"; |
$sth=$dbh -> prepare($query); |
$sth=$dbh -> prepare($query); |
Line 557 $sstr=~tr/йцукенгшщзхъфывапролджэячсмить
|
Line 570 $sstr=~tr/йцукенгшщзхъфывапролджэячсмить
|
$_= " 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).") AND length(questions)<80000"; |
$query="select questions from word2question where (". (join ' OR ', @arr).") "; |
|
|
$sth=$dbh -> prepare($query); |
$sth=$dbh -> prepare($query); |
$sth->execute; |
$sth->execute; |
Line 891 sub PrintList {
|
Line 904 sub PrintList {
|
for (my $i = $first; $i <= $last; $i++) { |
for (my $i = $first; $i <= $last; $i++) { |
my $q=$q{$$Questions[$i-1]}; |
my $q=$q{$$Questions[$i-1]}; |
my $output; |
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')) |
# 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; |
Line 945 sub PrintSearch {
|
Line 958 sub PrintSearch {
|
|
|
|
|
$Output.= p. "Время поиска: " . (time-$t) ." сек.".p; |
$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 ($output, $i, $suffix, $hits) = ('', 0, '', $#Questions + 1); |
|
|
my $shablon; |
my $shablon; |
Line 1263 sub PrintTour {
|
Line 1278 sub PrintTour {
|
my $sth=SelectQuestions($dbh,\@Questions,0); |
my $sth=SelectQuestions($dbh,\@Questions,0); |
for ($q = 0; $q <= $#Questions; $q++) { |
for ($q = 0; $q <= $#Questions; $q++) { |
fetchquestion($sth,\%q,0); |
fetchquestion($sth,\%q,0); |
$output .= &PrintQuestion($dbh, \%q, $answer, 0,0,0,1); |
$output .= &PrintQuestion($dbh, \%q, $answer, 0,0,$text,1); |
} |
} |
$sth->finish; |
$sth->finish; |
$output .= hr({-'align'=>'center', -'width'=>'80%'}); |
$output .= hr({-'align'=>'center', -'width'=>'80%'}); |
Line 1484 $output.="</span>"
|
Line 1499 $output.="</span>"
|
|
|
} |
} |
$output=~s/\(pic: ([^\)]*)\)/<p><img src="\/znatoki\/images\/db\/$1"><p>/g unless $text; |
$output=~s/\(pic: ([^\)]*)\)/<p><img src="\/znatoki\/images\/db\/$1"><p>/g unless $text; |
|
$output=~s/⌡/\ï/g; |
|
$output=~s/⌠/\Ï/g; |
|
|
$paramtour||=param("tour"); |
$paramtour||=param("tour"); |
$fname=$fname.".$Question{'TourNumber'}" if $fname && $Question{'TourNumber'}; |
$fname=$fname.".$Question{'TourNumber'}" if $fname && $Question{'TourNumber'}; |
$fname||=param('tour'); |
$fname||=param('tour'); |
Line 1964 MAIN:
|
Line 1982 MAIN:
|
my $texttour=$tour; |
my $texttour=$tour; |
my ($sth,$dbh); |
my ($sth,$dbh); |
my($dsn) = "DBI:mysql:database=$dbname;host=$dbhost"; |
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) |
# $dbh = DBI->connect("DBI:mysql:$dbname", $username, $dbpass) |
or do { |
or do { |
print header.h1("Временные проблемы") . "База вопросов временно не |
print header.h1("Временные проблемы") . "База вопросов временно не |
Line 1976 MAIN:
|
Line 1994 MAIN:
|
|
|
|
|
if (param('qid') && (param('qid')=~/^\d+$/) || $tour && $tour=~/^\d+$/) { |
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', |
# print header (-'Content-Type' => 'text/html', |
# -'Location:'=> 'http:\\db.chgk.info'); |
# -'Location:'=> 'http:\\db.chgk.info'); |
Redirect($destination); |
Redirect($destination); |
Line 2214 EOT
|
Line 2232 EOT
|
$QuestionNumber=($sth->fetchrow)[0]||0; |
$QuestionNumber=($sth->fetchrow)[0]||0; |
} |
} |
if ($QuestionNumber) { |
if ($QuestionNumber) { |
$globaloutput.= &PrintQuestion($dbh, $QuestionNumber, $withanswers||0, $qnum, 1,0,0); |
$globaloutput.= &PrintQuestion($dbh, $QuestionNumber, $withanswers||0, $qnum, 1,$text,0); |
# $dbh, $Id, $answer, $qnum, $title, $text |
# $dbh, $Id, $answer, $qnum, $title, $text |
} else { |
} else { |
$globaloutput.=&PrintTournament($dbh, $tour, $withanswers); |
$globaloutput.=&PrintTournament($dbh, $tour, $withanswers); |