version 1.33, 2001/11/19 13:02:15
|
version 1.36, 2001/11/25 23:40:27
|
Line 9 use POSIX qw(locale_h);
|
Line 9 use POSIX qw(locale_h);
|
use locale; |
use locale; |
open STDERR, ">errors"; |
open STDERR, ">errors"; |
my $printqueries=1; |
my $printqueries=1; |
|
my %forbidden=(); |
my $debug=1; #added by R7 |
my $debug=1; #added by R7 |
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 %searchin; |
my %searchin; |
Line 179 print "$query",br if $printqueries;
|
Line 180 print "$query",br if $printqueries;
|
|
|
my $kvo=0; |
my $kvo=0; |
push @$allnf, @{$_} foreach @nf; |
push @$allnf, @{$_} foreach @nf; |
print "nf=@$allnf"; |
print "nf=@$allnf" if $printqueries; |
|
|
foreach $i (0..$#w) #запросы в базу... |
foreach $i (0..$#w) #запросы в базу... |
{ |
{ |
Line 192 print "nf=@$allnf";
|
Line 193 print "nf=@$allnf";
|
$_= " word2question.word=".$_. ' ' foreach @arr; |
$_= " word2question.word=".$_. ' ' foreach @arr; |
$_= " nf.id=".$_. ' ' foreach @arr1; |
$_= " nf.id=".$_. ' ' foreach @arr1; |
|
|
# $_= " nests.w2=".$_. ' ' foreach @arr2; |
|
# $query="select w1 from nests where". (join ' OR ', @arr2); |
|
#print $query if $printqueries; |
|
# $sth=$dbh -> prepare($query); |
|
# $sth->execute; |
|
# while (@ar=$sth->fetchrow) |
|
# { |
|
# $ar[0]=~s/(.)/&nocase($1)/ge; |
|
# push(@sf,'(?:'.$ar[0].')'); |
|
# } |
|
# $selectshablon=join '|',@sf; |
|
|
|
#print $selectshablon,br if $printqueries; |
|
|
|
# $selectshablon=qr/$selectshablon/i; |
|
|
|
|
|
|
|
|
|
$query="select questions from word2question where". (join ' OR ', @arr); |
$query="select questions from word2question where". (join ' OR ', @arr); |
print "$query\n",br if $printqueries; |
print "$query\n",br if $printqueries; |
|
|
Line 293 foreach (keys %wordsof)
|
Line 275 foreach (keys %wordsof)
|
|
|
############ |
############ |
|
|
print "tasks=@tasks"; |
print "tasks=@tasks" if $printqueries; |
|
|
#print "$_ $relevance{$_} | " foreach @tasks; |
#print "$_ $relevance{$_} | " foreach @tasks; |
#print br; |
#print br; |
Line 405 sub Search {
|
Line 387 sub Search {
|
} else { |
} else { |
$sstr = join " OR $f LIKE ", @sar; |
$sstr = join " OR $f LIKE ", @sar; |
} |
} |
|
|
my $query="SELECT QuestionId FROM Questions |
my $query; |
|
$query="SELECT QuestionId FROM Questions |
WHERE $f LIKE $sstr ORDER BY QuestionId"; |
WHERE $f LIKE $sstr ORDER BY QuestionId"; |
|
|
|
|
print $query if $printqueries; |
print $query if $printqueries; |
$sth = $dbh->prepare($query) |
$sth = $dbh->prepare($query) |
|
|
Line 415 print $query if $printqueries;
|
Line 400 print $query if $printqueries;
|
|
|
$sth->execute; |
$sth->execute; |
while (@arr = $sth->fetchrow) { |
while (@arr = $sth->fetchrow) { |
push @Questions, $arr[0]; |
push @Questions, $arr[0] unless $forbidden{$arr[0]}; |
} |
} |
|
|
return @Questions; |
return @Questions; |
Line 768 sub PrintQuestion {
|
Line 753 sub PrintQuestion {
|
{ |
{ |
my ($firstletter)=$Name=~m/^./g; |
my ($firstletter)=$Name=~m/^./g; |
# $other.=a({href=>url."?qofauthor=$AuthorId"},"$Name $Surname").". "; |
# $other.=a({href=>url."?qofauthor=$AuthorId"},"$Name $Surname").". "; |
|
$Name=~s/\./\\\./g; |
my $sha="(?:$Name\\s+$Surname)|(?:$Surname\\s+$Name)|(?:$firstletter\\.\\s*$Surname)|(?:$Surname\\s+$firstletter\\.)|(?:$Surname)|(?:$Name)"; |
my $sha="(?:$Name\\s+$Surname)|(?:$Surname\\s+$Name)|(?:$firstletter\\.\\s*$Surname)|(?:$Surname\\s+$firstletter\\.)|(?:$Surname)|(?:$Name)"; |
$Nicks=~s/^\|//; |
$Nicks=~s/^\|//; |
foreach (split /\|/, $Nicks) |
foreach (split /\|/, $Nicks) |
{ |
{ |
s/ /\\s+/; |
s/\s+/ /g; |
|
s/\s+$//; |
|
s/ /\\s+/g; |
|
s/\./\\\./g; |
if (s/>$//) {$sha="$sha|(?:$_)"} |
if (s/>$//) {$sha="$sha|(?:$_)"} |
else {$sha="(?:$_)|$sha"} |
else {$sha="(?:$_)|$sha"} |
} |
} |
#$output.=br."sha=$sha".br; |
|
$q=~s/($sha)/a({href=>url."?qofauthor=$AuthorId"},$1)/ei; |
$q=~s/($sha)/a({href=>url."?qofauthor=$AuthorId"},$1)/ei; |
} |
} |
|
|
Line 934 sub PrintQOfAuthor
|
Line 922 sub PrintQOfAuthor
|
my $q; |
my $q; |
my @Questions; |
my @Questions; |
while (($q)=$sth->fetchrow,$q) |
while (($q)=$sth->fetchrow,$q) |
{push @Questions,$q;} |
{push @Questions,$q unless $forbidden{$q}} |
|
|
my ($output, $i, $suffix, $hits) = ('', 0, '', $#Questions + 1); |
my ($output, $i, $suffix, $hits) = ('', 0, '', $#Questions + 1); |
|
|
Line 1026 MAIN:
|
Line 1014 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; |
|
|
my($dbh) = DBI->connect("DBI:mysql:chgk", "piataev", "") |
my($dbh) = DBI->connect("DBI:mysql:chgk", "piataev", "") |
or do { |
or do { |
print h1("Временные проблемы") . "База данных временно не |
print h1("Временные проблемы") . "База данных временно не |
Line 1057 if ((uc 'а') ne 'А') {print "Koi8-r loca
|
Line 1046 if ((uc 'а') ne 'А') {print "Koi8-r loca
|
print header('text/plain'); |
print header('text/plain'); |
} |
} |
|
|
|
if (param('showequal')) { |
|
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')) { |
my ($type, $qnum) = ('', 12); |
my ($type, $qnum) = ('', 12); |
$type .= 'Б' if (param('brain')); |
$type .= 'Б' if (param('brain')); |