version 1.41, 2001/12/04 01:17:12
|
version 1.51, 2001/12/13 00:01:58
|
Line 2
|
Line 2
|
|
|
use DBI; |
use DBI; |
use CGI ':all'; |
use CGI ':all'; |
use Text::Query; |
#use Text::Query; |
use strict; |
use strict; |
use Time::Local; |
use Time::Local; |
use POSIX qw(locale_h); |
use POSIX qw(locale_h); |
use locale; |
use locale; |
#open STDERR, ">errors1"; |
open STDERR, ">errors1"; |
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} |
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 73 sub GetTournament {
|
Line 74 sub GetTournament {
|
foreach $name (@{$sth->{NAME}}) { |
foreach $name (@{$sth->{NAME}}) { |
$Tournament{$name} = $arr[$i++]; |
$Tournament{$name} = $arr[$i++]; |
} |
} |
|
$sth->finish; |
return %Tournament; |
return %Tournament; |
} |
} |
|
|
Line 94 sub GetQuestion {
|
Line 95 sub GetQuestion {
|
$Question{$name} = $arr[$i++]; |
$Question{$name} = $arr[$i++]; |
} |
} |
|
|
|
$sth->finish; |
return %Question; |
return %Question; |
} |
} |
|
|
Line 103 sub GetTourQuestions {
|
Line 105 sub GetTourQuestions {
|
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 QuestionId"); |
WHERE ParentId=$ParentId"); |
|
|
$sth->execute; |
$sth->execute; |
|
|
Line 111 sub GetTourQuestions {
|
Line 113 sub GetTourQuestions {
|
push @Questions, $arr[0]; |
push @Questions, $arr[0]; |
} |
} |
|
|
|
$sth->finish; |
return @Questions; |
return @Questions; |
} |
} |
|
|
Line 127 sub GetTours {
|
Line 130 sub GetTours {
|
while (@arr = $sth->fetchrow) { |
while (@arr = $sth->fetchrow) { |
push @Tours, $arr[0]; |
push @Tours, $arr[0]; |
} |
} |
|
$sth->finish; |
return @Tours; |
return @Tours; |
} |
} |
|
|
Line 141 print "timeb=".time.br if $debug;
|
Line 144 print "timeb=".time.br if $debug;
|
$sth->execute; |
$sth->execute; |
my @a=$sth->fetchrow; |
my @a=$sth->fetchrow; |
print "timee0=".time.br if $debug; |
print "timee0=".time.br if $debug; |
|
$sth->finish; |
$a[0]||0; |
$a[0]||0; |
} |
} |
|
|
Line 151 sub printform
|
Line 155 sub printform
|
my $submit=submit(-value=>'ðÏÉÓË'); |
my $submit=submit(-value=>'ðÏÉÓË'); |
my $inputstring=textfield(-name=>'sstr', |
my $inputstring=textfield(-name=>'sstr', |
-default=>param('sstr')||'', |
-default=>param('sstr')||'', |
-size=>50); |
-size=>30, |
my $fields=checkbox_group('searchin',['Question','Answer','Comments','Authors','Sources'], [grep $searchin{$_}, keys %searchin], |
-maxlength=>30); |
|
my $qnumber="÷Ù×ÏÄÉÔØ ÐÏ".br. textfield(-name=>'kvo', |
|
-default=>param('kvo')||'150', |
|
-size=>3, |
|
-maxlength=>5). br."×ÏÐÒÏÓÏ×"; |
|
|
|
my @df=keys %searchin; |
|
@df=('Question', 'Answer') unless @df; |
|
my $fields=checkbox_group('searchin',['Question','Answer','Comments','Authors','Sources'], [@df], |
'false',\%rusfieldname); |
'false',\%rusfieldname); |
|
|
my $metod=radio_group(-name=>'metod',-values=>['old','rus'], |
my $metod=radio_group(-name=>'metod',-values=>['old','rus'], |
-default=>param('metod')||'rus', |
-default=>(param('metod')||'rus'), |
-labels=>\%rusfieldname); |
-labels=>\%rusfieldname); |
my $all=radio_group(-name=>'all',-values=>['yes','no'], |
my $all=radio_group(-name=>'all',-values=>['yes','no'], |
-default=>param('all')||'no', |
-default=>(param('all')||'no'), |
-labels=>{'yes'=>'÷ÓÅ','no'=>'ìÀÂÏÅ'}); |
-labels=>{'yes'=>'÷ÓÅ','no'=>'ìÀÂÏÅ'}); |
|
|
################################################# |
################################################# |
Line 172 table(Tr
|
Line 184 table(Tr
|
( |
( |
td({-valign=>'TOP'},$inputstring.$submit.p."íÅÔÏÄ: $metod".p."óÌÏ×Á: $all"), |
td({-valign=>'TOP'},$inputstring.$submit.p."íÅÔÏÄ: $metod".p."óÌÏ×Á: $all"), |
td({-valign=>'TOP'},(' 'x 8).'ðÏÌÑ:'), |
td({-valign=>'TOP'},(' 'x 8).'ðÏÌÑ:'), |
td({-valign=>'TOP'},$fields) |
td({-valign=>'TOP'},$fields), td(" "x5), |
|
td({-valign=>'TOP'},$qnumber) |
) |
) |
) |
) |
|
|
Line 193 sub proxy
|
Line 206 sub proxy
|
$text=~s/p(${RLrl})/Ò$1/gom; |
$text=~s/p(${RLrl})/Ò$1/gom; |
$text=~s/(${RLrl})p/$1Ò/gom; |
$text=~s/(${RLrl})p/$1Ò/gom; |
$text=~s/\s+/ /gmo; |
$text=~s/\s+/ /gmo; |
$text=~s/[^ÊÃÕËÅÎÇÛÝÚÈßÆÙ×ÁÐÒÏÌÄÖÜÑÞÓÍÉÔØÂÀêãõëåîçûýúèÿæù÷áðòïìäöüñþóíéôøâàQWERTYUIOPASDFGHJKLZXCVBNM]/ /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); |
Line 210 sub proxy
|
Line 223 sub proxy
|
$good{$_}=1 if $c{$_}<200; |
$good{$_}=1 if $c{$_}<200; |
} |
} |
|
|
$good{$words[$_]}=0 foreach 11..$#words; |
$good{$words[$_]}=0 foreach 16..$#words; |
|
|
# foreach (@list) |
# foreach (@list) |
# { |
# { |
Line 263 print "$query",br if $printqueries;
|
Line 276 print "$query",br if $printqueries;
|
{ |
{ |
push (@{$nf[$i]},$arr[0]) |
push (@{$nf[$i]},$arr[0]) |
} |
} |
|
$sth->finish; |
} |
} |
|
|
|
|
Line 309 print STDERR "!$query\n",br if $printque
|
Line 323 print STDERR "!$query\n",br if $printque
|
{ |
{ |
@blob=(@blob,unpack 'C*',$arr[0]); |
@blob=(@blob,unpack 'C*',$arr[0]); |
} |
} |
|
$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; |
print "$query\n",br if $printqueries; |
$sth=$dbh -> prepare($query); |
$sth=$dbh -> prepare($query); |
Line 318 print "$query\n",br if $printqueries;
|
Line 333 print "$query\n",br if $printqueries;
|
{ |
{ |
$frequence[$i]+=$arr[0]; |
$frequence[$i]+=$arr[0]; |
} |
} |
|
$sth->finish; |
|
|
|
|
if (@blob < 4) |
if (@blob < 4) |
Line 439 sub Search {
|
Line 454 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'}; |
# my $ip=$ENV{'REMOTE_ADDR'}; |
|
|
$ip=$dbh->quote($ip); |
# $ip=$dbh->quote($ip); |
$query= |
# $query= |
"INSERT into queries (query,metod,searchin,ip) |
# "INSERT into queries (query,metod,searchin,ip) |
values (". $dbh->quote($sstr).', '. |
# values (". $dbh->quote($sstr).', '. |
$dbh->quote($metod) . ', ' . |
# $dbh->quote($metod) . ', ' . |
$dbh->quote(join ' ', grep $searchin{$_}, keys %searchin) . |
# $dbh->quote(join ' ', grep $searchin{$_}, keys %searchin) . |
", $ip)"; |
# ", $ip)"; |
print $query if $printqueries; |
#print $query if $printqueries; |
$dbh -> do ($query); |
# $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 525 print $query if $printqueries;
|
Line 540 print $query if $printqueries;
|
while (@arr = $sth->fetchrow) { |
while (@arr = $sth->fetchrow) { |
push @Questions, $arr[0] unless $forbidden{$arr[0]}; |
push @Questions, $arr[0] unless $forbidden{$arr[0]}; |
} |
} |
|
$sth->finish; |
print "@Questions" if $printqueries; |
print "@Questions" if $printqueries; |
return @Questions; |
return @Questions; |
} |
} |
Line 535 print "@Questions" if $printqueries;
|
Line 550 print "@Questions" if $printqueries;
|
Ðð Òò Óó Ôô Õõ Ææ Èè Ãã Þþ Ûû Ýý Øø Ùù Üü Àà Ññ/; |
Ðð Òò Óó Ôô Õõ Ææ Èè Ãã Þþ Ûû Ýý Øø Ùù Üü Àà Ññ/; |
|
|
sub NoCase { |
sub NoCase { |
my ($sstr) = shift; |
my ($sstr) = shift; |
my ($res); |
my ($res); |
|
|
if (($res) = grep(/$sstr/, @letters)) { |
if (($res) = grep(/$sstr/, @letters)) { |
Line 549 sub PrintList {
|
Line 564 sub PrintList {
|
my ($dbh,$Questions,$shablon)=@_; |
my ($dbh,$Questions,$shablon)=@_; |
|
|
my $first=param('first') ||1; |
my $first=param('first') ||1; |
my $kvo=param('kvo') ||30; |
my $kvo=param('kvo') ||150; |
|
|
$first=$first-($first-1)%$kvo; |
$first=$first-($first-1)%$kvo; |
my $last=$first+$kvo-1; |
my $last=$first+$kvo-1; |
Line 559 sub PrintList {
|
Line 574 sub PrintList {
|
my $qs=query_string; |
my $qs=query_string; |
$qs=~s/\;/\&/g; |
$qs=~s/\;/\&/g; |
$qs=~s/\&first\=[^\&]+//g; |
$qs=~s/\&first\=[^\&]+//g; |
|
my $sstr=param('sstr'); |
|
$qs=~s/sstr=[^\&]+/sstr=$sstr/; |
if ($first>$kvo*3+1) |
if ($first>$kvo*3+1) |
{ |
{ |
$nav.= |
$nav.= |
Line 956 sub PrintQuestion {
|
Line 971 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.Id,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); |
|
|
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)"; |
# my $sha="(?:$Name\\s+$Surname)|(?:$Surname\\s+$Name)|(?:$firstletter\\.\\s*$Surname)|(?:$Surname\\s+$firstletter\\.)|(?:$Surname)|(?:$Name)"; |
if ($Nicks) |
# if ($Nicks) |
{ |
# { |
$Nicks=~s/^\|//; |
# $Nicks=~s/^\|//; |
foreach (split /\|/, $Nicks) |
# foreach (split /\|/, $Nicks) |
{ |
# { |
s/\s+/ /g; |
# s/\s+/ /g; |
s/\s+$//; |
# s/\s+$//; |
s/ /\\s+/g; |
# s/ /\\s+/g; |
s/\./\\\./g; |
# s/\./\\\./g; |
if (s/>$//) {$sha="$sha|(?:$_)"} |
# if (s/>$//) {$sha="$sha|(?:$_)"} |
else {$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; |
} |
# } |
|
|
$output .= &PrintField("á×ÔÏÒ(Ù)", $q, $text); |
$output .= &PrintField("á×ÔÏÒ(Ù)", $q, $text); |
|
|
Line 995 sub PrintQuestion {
|
Line 1010 sub PrintQuestion {
|
$output .= &PrintField("ëÏÍÍÅÎÔÁÒÉÉ", $Question{'Comments'}, $text); |
$output .= &PrintField("ëÏÍÍÅÎÔÁÒÉÉ", $Question{'Comments'}, $text); |
} |
} |
} |
} |
$output.=br.a({href=> url."?metod=proxy&qid=$Id"}, 'âÌÉÚËÉÅ ×ÏÐÒÏÓÙ').p |
# $output.=br.a({href=> url."?metod=proxy&qid=$Id"}, 'âÌÉÚËÉÅ ×ÏÐÒÏÓÙ').p |
if $answer; |
# if $answer; |
return $output; |
return $output; |
} |
} |
|
|
Line 1030 sub Get12Random {
|
Line 1045 sub Get12Random {
|
$sth->execute; |
$sth->execute; |
$t = ($sth->fetchrow)[0]; |
$t = ($sth->fetchrow)[0]; |
} until !$chosen{$q} && $t && $type =~ /[$t]/; |
} until !$chosen{$q} && $t && $type =~ /[$t]/; |
|
$sth->finish; |
$chosen{$q} = 'y'; |
$chosen{$q} = 'y'; |
push @questions, $q; |
push @questions, $q; |
} |
} |
Line 1121 sub PrintDates {
|
Line 1137 sub PrintDates {
|
" " . a({href=>url . "?tour=$Tournament{'Id'}&answer=0"}, |
" " . a({href=>url . "?tour=$Tournament{'Id'}&answer=0"}, |
$Tournament{'Title'}, $Tournament{'PlayedAt'})); |
$Tournament{'Title'}, $Tournament{'PlayedAt'})); |
} |
} |
|
$sth->finish; |
$output .= dl($list); |
$output .= dl($list); |
return $output; |
return $output; |
} |
} |
Line 1140 sub PrintQOfAuthor
|
Line 1157 sub PrintQOfAuthor
|
my @Questions; |
my @Questions; |
while (($q)=$sth->fetchrow,$q) |
while (($q)=$sth->fetchrow,$q) |
{push @Questions,$q unless $forbidden{$q}} |
{push @Questions,$q unless $forbidden{$q}} |
|
$sth->finish; |
|
|
my ($output, $i, $suffix, $hits) = ('', 0, '', $#Questions + 1); |
my ($output, $i, $suffix, $hits) = ('', 0, '', $#Questions + 1); |
|
|
Line 1213 a({href=>url."?authors=surname"},"ÆÁÍÉÌÉ
|
Line 1231 a({href=>url."?authors=surname"},"ÆÁÍÉÌÉ
|
} |
} |
} |
} |
$output.="</TABLE>"; |
$output.="</TABLE>"; |
|
$sth->finish; |
return $output; |
return $output; |
} |
} |
|
|
Line 1309 print $query if $printqueries;
|
Line 1328 print $query if $printqueries;
|
my $sth=$dbh->prepare($query); |
my $sth=$dbh->prepare($query); |
$sth->execute; |
$sth->execute; |
my $sstr= join ' ',$sth->fetchrow; |
my $sstr= join ' ',$sth->fetchrow; |
|
$sth->finish; |
$searchin{'Question'}=1; |
$searchin{'Question'}=1; |
$searchin{'Answer'}=1; |
$searchin{'Answer'}=1; |
$sstr=~tr/£³/Åå/; |
$sstr=~tr/£³/Åå/; |
Line 1351 $sstr=~s/[^ÊÃÕËÅÎÇÛÝÚÈßÆÙ×ÁÐÒÏÌÄÖÜÑÞÓÍÉÔ
|
Line 1371 $sstr=~s/[^ÊÃÕËÅÎÇÛÝÚÈßÆÙ×ÁÐÒÏÌÄÖÜÑÞÓÍÉÔ
|
WHERE FileName = '$tour.txt'"); |
WHERE FileName = '$tour.txt'"); |
$sth->execute; |
$sth->execute; |
$tour = ($sth->fetchrow)[0]; |
$tour = ($sth->fetchrow)[0]; |
|
$sth->finish; |
} |
} |
print &PrintTournament($dbh, $tour, param('answer')); |
print &PrintTournament($dbh, $tour, param('answer')); |
} |
} |