version 1.36, 2001/11/25 23:40:27
|
version 1.44, 2001/12/05 01:55:21
|
Line 7 use strict;
|
Line 7 use strict;
|
use Time::Local; |
use Time::Local; |
use POSIX qw(locale_h); |
use POSIX qw(locale_h); |
use locale; |
use locale; |
open STDERR, ">errors"; |
#open STDERR, ">errors1"; |
my $printqueries=1; |
my $printqueries=0; |
my %forbidden=(); |
my %forbidden=(); |
my $debug=1; #added by R7 |
my $debug=0; #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 %rusfieldname=('Question','÷ÏÐÒÏÓ', 'Answer', 'ïÔ×ÅÔ', |
|
'Comments', 'ëÏÍÍÅÎÔÁÒÉÉ', 'Authors', 'á×ÔÏÒ', |
|
'Sources', 'éÓÔÏÞÎÉË','old','óÔÁÒÙÊ','rus','îÏ×ÙÊ'); |
my %searchin; |
my %searchin; |
|
my $rl=qr/[ÊÃÕËÅÎÇÛÝÚÈßÆÙ×ÁÐÒÏÌÄÖÜÑÞÓÍÉÔØÂÀ£]/; |
|
my $RL=qr/[êãõëåîçûýúèÿüöäìïòðá÷ùæñþóíéôøâà³]/; |
|
my $RLrl=qr/(?:(?:${rl})|(?:${RL}))+/; |
|
my $l=qr/(?:(?:${RLrl})|(?:[\w\-]))+/; |
|
my $Ll=qr/(?:[A-Z])|(?:${RL})/; |
|
|
|
|
|
|
my $thislocale; |
|
|
|
|
my $thislocale; |
|
|
$searchin{'question'}=param('Question'); |
$searchin{$_}=1 foreach param('searchin'); |
$searchin{'answer'}=param('Answer'); |
#$searchin{'Question'}=param('Question'); |
$searchin{'comment'}=param('Comment'); |
#$searchin{'Answer'}=param('Answer'); |
$searchin{'authors'}=param('Authors'); |
#$searchin{'Comments'}=param('Comments'); |
$searchin{'sources'}=param('Sources'); |
#$searchin{'Authors'}=param('Authors'); |
|
#$searchin{'Sources'}=param('Sources'); |
my $all=param('all'); |
my $all=param('all'); |
$all=0 if lc $all eq 'no'; |
$all=0 if lc $all eq 'no'; |
my ($PWD) = `pwd`; |
my ($PWD) = `pwd`; |
Line 33 my ($ZIP) = "/home/piataev/bin/zip";
|
Line 42 my ($ZIP) = "/home/piataev/bin/zip";
|
my $DUMPFILE = "/tmp/chgkdump"; |
my $DUMPFILE = "/tmp/chgkdump"; |
my ($SENDMAIL) = "/usr/sbin/sendmail"; |
my ($SENDMAIL) = "/usr/sbin/sendmail"; |
my ($TMSECS) = 30*24*60*60; |
my ($TMSECS) = 30*24*60*60; |
my (%RevMonths) = |
my (%RevMonths) = |
('Jan', '0', 'Feb', '1', 'Mar', '2', 'Apr', '3', 'May', '4', 'Jun', '5', |
('Jan', '0', 'Feb', '1', 'Mar', '2', 'Apr', '3', 'May', '4', 'Jun', '5', |
'Jul', '6', 'Aug', '7', 'Sep', '8', 'Oct', '9', 'Nov', '10', |
'Jul', '6', 'Aug', '7', 'Sep', '8', 'Oct', '9', 'Nov', '10', |
'Dec', '11', |
'Dec', '11', |
'ñÎ×', '0', 'æÅ×', 1, 'íÁÒ', 2, 'áÐÒ', 3, 'íÁÊ', '4', |
'ñÎ×', '0', 'æÅ×', 1, 'íÁÒ', 2, 'áÐÒ', 3, 'íÁÊ', '4', |
'éÀÎ', '5', 'éÀÌ', 6, 'á×Ç', '7', 'óÅÎ', '8', |
'éÀÎ', '5', 'éÀÌ', 6, 'á×Ç', '7', 'óÅÎ', '8', |
'ïËÔ', '9', 'îÏÑ', '19', 'äÅË', '11'); |
'ïËÔ', '9', 'îÏÑ', '19', 'äÅË', '11'); |
|
|
# Determine whether the given time is within 2 months from now. |
# Determine whether the given time is within 2 months from now. |
Line 93 sub GetTourQuestions {
|
Line 102 sub GetTourQuestions {
|
my ($dbh, $ParentId) = @_; |
my ($dbh, $ParentId) = @_; |
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 ORDER BY QuestionId"); |
|
|
$sth->execute; |
$sth->execute; |
Line 122 sub GetTours {
|
Line 131 sub GetTours {
|
return @Tours; |
return @Tours; |
} |
} |
|
|
|
sub count |
|
{ |
|
my ($dbh,$word)=@_; |
|
print "timeb=".time.br if $debug; |
|
$word=$dbh->quote(uc $word); |
|
my $query="SELECT number from nests,nf where $word=w1 AND w2=nf.id"; |
|
my $sth=$dbh->prepare($query); |
|
$sth->execute; |
|
my @a=$sth->fetchrow; |
|
print "timee0=".time.br if $debug; |
|
$a[0]||0; |
|
} |
|
|
|
|
|
sub printform |
|
{ |
|
|
|
my $submit=submit(-value=>'ðÏÉÓË'); |
|
my $inputstring=textfield(-name=>'sstr', |
|
-default=>param('sstr')||'', |
|
-size=>50); |
|
my @df=keys %searchin; |
|
@df=('Question', 'Answer') unless @df; |
|
my $fields=checkbox_group('searchin',['Question','Answer','Comments','Authors','Sources'], [@df], |
|
'false',\%rusfieldname); |
|
|
|
my $metod=radio_group(-name=>'metod',-values=>['old','rus'], |
|
-default=>(param('metod')||'rus'), |
|
-labels=>\%rusfieldname); |
|
my $all=radio_group(-name=>'all',-values=>['yes','no'], |
|
-default=>(param('all')||'no'), |
|
-labels=>{'yes'=>'÷ÓÅ','no'=>'ìÀÂÏÅ'}); |
|
|
|
################################################# |
|
return start_form(-method=>'get', |
|
-action=>url, |
|
-enctype=> |
|
"application/x-www-form-urlencoded" |
|
).br. |
|
table(Tr |
|
( |
|
td({-valign=>'TOP'},$inputstring.$submit.p."íÅÔÏÄ: $metod".p."óÌÏ×Á: $all"), |
|
td({-valign=>'TOP'},(' 'x 8).'ðÏÌÑ:'), |
|
td({-valign=>'TOP'},$fields) |
|
) |
|
) |
|
|
|
#$fields. |
|
#$inputstring.$submit.br.$metod.$all |
|
.endform |
|
.hr |
|
|
|
} |
|
|
|
sub proxy |
|
{ |
|
#print "time0=".time.br if $debug; |
|
my ($dbh,$ptext,$allnf)=@_; |
|
my $text=$$ptext; |
|
$text=~tr/£³/Åå/; |
|
$text=~s/(${RLrl})p(${RLrl})/$1p$2/gom; |
|
$text=~s/p(${RLrl})/Ò$1/gom; |
|
$text=~s/(${RLrl})p/$1Ò/gom; |
|
$text=~s/\s+/ /gmo; |
|
$text=~s/[^ÊÃÕËÅÎÇÛÝÚÈßÆÙ×ÁÐÒÏÌÄÖÜÑÞÓÍÉÔØÂÀêãõëåîçûýúèÿæù÷áðòïìäöüñþóíéôøâàQWERTYUIOPASDFGHJKLZXCVBNM0-9]/ /g; |
|
$text=uc $text; |
|
my @list= $text=~m/(?:(?:${RLrl})+)|(?:[A-Za-z0-9]+)/gom; |
|
my (%c, %good,$sstr); |
|
foreach (@list) |
|
{ |
|
$c{$_}=count($dbh,$_)||10000; |
|
} |
|
my @words=sort {$c{$a}<=> $c{$b}} @list; |
|
|
|
# $good{$words[$_]}=1 foreach 0..4; |
|
|
|
foreach (@words) |
|
{ |
|
$good{$_}=1 if $c{$_}<200; |
|
} |
|
|
|
$good{$words[$_]}=0 foreach 16..$#words; |
|
|
|
# foreach (@list) |
|
# { |
|
# if ($good{$_}) |
|
# { |
|
# $good{$_}=0; |
|
# $sstr.=" $_"; |
|
# } |
|
# } |
|
$sstr.=" $_" foreach grep {$good{$_}} @list; |
|
print "time05=".time.br if $debug; |
|
$$ptext=$sstr; |
|
return russearch($dbh,$sstr,0,$allnf); |
|
} |
|
|
|
|
sub russearch { |
sub russearch { |
my ($dbh, $sstr, $all,$allnf)=@_; |
my ($dbh, $sstr, $all,$allnf)=@_; |
my (@qw,@w,@tasks,$qw,@arr,$nf,$sth,@nf,$w,$where,$e,@where,%good,$i,%where,$from); |
my (@qw,@w,@tasks,$qw,@arr,$nf,$sth,@nf,$w,$where,$e,@where,%good,$i,%where,$from); |
Line 146 $sstr=~tr/ÊÃÕËÅÎÇÛÝÚÈßÆÙ×ÁÐÒÏÌÄÖÜÑÞÓÍÉÔØ
|
Line 253 $sstr=~tr/ÊÃÕËÅÎÇÛÝÚÈßÆÙ×ÁÐÒÏÌÄÖÜÑÞÓÍÉÔØ
|
foreach $i (0..$#w) # ÚÁÐÏÌÎÑÅÍ ÍÁÓÓÉ× @nf ÎÁÞÁÌØÎÙÈ ÆÏÒÍ |
foreach $i (0..$#w) # ÚÁÐÏÌÎÑÅÍ ÍÁÓÓÉ× @nf ÎÁÞÁÌØÎÙÈ ÆÏÒÍ |
# $nf[$i] -- ÓÓÙÌËÁ ÎÁ ÍÁÓÓÉ× ×ÏÚÍÏÖÎÙÈ |
# $nf[$i] -- ÓÓÙÌËÁ ÎÁ ÍÁÓÓÉ× ×ÏÚÍÏÖÎÙÈ |
# ÎÁÞÁÌØÎÙÈ ÆÏÒÍ ÓÌÏ×ÏÆÏÒÍÙ $i |
# ÎÁÞÁÌØÎÙÈ ÆÏÒÍ ÓÌÏ×ÏÆÏÒÍÙ $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"; |
Line 161 print "$query",br if $printqueries;
|
Line 268 print "$query",br if $printqueries;
|
} |
} |
|
|
|
|
my @bad=grep {!$nf[$_]} 0..$#w; # @bad -- ÎÏÍÅÒÁ ÓÌÏ×ÏÆÏÒÍ, |
my @bad=grep {!@{$nf[$_]}} 0..$#w; # @bad -- ÎÏÍÅÒÁ ÓÌÏ×ÏÆÏÒÍ, |
# ËÏÔÏÒÙÈ ÎÅÔ × ÓÌÏ×ÁÒÅ |
# ËÏÔÏÒÙÈ ÎÅÔ × ÓÌÏ×ÁÒÅ |
|
|
if (@bad) #ÅÓÔØ ÎÅÏÐÏÚÎÁÎÎÙÅ ÓÌÏ×ÏÆÏÒÍÙ |
if (@bad) #ÅÓÔØ ÎÅÏÐÏÚÎÁÎÎÙÅ ÓÌÏ×ÏÆÏÒÍÙ |
Line 192 print "$query",br if $printqueries;
|
Line 299 print "$query",br if $printqueries;
|
|
|
$_= " word2question.word=".$_. ' ' foreach @arr; |
$_= " word2question.word=".$_. ' ' foreach @arr; |
$_= " nf.id=".$_. ' ' foreach @arr1; |
$_= " nf.id=".$_. ' ' foreach @arr1; |
|
# @arr=(0) unless @arr; |
$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 STDERR "!$query\n",br if $printqueries; |
|
|
$sth=$dbh -> prepare($query); |
$sth=$dbh -> prepare($query); |
$sth->execute; |
$sth->execute; |
Line 235 print "$query\n",br if $printqueries;
|
Line 342 print "$query\n",br if $printqueries;
|
$ii+=4; |
$ii+=4; |
$number=$lo+$hi*256; |
$number=$lo+$hi*256; |
$field=$fieldname{$field}; |
$field=$fieldname{$field}; |
if ($searchin{lc $field}) |
if ($searchin{$field}) |
{ |
{ |
push @{$tasksof{$i}{$number}}, $wordnumber; |
push @{$tasksof{$i}{$number}}, $wordnumber; |
# ÄÏÐÏÌÎÉÌÉ × ÈÜÛÅ, ×ÉÓÑÝÅÍ ÎÁ |
# ÄÏÐÏÌÎÉÌÉ × ÈÜÛÅ, ×ÉÓÑÝÅÍ ÎÁ |
Line 330 if $$words{$first};
|
Line 437 if $$words{$first};
|
|
|
# Returns list of QuestionId's, that have the search string in them. |
# Returns list of QuestionId's, that have the search string in them. |
sub Search { |
sub Search { |
my ($dbh, $sstr,$metod,$all,$allnf) = @_; |
my ($dbh, $s,$metod,$all,$allnf) = @_; |
|
my $sstr=$$s; |
my (@arr, @Questions, @fields); |
my (@arr, @Questions, @fields); |
my (@sar, $i, $sth,$where); |
my (@sar, $i, $sth,$where,$query); |
|
my $ip=$ENV{'REMOTE_ADDR'}; |
# push @fields, 'Question'; |
|
|
|
|
$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); |
return @tasks |
return @tasks |
} |
} |
|
elsif ($metod eq 'proxy') |
|
{ |
|
# $searchin{'question'}=1; |
|
# $searchin{'answer'}=1; |
|
my @task=proxy($dbh,$s,$allnf); |
|
# $$s=$sstr; |
|
return @task |
|
} |
|
|
|
|
|
|
###Simple and advanced query processing. Added by R7 |
###Simple and advanced query processing. Added by R7 |
if ($metod eq 'simple' || $metod eq 'advanced') |
if ($metod eq 'simple' || $metod eq 'advanced') |
{ |
{ |
foreach (qw/Question Answer Sources Authors Comments/) { |
foreach (qw/Question Answer Sources Authors Comments/) { |
if (param($_)) { |
if (param($_)) { |
push @fields, $_; |
push @fields, $_; |
} |
} |
} |
} |
|
|
@fields=(qw/Question Answer Sources Authors Comments/) unless scalar @fields; |
@fields=(qw/Question Answer Sources Authors Comments/) unless scalar @fields; |
my $fields=join ",", @fields; |
my $fields=join ",", @fields; |
my $q=new Text::Query($sstr, |
my $q=new Text::Query($sstr, |
-parse => 'Text::Query::'. |
-parse => 'Text::Query::'. |
(($metod eq 'simple') ? 'ParseSimple':'ParseAdvanced'), |
(($metod eq 'simple') ? 'ParseSimple':'ParseAdvanced'), |
-solve => 'Text::Query::SolveSQL', |
-solve => 'Text::Query::SolveSQL', |
-build => 'Text::Query::BuildSQLMySQL', |
-build => 'Text::Query::BuildSQLMySQL', |
-fields_searched => $fields); |
-fields_searched => $fields); |
|
|
$where= $$q{'matchexp'}; |
$where= $$q{'matchexp'}; |
my $query= "SELECT Questionid FROM Questions |
$query= "SELECT Questionid FROM Questions |
WHERE $where"; |
WHERE $where"; |
print br."Query is: $query".br if $debug; |
print br."Query is: $query".br if $debug; |
|
|
$sth = $dbh->prepare($query); |
$sth = $dbh->prepare($query); |
} else |
} else |
###### |
###### |
{ |
{ |
|
|
foreach (qw/Question Answer Sources Authors Comments/) { |
# foreach (qw/Question Answer Sources Authors Comments/) { |
if (param($_)) { |
foreach (param('searchin')) { |
|
# if (param($_)) { |
push @fields, "IFNULL($_, '')"; |
push @fields, "IFNULL($_, '')"; |
} |
# } |
} |
} |
@sar = split " ", $sstr; |
@sar = split " ", $sstr; |
for $i (0 .. $#sar) { |
for $i (0 .. $#sar) { |
Line 387 sub Search {
|
Line 513 sub Search {
|
} else { |
} else { |
$sstr = join " OR $f LIKE ", @sar; |
$sstr = join " OR $f LIKE ", @sar; |
} |
} |
|
|
my $query; |
my $query; |
$query="SELECT QuestionId FROM Questions |
$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) |
|
|
} #else -- processing old-style query (R7) |
} #else -- processing old-style query (R7) |
|
|
$sth->execute; |
$sth->execute; |
while (@arr = $sth->fetchrow) { |
while (@arr = $sth->fetchrow) { |
push @Questions, $arr[0] unless $forbidden{$arr[0]}; |
push @Questions, $arr[0] unless $forbidden{$arr[0]}; |
} |
} |
|
|
|
print "@Questions" if $printqueries; |
return @Questions; |
return @Questions; |
} |
} |
|
|
# Substitute every letter by a pair (for case insensitive search). |
# Substitute every letter by a pair (for case insensitive search). |
my (@letters) = qw/Áá Ââ ×÷ Çç Ää Åå Öö Úú Éé Êê Ëë Ìì Íí Îî Ïï |
my (@letters) = qw/Áá Ââ ×÷ Çç Ää Åå Öö Úú Éé Êê Ëë Ìì Íí Îî Ïï |
Ðð Òò Óó Ôô Õõ Ææ Èè Ãã Þþ Ûû Ýý Øø Ùù Üü Àà Ññ/; |
Ðð Òò Óó Ôô Õõ Ææ Èè Ãã Þþ Ûû Ýý Øø Ùù Üü Àà Ññ/; |
|
|
sub NoCase { |
sub NoCase { |
my ($sstr) = shift; |
my ($sstr) = shift; |
my ($res); |
my ($res); |
Line 421 sub NoCase {
|
Line 547 sub NoCase {
|
} |
} |
} |
} |
|
|
|
sub PrintList { |
|
my ($dbh,$Questions,$shablon)=@_; |
|
|
|
my $first=param('first') ||1; |
|
my $kvo=param('kvo') ||30; |
|
|
|
$first=$first-($first-1)%$kvo; |
|
my $last=$first+$kvo-1; |
|
$last=scalar @$Questions if scalar @$Questions <$last; |
|
my($f,$l); |
|
my $nav=''; |
|
my $qs=query_string; |
|
$qs=~s/\;/\&/g; |
|
$qs=~s/\&first\=[^\&]+//g; |
|
|
|
|
|
if ($first>$kvo*3+1) |
|
{ |
|
$nav.= |
|
(" "x4). |
|
a({href=>url."?".$qs."\&first=1"},"<<").(" "x4). |
|
a({href=>(url."?".$qs."\&first=".($first-$kvo))},"<").(" "x4) |
|
} |
|
|
|
else {$nav.=' 'x15;} |
|
|
|
my ($fprint,$lprint); |
|
my $llprint=$#$Questions- ($#$Questions+1)%$kvo+2; |
|
if ($#$Questions+1<=$kvo*7) |
|
{ $fprint=1; |
|
$lprint=$llprint; |
|
} |
|
elsif ($first>$kvo*3 && $#$Questions+1-$first>$kvo*3) |
|
{ |
|
$fprint=$first-$kvo*3; |
|
$lprint=$first+$kvo*3; |
|
} |
|
elsif ($first<=$kvo*3) |
|
{ |
|
$fprint=1; $lprint=6*$kvo+1; |
|
} |
|
else |
|
{ |
|
$lprint=$llprint; |
|
$fprint=$lprint-$kvo*6 |
|
} |
|
|
|
# my $fprint=($first>$kvo*3) ? $first-$kvo*3 : 1; |
|
# my $lprint=$#$Questions+1-$fprint>$kvo*7 ? $kvo*7 :$#$Questions+1; |
|
# if ($lprint-$fprint<$kvo*6 && $fprint>1) |
|
# { |
|
# $fprint=$lprint-$kvo*6; |
|
# $fprint=1 if ($fprint<=0) |
|
# } |
|
|
|
|
|
|
|
for($f=$fprint; $f<=$lprint; $f+=$kvo) |
|
{ |
|
# next if $first-$f>$kvo*3; |
|
$l=$f+$kvo-1; |
|
$l=$#$Questions+1 if $l>$#$Questions+1; |
|
if ($f==$first) {$nav.="[$f-$l] ";} |
|
else { |
|
$nav.= "[".a({href=>(url."?".$qs."\&first=$f")},"$f-$l")."] ";} |
|
} |
|
if ($lprint+$kvo<$#$Questions) |
|
{ |
|
$nav.= |
|
(" "x4). |
|
a({href=>(url."?".$qs."\&first=".($first+$kvo))},">").(" "x4). |
|
a({href=>url."?".$qs."\&first=$llprint"},">>").(" "x4) |
|
} |
|
|
|
|
|
print "$nav".br."\n"; |
|
for (my $i = $first; $i <= $last; $i++) { |
|
my $output = &PrintQuestion($dbh, $$Questions[$i-1], 1, $i, 1); |
|
if (param('metod') eq 'rus' || param('metod') eq 'proxy') |
|
{ |
|
$output=~s/\b($shablon)\b/\<strong\>$1\<\/strong\>/gi; |
|
} else { |
|
$output=~s/($shablon)/\<strong\>$1\<\/strong\>/gi; |
|
} |
|
print $output; |
|
} |
|
|
|
|
|
print "$nav".br."\n"; |
|
|
|
} |
|
|
sub PrintSearch { |
sub PrintSearch { |
my ($dbh, $sstr, $metod) = @_; |
my ($dbh, $sstr, $metod) = @_; |
|
print h2("ðÏÉÓË × ÂÁÚÅ ×ÏÐÒÏÓÏ×"); |
|
print printform; |
my @allnf; |
my @allnf; |
my (@Questions) = &Search($dbh, $sstr,$metod,$all,\@allnf); |
my (@Questions) = &Search($dbh, \$sstr,$metod,$all,\@allnf); |
my ($output, $i, $suffix, $hits) = ('', 0, '', $#Questions + 1); |
my ($output, $i, $suffix, $hits) = ('', 0, '', $#Questions + 1); |
|
|
my $shablon; |
my $shablon; |
|
$metod='rus' if $metod eq 'proxy'; |
if ($metod eq 'rus') |
if ($metod eq 'rus') |
{ |
{ |
my $where='0'; |
my $where='0'; |
Line 443 print "$query" if $printqueries;
|
Line 663 print "$query" if $printqueries;
|
{ |
{ |
push @shablon,"(?:$arr[0])"; |
push @shablon,"(?:$arr[0])"; |
} |
} |
$shablon= join "|", @shablon; |
$shablon= join "|", @shablon; |
$shablon=~s/[Å£]/\[å³\]/gi; |
$shablon=~s/[Å£]/\[å³\]/gi; |
# $shablon=~s/([ÊÃÕËÅÎÇÛÝÚÈßÆÙ×ÁÐÒÏÌÄÖÜÑÞÓÍÉÔØÂÀêãõëåîçûýúèÿæù÷áðòïìäöüñþóíéôøâà])/&NoCase($1)/ge; |
# $shablon=~s/([ÊÃÕËÅÎÇÛÝÚÈßÆÙ×ÁÐÒÏÌÄÖÜÑÞÓÍÉÔØÂÀêãõëåîçûýúèÿæù÷áðòïìäöüñþóíéôøâà])/&NoCase($1)/ge; |
$shablon=qr/$shablon/i; |
$shablon=qr/$shablon/i; |
Line 457 print "$query" if $printqueries;
|
Line 677 print "$query" if $printqueries;
|
} elsif ($hits =~ /1$/) { |
} elsif ($hits =~ /1$/) { |
$suffix = 'Å'; |
$suffix = 'Å'; |
} else { |
} else { |
$suffix = 'Ñ'; |
$suffix = 'Ñ'; |
} |
} |
|
|
print p({align=>"center"}, "òÅÚÕÌØÔÁÔÙ ÐÏÉÓËÁ ÎÁ " . strong($sstr) |
print p({align=>"center"}, "òÅÚÕÌØÔÁÔÙ ÐÏÉÓËÁ ÎÁ " . strong($sstr) |
. " : $hits ÐÏÐÁÄÁÎÉ$suffix."); |
. " : $hits ÐÏÐÁÄÁÎÉ$suffix."); |
|
|
Line 469 print "$query" if $printqueries;
|
Line 689 print "$query" if $printqueries;
|
|
|
$sstr =~ s/(.)/&NoCase($1)/ge; |
$sstr =~ s/(.)/&NoCase($1)/ge; |
|
|
my(@sar) = split(' ', $sstr); |
my @sar; |
for ($i = 0; $i <= $#Questions; $i++) { |
if ($metod ne 'rus') |
$output = &PrintQuestion($dbh, $Questions[$i], 1, $i + 1, 1); |
{ |
if (param('metod') eq 'rus') |
(@sar) = split(' ', $sstr); |
{ |
$shablon=join "|",@sar; |
$output=~s/\b($shablon)\b/\<strong\>$1\<\/strong\>/gi; |
|
} else { |
|
foreach (@sar) { |
|
$output =~ s/$_/<strong>$&<\/strong>/gs; |
|
}} |
|
print $output; |
|
} |
} |
|
PrintList($dbh,\@Questions,$shablon); |
} |
} |
|
|
sub PrintRandom { |
sub PrintRandom { |
Line 498 sub PrintRandom {
|
Line 713 sub PrintRandom {
|
for ($i = 0; $i <= $#Questions; $i++) { |
for ($i = 0; $i <= $#Questions; $i++) { |
# Passing DB handler, question ID, print answer, question |
# Passing DB handler, question ID, print answer, question |
# number, print title, print text/html |
# number, print title, print text/html |
$output .= |
$output .= |
&PrintQuestion($dbh, $Questions[$i], 1, $i + 1, 0, $text); |
&PrintQuestion($dbh, $Questions[$i], 1, $i + 1, 0, $text); |
} |
} |
return $output; |
return $output; |
} |
} |
|
|
sub PrintTournament { |
sub PrintTournament { |
Line 511 sub PrintTournament {
|
Line 726 sub PrintTournament {
|
my ($output) = ''; |
my ($output) = ''; |
|
|
%Tournament = &GetTournament($dbh, $Id) if ($Id); |
%Tournament = &GetTournament($dbh, $Id) if ($Id); |
|
|
my ($URL) = $Tournament{'URL'}; |
my ($URL) = $Tournament{'URL'}; |
my ($Info) = $Tournament{'Info'}; |
my ($Info) = $Tournament{'Info'}; |
my ($Copyright) = $Tournament{'Copyright'}; |
my ($Copyright) = $Tournament{'Copyright'}; |
Line 521 sub PrintTournament {
|
Line 736 sub PrintTournament {
|
if ($Id) { |
if ($Id) { |
for ($Tournament{'Type'}) { |
for ($Tournament{'Type'}) { |
/ç/ && do { |
/ç/ && do { |
$output .= h2({align=>"center"}, |
$output .= h2({align=>"center"}, |
"çÒÕÐÐÁ: $Tournament{'Title'} ", |
"çÒÕÐÐÁ: $Tournament{'Title'} ", |
"$Tournament{'PlayedAt'}") . p . "\n"; |
"$Tournament{'PlayedAt'}") . p . "\n"; |
last; |
last; |
Line 529 sub PrintTournament {
|
Line 744 sub PrintTournament {
|
/þ/ && do { |
/þ/ && do { |
return &PrintTour($dbh, $Tours[0], $answer) |
return &PrintTour($dbh, $Tours[0], $answer) |
if ($#Tours == 0); |
if ($#Tours == 0); |
|
|
my $title="ðÁËÅÔ: $Tournament{'Title'}"; |
my $title="ðÁËÅÔ: $Tournament{'Title'}"; |
if ($Tournament{'PlayedAt'}) { |
if ($Tournament{'PlayedAt'}) { |
$title .= " $Tournament{'PlayedAt'}"; |
$title .= " $Tournament{'PlayedAt'}"; |
} |
} |
|
|
$output .= h2({align=>"center"}, |
$output .= h2({align=>"center"}, |
"$title") . p . "\n"; |
"$title") . p . "\n"; |
last; |
last; |
}; |
}; |
Line 548 sub PrintTournament {
|
Line 763 sub PrintTournament {
|
$output .= h2("âÁÎË ÷ÏÐÒÏÓÏ×: $qnum ×ÏÐÒÏÓÏ×") . p . "\n"; |
$output .= h2("âÁÎË ÷ÏÐÒÏÓÏ×: $qnum ×ÏÐÒÏÓÏ×") . p . "\n"; |
} |
} |
|
|
for ($i = 0; $i <= $#Tours; $i++) { |
for ($i = 0; $i <= $#Tours; $i++) { |
%Tournament = &GetTournament($dbh, $Tours[$i]); |
%Tournament = &GetTournament($dbh, $Tours[$i]); |
|
|
if ($Tournament{'Type'} =~ /þ/) { |
if ($Tournament{'Type'} =~ /þ/) { |
$SingleTour = 0; |
$SingleTour = 0; |
my (@Tours) = &GetTours($dbh, $Tournament{'Id'}); |
my (@Tours) = &GetTours($dbh, $Tournament{'Id'}); |
Line 574 sub PrintTournament {
|
Line 789 sub PrintTournament {
|
if ($SingleTour or $Tournament{'Type'} =~ /ô/) { |
if ($SingleTour or $Tournament{'Type'} =~ /ô/) { |
$list .= dd(img({src=>$imgsrc, alt=>$alt}) |
$list .= dd(img({src=>$imgsrc, alt=>$alt}) |
. " " . $Tournament{'Title'} . " " . |
. " " . $Tournament{'Title'} . " " . |
$Tournament{'PlayedAt'} . $qnum) . |
$Tournament{'PlayedAt'} . $qnum) . |
dl( |
dl( |
dd("[" |
dd("[" |
. a({href=>url . "?tour=$Tournament{'Id'}&answer=0"}, |
. a({href=>url . "?tour=$Tournament{'Id'}&answer=0"}, |
Line 583 sub PrintTournament {
|
Line 798 sub PrintTournament {
|
"×ÏÐÒÏÓÙ + ÏÔ×ÅÔÙ") . "]") |
"×ÏÐÒÏÓÙ + ÏÔ×ÅÔÙ") . "]") |
); |
); |
} else { |
} else { |
$list .= dd(a({href=>url . "?tour=$Tournament{'Id'}&comp=1"}, |
$list .= dd(a({href=>url . "?tour=$Tournament{'Id'}&comp=1"}, |
img({src=>'/icons/compressed.gif', alt=>'[ZIP]', border=>1})) |
img({src=>'/icons/compressed.gif', alt=>'[ZIP]', border=>1})) |
. " " . img({src=>$imgsrc, alt=>$alt}) |
. " " . img({src=>$imgsrc, alt=>$alt}) |
. " " . a({href=>url . "?tour=$Tournament{'Id'}&answer=0"}, |
. " " . a({href=>url . "?tour=$Tournament{'Id'}&answer=0"}, |
$Tournament{'Title'}. " ". |
$Tournament{'Title'}. " ". |
$Tournament{'PlayedAt'}) . $qnum); |
$Tournament{'PlayedAt'}) . $qnum); |
} |
} |
} |
} |
Line 595 sub PrintTournament {
|
Line 810 sub PrintTournament {
|
|
|
if ($URL) { |
if ($URL) { |
$output .= |
$output .= |
p("äÏÐÏÌÎÉÔÅÌØÎÁÑ ÉÎÆÏÒÍÁÃÉÑ Ï ÜÔÏÍ ÔÕÒÎÉÒÅ - ÐÏ ÁÄÒÅÓÕ " . |
p("äÏÐÏÌÎÉÔÅÌØÎÁÑ ÉÎÆÏÒÍÁÃÉÑ Ï ÜÔÏÍ ÔÕÒÎÉÒÅ - ÐÏ ÁÄÒÅÓÕ " . |
a({-'href'=>$URL}, $URL)); |
a({-'href'=>$URL}, $URL)); |
} |
} |
|
|
Line 606 sub PrintTournament {
|
Line 821 sub PrintTournament {
|
if ($Info) { |
if ($Info) { |
$output .= p($Info); |
$output .= p($Info); |
} |
} |
|
|
return $output; |
return $output; |
} |
} |
|
|
Line 620 sub Suffix {
|
Line 835 sub Suffix {
|
|
|
sub IsTour { |
sub IsTour { |
my ($dbh, $Id) = @_; |
my ($dbh, $Id) = @_; |
my ($sth) = $dbh->prepare("SELECT Type FROM Tournaments |
my ($sth) = $dbh->prepare("SELECT Type FROM Tournaments |
WHERE Id=$Id"); |
WHERE Id=$Id"); |
$sth->execute; |
$sth->execute; |
return ($sth->fetchrow)[0] =~ /ô/; |
return ($sth->fetchrow)[0] =~ /ô/; |
Line 640 sub PrintTour {
|
Line 855 sub PrintTour {
|
if ($Tour{'Type'} !~ /ô/); |
if ($Tour{'Type'} !~ /ô/); |
|
|
my ($qnum) = $Tour{'QuestionsNum'}; |
my ($qnum) = $Tour{'QuestionsNum'}; |
my ($suffix) = &Suffix($qnum); |
my ($suffix) = &Suffix($qnum); |
|
|
$output .= h2({align=>"center"}, $Tournament{"Title"}, |
$output .= h2({align=>"center"}, $Tournament{"Title"}, |
$Tournament{'PlayedAt'}, |
$Tournament{'PlayedAt'}, |
"<br>", $Tour{"Title"} . |
"<br>", $Tour{"Title"} . |
" ($qnum ×ÏÐÒÏÓ$suffix)\n") . p; |
" ($qnum ×ÏÐÒÏÓ$suffix)\n") . p; |
|
|
my (@Questions) = &GetTourQuestions($dbh, $Id); |
my (@Questions) = &GetTourQuestions($dbh, $Id); |
for ($q = 0; $q <= $#Questions; $q++) { |
for ($q = 0; $q <= $#Questions; $q++) { |
$output .= &PrintQuestion($dbh, $Questions[$q], $answer, 0); |
$output .= &PrintQuestion($dbh, $Questions[$q], $answer, 0); |
} |
} |
|
|
$output .= hr({-'align'=>'center', -'width'=>'80%'}); |
$output .= hr({-'align'=>'center', -'width'=>'80%'}); |
|
|
if ($Tournament{'URL'}) { |
if ($Tournament{'URL'}) { |
$output .= |
$output .= |
p("äÏÐÏÌÎÉÔÅÌØÎÁÑ ÉÎÆÏÒÍÁÃÉÑ Ï ÜÔÏÍ ÔÕÒÎÉÒÅ - ÐÏ ÁÄÒÅÓÕ " . |
p("äÏÐÏÌÎÉÔÅÌØÎÁÑ ÉÎÆÏÒÍÁÃÉÑ Ï ÜÔÏÍ ÔÕÒÎÉÒÅ - ÐÏ ÁÄÒÅÓÕ " . |
a({-'href'=>$Tournament{'URL'}}, $Tournament{'URL'})); |
a({-'href'=>$Tournament{'URL'}}, $Tournament{'URL'})); |
} |
} |
|
|
Line 667 sub PrintTour {
|
Line 882 sub PrintTour {
|
if ($Tournament{'Info'}) { |
if ($Tournament{'Info'}) { |
$output .= p($Tournament{'Info'}); |
$output .= p($Tournament{'Info'}); |
} |
} |
|
|
|
|
if ($answer == 0) { |
if ($answer == 0) { |
$bottom .= |
$bottom .= |
"[" . a({href=>url . "?tour=$Id&answer=1"}, "ÏÔ×ÅÔÙ") . "] " . br; |
"[" . a({href=>url . "?tour=$Id&answer=1"}, "ÏÔ×ÅÔÙ") . "] " . br; |
} |
} |
if (&IsTour($dbh, $Id - 1)) { |
if (&IsTour($dbh, $Id - 1)) { |
$bottom .= |
$bottom .= |
"[" . a({href=>url . "?tour=" . ($Id - 1) . "&answer=0"}, |
"[" . a({href=>url . "?tour=" . ($Id - 1) . "&answer=0"}, |
"ÐÒÅÄÙÄÕÝÉÊ ÔÕÒ") . "] "; |
"ÐÒÅÄÙÄÕÝÉÊ ÔÕÒ") . "] "; |
$bottom .= |
$bottom .= |
"[" . a({href=>url . "?tour=" . ($Id - 1) . "&answer=1"}, |
"[" . a({href=>url . "?tour=" . ($Id - 1) . "&answer=1"}, |
"ÐÒÅÄÙÄÕÝÉÊ ÔÕÒ Ó ÏÔ×ÅÔÁÍÉ") . "] " . br; |
"ÐÒÅÄÙÄÕÝÉÊ ÔÕÒ Ó ÏÔ×ÅÔÁÍÉ") . "] " . br; |
} |
} |
if (&IsTour($dbh, $Id + 1)) { |
if (&IsTour($dbh, $Id + 1)) { |
$bottom .= |
$bottom .= |
"[" . a({href=>url . "?tour=" . ($Id + 1) . "&answer=0"}, |
"[" . a({href=>url . "?tour=" . ($Id + 1) . "&answer=0"}, |
"ÓÌÅÄÕÀÝÉÊ ÔÕÒ") . "] "; |
"ÓÌÅÄÕÀÝÉÊ ÔÕÒ") . "] "; |
$bottom .= |
$bottom .= |
"[" . a({href=>url . "?tour=" . ($Id + 1) . "&answer=1"}, |
"[" . a({href=>url . "?tour=" . ($Id + 1) . "&answer=1"}, |
"ÓÌÅÄÕÀÝÉÊ ÔÕÒ Ó ÏÔ×ÅÔÁÍÉ") . "] "; |
"ÓÌÅÄÕÀÝÉÊ ÔÕÒ Ó ÏÔ×ÅÔÁÍÉ") . "] "; |
} |
} |
|
|
Line 705 sub PrintField {
|
Line 920 sub PrintField {
|
$value =~ s/^\|([^\n]*)/<pre>$1<\/pre>/mg; |
$value =~ s/^\|([^\n]*)/<pre>$1<\/pre>/mg; |
} |
} |
|
|
return $text ? "$header:\n$value\n\n" : |
return $text ? "$header:\n$value\n\n" : |
strong("$header: ") . $value . p . "\n"; |
strong("$header: ") . $value . p . "\n"; |
} |
} |
|
|
# Gets a DB handler (ofcourse) and a question Id. Prints |
# Gets a DB handler (ofcourse) and a question Id. Prints |
# that question, according to the options. |
# that question, according to the options. |
sub PrintQuestion { |
sub PrintQuestion { |
my ($dbh, $Id, $answer, $qnum, $title, $text) = @_; |
my ($dbh, $Id, $answer, $qnum, $title, $text) = @_; |
my ($output, $titles) = ('', ''); |
my ($output, $titles) = ('', ''); |
|
|
my (%Question) = &GetQuestion($dbh, $Id); |
my (%Question) = &GetQuestion($dbh, $Id); |
if (!$text) { |
if (!$text) { |
$output .= hr({width=>"50%"}); |
$output .= hr({width=>"50%"}); |
Line 730 sub PrintQuestion {
|
Line 944 sub PrintQuestion {
|
} |
} |
$output .= dl(strong($titles)); |
$output .= dl(strong($titles)); |
} |
} |
|
|
$qnum = $Question{'Number'} |
$qnum = $Question{'Number'} |
if ($qnum == 0); |
if ($qnum == 0); |
|
|
$output .= |
$output .= |
&PrintField("÷ÏÐÒÏÓ $qnum", $Question{'Question'}, $text); |
&PrintField("÷ÏÐÒÏÓ $qnum", $Question{'Question'}, $text); |
|
|
if ($answer) { |
if ($answer) { |
$output .= |
$output .= |
&PrintField("ïÔ×ÅÔ", $Question{'Answer'}, $text); |
&PrintField("ïÔ×ÅÔ", $Question{'Answer'}, $text); |
|
|
if ($Question{'Authors'}) { |
if ($Question{'Authors'}) { |
Line 752 sub PrintQuestion {
|
Line 966 sub PrintQuestion {
|
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; |
# $other.=a({href=>url."?qofauthor=$AuthorId"},"$Name $Surname").". "; |
|
$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)"; |
$Nicks=~s/^\|//; |
if ($Nicks) |
foreach (split /\|/, $Nicks) |
|
{ |
{ |
|
$Nicks=~s/^\|//; |
|
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; |
} |
} |
Line 781 sub PrintQuestion {
|
Line 997 sub PrintQuestion {
|
$output .= &PrintField("ëÏÍÍÅÎÔÁÒÉÉ", $Question{'Comments'}, $text); |
$output .= &PrintField("ëÏÍÍÅÎÔÁÒÉÉ", $Question{'Comments'}, $text); |
} |
} |
} |
} |
|
$output.=br.a({href=> url."?metod=proxy&qid=$Id"}, 'âÌÉÚËÉÅ ×ÏÐÒÏÓÙ').p |
|
if $answer; |
return $output; |
return $output; |
} |
} |
|
|
Line 805 sub Get12Random {
|
Line 1023 sub Get12Random {
|
my ($qnum) = &GetMaxQId($dbh); |
my ($qnum) = &GetMaxQId($dbh); |
my (%chosen); |
my (%chosen); |
srand; |
srand; |
|
|
for ($i = 0; $i < $num; $i++) { |
for ($i = 0; $i < $num; $i++) { |
do { |
do { |
$q = int(rand($qnum)); |
$q = int(rand($qnum)); |
Line 825 sub Include_virtual {
|
Line 1043 sub Include_virtual {
|
|
|
open F , $fn |
open F , $fn |
or return; #die "Can't open the file $fn: $!\n"; |
or return; #die "Can't open the file $fn: $!\n"; |
|
|
while (<F>) { |
while (<F>) { |
if (/<!--#include/o) { |
if (/<!--#include/o) { |
s/<!--#include virtual="\/(.*)" -->/&Include_virtual($1)/e; |
s/<!--#include virtual="\/(.*)" -->/&Include_virtual($1)/e; |
Line 844 sub PrintArchive {
|
Line 1062 sub PrintArchive {
|
|
|
my (%Tournament) = &GetTournament($dbh, $Id); |
my (%Tournament) = &GetTournament($dbh, $Id); |
my (@Tours) = &GetTours($dbh, $Id); |
my (@Tours) = &GetTours($dbh, $Id); |
|
|
if ($Tournament{'Type'} =~ /ç/ || $Id == 0) { |
if ($Tournament{'Type'} =~ /ç/ || $Id == 0) { |
for ($i = 0; $i <= $#Tours; $i++) { |
for ($i = 0; $i <= $#Tours; $i++) { |
push(@list ,&PrintArchive($dbh, $Tours[$i])); |
push(@list ,&PrintArchive($dbh, $Tours[$i])); |
Line 860 sub PrintAll {
|
Line 1078 sub PrintAll {
|
|
|
my (%Tournament) = &GetTournament($dbh, $Id); |
my (%Tournament) = &GetTournament($dbh, $Id); |
my (@Tours) = &GetTours($dbh, $Id); |
my (@Tours) = &GetTours($dbh, $Id); |
my ($New) = ($Id and $Tournament{'Type'} eq 'þ' and |
my ($New) = ($Id and $Tournament{'Type'} eq 'þ' and |
&NewEnough($Tournament{"CreatedAt"})) ? |
&NewEnough($Tournament{"CreatedAt"})) ? |
img({src=>"/znatoki/dimrub/db/new-sml.gif", alt=>"NEW!"}) : ""; |
img({src=>"/znatoki/dimrub/db/new-sml.gif", alt=>"NEW!"}) : ""; |
|
|
Line 882 sub PrintAll {
|
Line 1100 sub PrintAll {
|
|
|
sub PrintDates { |
sub PrintDates { |
my ($dbh) = @_; |
my ($dbh) = @_; |
my ($from) = param('from_year') . "-" . param('from_month') . |
my ($from) = param('from_year') . "-" . param('from_month') . |
"-" . param('from_day'); |
"-" . param('from_day'); |
my ($to) = param('to_year') . "-" . param('to_month') . "-" . param('to_day'); |
my ($to) = param('to_year') . "-" . param('to_month') . "-" . param('to_day'); |
$from = $dbh->quote($from); |
$from = $dbh->quote($from); |
Line 911 sub PrintDates {
|
Line 1129 sub PrintDates {
|
|
|
sub PrintQOfAuthor |
sub PrintQOfAuthor |
{ |
{ |
|
|
my ($dbh, $id) = @_; |
my ($dbh, $id) = @_; |
$id=$dbh->quote($id); |
$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; |
|
|
$sth = $dbh->prepare("SELECT Question FROM A2Q WHERE Author=$id"); |
$sth = $dbh->prepare("SELECT Question FROM A2Q WHERE Author=$id"); |
$sth->execute; |
$sth->execute; |
my $q; |
my $q; |
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}} |
|
|
Line 931 sub PrintQOfAuthor
|
Line 1150 sub PrintQOfAuthor
|
} elsif ($hits =~ /1$/) { |
} elsif ($hits =~ /1$/) { |
$suffix = 'Å'; |
$suffix = 'Å'; |
} else { |
} else { |
$suffix = 'Ñ'; |
$suffix = 'Ñ'; |
} |
} |
|
print h2("ðÏÉÓË × ÂÁÚÅ ×ÏÐÒÏÓÏ×"); |
print p({align=>"center"}, "á×ÔÏÒ ".strong("$name $surname. ") |
print printform; |
|
print p({align=>"center"}, "á×ÔÏÒ ".strong("$name $surname. ") |
. " : $hits ÐÏÐÁÄÁÎÉ$suffix."); |
. " : $hits ÐÏÐÁÄÁÎÉ$suffix."); |
|
|
|
|
for ($i = 0; $i <= $#Questions; $i++) { |
# for ($i = 0; $i <= $#Questions; $i++) { |
$output = &PrintQuestion($dbh, $Questions[$i], 1, $i + 1, 1); |
# $output = &PrintQuestion($dbh, $Questions[$i], 1, $i + 1, 1); |
print $output; |
# print $output; |
} |
# } |
|
PrintList($dbh,\@Questions,'gdfgdfgdfgdfg'); |
} |
} |
|
|
|
|
Line 949 sub PrintAuthors
|
Line 1170 sub PrintAuthors
|
{ |
{ |
my ($dbh,$sort)=@_; |
my ($dbh,$sort)=@_; |
my($output,$out1,@array,$sth); |
my($output,$out1,@array,$sth); |
if ($sort eq 'surname') |
if ($sort eq 'surname') |
|
{ |
|
$sth = |
|
$dbh->prepare("SELECT Id, Name, Surname, QNumber FROM Authors order by Surname, Name"); |
|
} |
|
elsif($sort eq 'name') |
{ |
{ |
$sth = |
$sth = |
$dbh->prepare("SELECT Id, Name, Surname, QNumber FROM Authors order by Surname"); |
$dbh->prepare("SELECT Id, Name, Surname, QNumber FROM Authors order by Name, Surname"); |
|
|
$output.="<TABLE><CAPTION>áÌÆÁ×ÉÔÎÙÊ ÓÐÉÓÏË Á×ÔÏÒÏ×</CAPTION>"; |
|
} |
} |
else |
else |
{ |
{ |
$sth = |
$sth = |
$dbh->prepare("SELECT Id, Name, Surname, QNumber FROM Authors Order by QNumber DESC"); |
$dbh->prepare("SELECT Id, Name, Surname, QNumber FROM Authors Order by QNumber DESC, Surname"); |
$output.="<TABLE>"; |
|
} |
} |
|
|
|
$output.=h2("á×ÔÏÒÙ ×ÏÐÒÏÓÏ×")."\n"; |
|
$output.="<TABLE>"; |
|
|
|
|
$sth->execute; |
$sth->execute; |
$output.=Tr(th["æÁÍÉÌÉÑ, ÉÍÑ", "ëÏÌÉÞÅÓÔ×Ï ×ÏÐÒÏÓÏ×"]); |
$output.=Tr(th[a({href=>url."?authors=name"},"éÍÑ") |
|
.", ". |
|
a({href=>url."?authors=surname"},"ÆÁÍÉÌÉÑ") |
|
, a({href=>url."?authors=kvo"},"ëÏÌÉÞÅÓÔ×Ï ×ÏÐÒÏÓÏ×")]); |
|
|
$out1=''; |
$out1=''; |
|
|
my $ar=$sth->fetchall_arrayref; |
my $ar=$sth->fetchall_arrayref; |
|
|
|
|
=head |
|
foreach my $arr(@$ar) |
|
{ |
|
$sth = |
|
$dbh->prepare("SELECT count(*) FROM A2Q where Author=".$$arr[0]); |
|
$sth->execute; |
|
|
|
my ($kvo)=$sth->fetchrow; |
|
|
|
|
|
|
|
push @$arr, $kvo; |
|
} |
|
|
|
=cut |
|
|
|
|
|
# sort { }@{$ar} |
|
|
|
foreach my $arr(@$ar) |
foreach my $arr(@$ar) |
{ |
{ |
|
|
my ($id,$name,$surname,$kvo)=@$arr; |
my ($id,$name,$surname,$kvo)=@$arr; |
if (!$name || !$surname) {print "Opanki at $id\n"} else |
if (!$name || !$surname) {#print "Opanki at $id\n" |
|
} else |
{ |
{ |
print "!"; |
my $add=Tr(td([a({href=>url."?qofauthor=$id"},"$name $surname"), $kvo]))."\n"; |
|
|
my $add=Tr(td([a({href=>"/cgi-bin/db.cgi?qofauthor=$id"},'[Q] ')."$name $surname", $kvo]))."\n"; |
|
print STDERR $add; |
print STDERR $add; |
$output.=$add; |
$output.=$add; |
} |
} |
Line 1008 sub PrintAuthors
|
Line 1219 sub PrintAuthors
|
} |
} |
|
|
|
|
|
|
MAIN: |
MAIN: |
{ |
{ |
setlocale(LC_CTYPE,'russian'); |
setlocale(LC_CTYPE,'russian'); |
Line 1032 MAIN:
|
Line 1243 MAIN:
|
print &Include_virtual("../dimrub/db/reklama.html"); |
print &Include_virtual("../dimrub/db/reklama.html"); |
} |
} |
|
|
|
|
if ($^O =~ /win/i) { |
if ($^O =~ /win/i) { |
$thislocale = "Russian_Russia.20866"; |
$thislocale = "Russian_Russia.20866"; |
} else { |
} else { |
Line 1046 if ((uc 'Á') ne 'á') {print "Koi8-r loca
|
Line 1258 if ((uc 'Á') ne 'á') {print "Koi8-r loca
|
print header('text/plain'); |
print header('text/plain'); |
} |
} |
|
|
if (param('showequal')) { |
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; |
while ( my ($first, $second)=$sth -> fetchrow) |
while ( my ($first, $second)=$sth -> fetchrow) |
Line 1054 if ((uc 'Á') ne 'á') {print "Koi8-r loca
|
Line 1266 if ((uc 'Á') ne 'á') {print "Koi8-r loca
|
$forbidden{$first}=1; |
$forbidden{$first}=1; |
} |
} |
$sth->finish; |
$sth->finish; |
} |
} |
|
|
|
|
if (param('rand')) { |
if (param('rand')) { |
my ($type, $qnum) = ('', 12); |
my ($type, $qnum) = ('', 12); |
$type .= 'â' if (param('brain')); |
$type .= 'â' if (param('brain')); |
$type .= 'þ' if (param('chgk')); |
$type .= 'þ' if (param('chgk')); |
$qnum = param('qnum') if (param('qnum') =~ /^\d+$/); |
$qnum = param('qnum') if (param('qnum') =~ /^\d+$/); |
$qnum = 0 if (!$type); |
$qnum = 0 if (!$type); |
if (param('email') && -x $SENDMAIL && |
if (param('email') && -x $SENDMAIL && |
open(F, "| $SENDMAIL -t -n")) { |
open(F, "| $SENDMAIL -t -n")) { |
my ($Email) = param('email'); |
my ($Email) = param('email'); |
my ($mime_type) = $text ? "plain" : "html"; |
my ($mime_type) = $text ? "plain" : "html"; |
Line 1082 EOT
|
Line 1294 EOT
|
} else { |
} else { |
print &PrintRandom($dbh, $type, $qnum, $text); |
print &PrintRandom($dbh, $type, $qnum, $text); |
} |
} |
} |
} |
elsif (param('authors')){ |
elsif (param('authors')){ |
print &PrintAuthors($dbh,param('authors')); |
print &PrintAuthors($dbh,param('authors')); |
} |
} |
Line 1091 EOT
|
Line 1303 EOT
|
} |
} |
elsif (param('sstr')) { |
elsif (param('sstr')) { |
&PrintSearch($dbh, param('sstr'), param('metod')); |
&PrintSearch($dbh, param('sstr'), param('metod')); |
} elsif (param('all')) { |
} |
|
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; |
|
$searchin{'Question'}=1; |
|
$searchin{'Answer'}=1; |
|
$sstr=~tr/£³/Åå/; |
|
$sstr=~s/[^ÊÃÕËÅÎÇÛÝÚÈßÆÙ×ÁÐÒÏÌÄÖÜÑÞÓÍÉÔØÂÀêãõëåîçûýúèÿæù÷áðòïìäöüñþóíéôøâàa-zA-Z0-9]/ /gi; |
|
# print &PrintQuestion($dbh,$qid, 1, '!'); |
|
&PrintSearch($dbh, $sstr, 'proxy'); |
|
} |
|
|
|
elsif (param('all')) { |
print &PrintAll($dbh, 0); |
print &PrintAll($dbh, 0); |
} elsif (param('from_year') && param('to_year')) { |
} elsif (param('from_year') && param('to_year')) { |
print &PrintDates($dbh); |
print &PrintDates($dbh); |
} elsif (param('comp')) { |
} elsif (param('comp')) { |
print header( |
print header( |
-'Content-Type' => 'application/x-zip-compressed; name="db.zip"', |
-'Content-Type' => 'application/x-zip-compressed; name="db.zip"', |