version 1.137, 2004/11/08 02:23:18
|
version 1.155, 2010/01/10 17:49:00
|
Line 3
|
Line 3
|
use DBI; |
use DBI; |
use CGI ':all'; |
use CGI ':all'; |
#use strict; |
#use strict; |
|
use Encode; |
my @softfields=("От Олега Степанова"); |
my @softfields=("От Олега Степанова"); |
use Time::Local; |
use Time::Local; |
|
use Data::Dumper "Dumper"; |
|
use URI::Escape; |
my $proxyredirect=1; |
my $proxyredirect=1; |
use POSIX qw(locale_h); |
use POSIX qw(locale_h); |
use locale; |
use locale; |
Line 13 use Getopt::Std;
|
Line 16 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=(); |
|
my $showNearQuestions=0; |
$dbuser||="piataev"; |
$dbuser||="piataev"; |
$dbname||="chgk"; |
$dbname||="chgk"; |
$dbpass||=""; |
$dbpass||=""; |
Line 43 if ($^O =~ /win/i) {
|
Line 48 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 71 $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\// && $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 134 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 209 sub fetchquestion {
|
Line 214 sub fetchquestion {
|
if ($WithTour) { |
if ($WithTour) { |
($$q{'QuestionId'}, $$q{'Question'},$$q{'Answer'},$$q{'PassCriteria'},$$q{'Comments'},$$q{'Authors'},$$q{'Sources'}, |
($$q{'QuestionId'}, $$q{'Question'},$$q{'Answer'},$$q{'PassCriteria'},$$q{'Comments'},$$q{'Authors'},$$q{'Sources'}, |
$$q{'Number'}, |
$$q{'Number'}, |
$$q{'Title'}, $$q{'TourTitle'}, $$q{'FileName'},$$q{'PlayedAt'},$$q{'TourNumber'}) = |
$$q{'Title'}, $$q{'TourTitle'}, $$q{'FileName'},$$q{'PlayedAt'},$$q{'TourNumber'},$$q{'PlayedAt2'}) = |
$sth->fetchrow; |
$sth->fetchrow; |
} else { |
} else { |
($$q{'QuestionId'}, $$q{'Question'},$$q{'Answer'},$$q{'PassCriteria'},$$q{'Comments'},$$q{'Authors'},$$q{'Sources'}, |
($$q{'QuestionId'}, $$q{'Question'},$$q{'Answer'},$$q{'PassCriteria'},$$q{'Comments'},$$q{'Authors'},$$q{'Sources'}, |
Line 236 sub SelectQuestions {
|
Line 241 sub SelectQuestions {
|
if ($WithTour) { |
if ($WithTour) { |
$query="SELECT QuestionId, Questions.Question, Answer, PassCriteria, Comments, Authors, Sources, |
$query="SELECT QuestionId, Questions.Question, Answer, PassCriteria, Comments, Authors, Sources, |
Questions.Number |
Questions.Number |
, t2.Title, t1.Title, t2.FileName, t2.PlayedAt,t1.Number |
, t2.Title, t1.Title, t2.FileName, t2.PlayedAt,t1.Number,t2.PlayedAt2 |
from Questions,Tournaments as t1, Tournaments as t2 |
from Questions,Tournaments as t1, Tournaments as t2 |
WHERE $where"; |
WHERE $where"; |
} else { |
} else { |
Line 278 sub tourhref {
|
Line 283 sub tourhref {
|
my $res; |
my $res; |
if ($usehtml) { |
if ($usehtml) { |
$res=$t; |
$res=$t; |
|
$res=~s/\-q$//; |
|
$res=~s/\-a$//; |
$res.=$a?"-a":"-q" unless $gr; |
$res.=$a?"-a":"-q" unless $gr; |
$res.=".html"; |
$res.=".html"; |
$res=~s/(\#\d+)(.*)$/$2$1/; |
$res=~s/(\#\d+)(.*)$/$2$1/; |
my $t=$res; |
my $t=$res; |
$t=~s/\#.*$//; |
$t=~s/\#.*$//; |
$res=~s/\.1// unless -e "$realHTMLDIR$t"; |
# $res=~s/\.1// unless $gr ||$res=~/\.\d+$/;#-e "$realHTMLDIR$t"; |
$t=$res; |
$t=$res; |
$t=~s/\#.*$//; |
$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; |
$res="$HTMLDIR$res" unless $opt_z; |
return $res; |
return $res; |
} else { |
} else { |
Line 378 sub printform
|
Line 385 sub printform
|
return |
return |
<<EOT |
<<EOT |
<form method="get" enctype="application/x-www-form-urlencoded" |
<form method="get" enctype="application/x-www-form-urlencoded" |
action="/znatoki/cgi-bin/db.cgi"> |
action="/cgi-bin/db.cgi"> |
<h2>Поиск в базе вопросов</h2> |
<h2>Поиск в базе вопросов</h2> |
|
|
<input type="text" name="sstr" value="$sstr" size="30" maxlength="50"> |
<input type="text" name="sstr" value="$sstr" size="30" maxlength="50"> |
Line 432 action="/znatoki/cgi-bin/db.cgi">
|
Line 439 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 507 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 576 $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 698 sub Search {
|
Line 717 sub Search {
|
my (@sar, $i, $sth,$where,$query); |
my (@sar, $i, $sth,$where,$query); |
if ($metod eq 'rus') |
if ($metod eq 'rus') |
{ |
{ |
my @tasks=russearch($dbh,$sstr,$all,$allnf); |
my @tasks; |
|
@tasks = russearch($dbh,$sstr,$all,$allnf); |
|
|
|
|
return @tasks |
return @tasks |
} |
} |
elsif ($metod eq 'proxy') |
elsif ($metod eq 'proxy') |
Line 891 sub PrintList {
|
Line 913 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; |
$output=~s/($shablon)/\<strong\>$1\<\/strong\>/gi; |
$output=~s/($shablon)/\<strong\>$1\<\/strong\>/gi; |
|
$output=~s/(href="[^"]*?)(?:<.*?>)+([^"]*?)(?:<\/.*?>)+([^"]*?")/!1 $1$2$3 2!/g;#!!!! |
} |
} |
|
|
$Output.= $output; |
$Output.= $output; |
} |
} |
$sth->finish; |
$sth->finish; |
Line 938 sub PrintSearch {
|
Line 962 sub PrintSearch {
|
} |
} |
while (--$ss && (!$dbh->do ("insert into lastqueries (id,sstr,questions,allnf) |
while (--$ss && (!$dbh->do ("insert into lastqueries (id,sstr,questions,allnf) |
values ($was, $qsstr,$tmp,$nf)"))); |
values ($was, $qsstr,$tmp,$nf)"))); |
$Output.= "Something is wrong...".br unless $ss; |
$Output.= "Something is wrong...".br."\n" unless $ss; |
} |
} |
} |
} |
|
|
|
|
|
|
$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 1071 sub PrintTournament {
|
Line 1097 sub PrintTournament {
|
/Г/ && do { |
/Г/ && do { |
$output .= h2({align=>"center"}, |
$output .= h2({align=>"center"}, |
"Группа: $Tournament{'Title'} ", |
"Группа: $Tournament{'Title'} ", |
$Tournament{'PlayedAt'}||'') . p . "\n"; |
$Tournament{'PlayedAt'}||'') . |
|
($Tournament{'PlayedAt2'}?' – '. |
|
$Tournament{'PlayedAt2'}:'') . |
|
|
|
p . "\n"; |
last; |
last; |
}; |
}; |
/Ч/ && do { |
/Ч/ && do { |
Line 1083 sub PrintTournament {
|
Line 1113 sub PrintTournament {
|
$title .= " $Tournament{'PlayedAt'}"; |
$title .= " $Tournament{'PlayedAt'}"; |
} |
} |
|
|
|
if ($Tournament{'PlayedAt2'}) { |
|
$title .= ' – '.$Tournament{'PlayedAt2'}; |
|
} |
|
|
$output .= h2({align=>"center"}, |
$output .= h2({align=>"center"}, |
"$title") . p . "\n"; |
"$title") . p . "\n"; |
$output.=&PrintEditor(\%Tournament); |
$output.=&PrintEditor(\%Tournament); |
Line 1149 sub PrintTournament {
|
Line 1183 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'}||"") . |
|
($Tournament{'PlayedAt2'}?' – '.$Tournament{'PlayedAt2'}:"") . |
|
$qnum) . |
dl( |
dl( |
dd("[" |
dd("[" |
. a({href=>tourhref($textid,0)}, |
. a({href=>tourhref($textid,0)}, |
Line 1165 sub PrintTournament {
|
Line 1201 sub PrintTournament {
|
img({src=>$imgsrc, alt=>$alt}) |
img({src=>$imgsrc, alt=>$alt}) |
. " " . a({href=>tourhref($textid,0,1)}, |
. " " . a({href=>tourhref($textid,0,1)}, |
$Tournament{'Title'}. " ". |
$Tournament{'Title'}. " ". |
($Tournament{'PlayedAt'}||'')) . $qnum); |
($Tournament{'PlayedAt'}||'')) . |
|
($Tournament{'PlayedAt2'}?' &ndash '. $Tournament{'PlayedAt2'}:''). $qnum); |
} |
} |
} |
} |
$output .= dl($list); |
$output .= dl($list); |
Line 1176 sub PrintTournament {
|
Line 1213 sub PrintTournament {
|
p("Дополнительная информация об этом турнире - по адресу " . |
p("Дополнительная информация об этом турнире - по адресу " . |
a({-'href'=>$URL}, $URL)); |
a({-'href'=>$URL}, $URL)); |
} |
} |
|
|
if ($Copyright) { |
if ($Copyright) { |
$output .= p("Копирайт: " . $Copyright); |
$output .= p("Копирайт: " . $Copyright); |
} |
} |
Line 1186 sub PrintTournament {
|
Line 1222 sub PrintTournament {
|
if ($Info) { |
if ($Info) { |
$output .= p($Info); |
$output .= p($Info); |
} |
} |
|
|
|
$output.=p("<a href='/dbxml.php?tour=".param('tour')."'>XML</a>"); |
|
|
|
|
return $output; |
return $output; |
} |
} |
|
|
Line 1255 sub PrintTour {
|
Line 1295 sub PrintTour {
|
|
|
$output .= h2({align=>"center"}, $Tournament{"Title"}, |
$output .= h2({align=>"center"}, $Tournament{"Title"}, |
$Tournament{'PlayedAt'}||'', |
$Tournament{'PlayedAt'}||'', |
"<br>", $Tour{"Title"} . |
$Tournament{'PlayedAt2'}?' – '.$Tournament{'PlayedAt2'}:'', |
|
"<br>\n", $Tour{"Title"} . |
" ($qnum вопрос$suffix)\n") . p; |
" ($qnum вопрос$suffix)\n") . p; |
$output .=&PrintEditor(\%Tour); |
$output .=&PrintEditor(\%Tour); |
|
|
Line 1263 sub PrintTour {
|
Line 1304 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%'}); |
|
|
if ($Tournament{'URL'}) { |
if ($Tournament{'URL'}) { |
$output .= |
$URL = $Tournament{'URL'}; |
p("Дополнительная информация об этом турнире - по адресу " . |
$URL=~s/http:\/znatoki\/boris\/reports\//$newsurl/ if $url=~/kulichki/ || $url=~/db.chgk.info/; |
a({-'href'=>$Tournament{'URL'}}, $Tournament{'URL'})); |
$URL=~s/\/znatoki\/boris\/reports\//$newsurl/ if url=~/kulichki/ || $url=~/db.chgk.info/; |
|
|
|
$output .= |
|
p("Дополнительная информация об этом турнире - по адресу " . |
|
a({-'href'=>$URL}, $URL)); |
} |
} |
|
|
if ($Tournament{'Copyright'}) { |
if ($Tournament{'Copyright'}) { |
$output .= p("Копирайт: " . $Tournament{'Copyright'}); |
$output .= p("Копирайт: " . $Tournament{'Copyright'}); |
} |
} |
|
|
if ($Tournament{'Info'}) { |
if ($Tournament{'Info'} ) { |
$output .= p($Tournament{'Info'}); |
$output .= p($Tournament{'Info'}); |
} |
} |
|
|
|
if ($Tour{'Info'} && ($Tournament{'Info'} ne $Tour{'Info'})) { |
|
$output .= "!!".p($Tour{'Info'}); |
|
} |
|
|
|
$output.=p("<a href='/dbxml.php?tour=".param('tour')."'>XML</a>"); |
|
|
my $n=$Tour{'Number'}; |
my $n=$Tour{'Number'}; |
if ($answer == 0) { |
if ($answer == 0) { |
my $nn=".$n"; |
my $nn=".$n"; |
Line 1289 sub PrintTour {
|
Line 1340 sub PrintTour {
|
|
|
$bottom .= |
$bottom .= |
"[" . a({href=>tourhref("$fname$nn",1)}, |
"[" . a({href=>tourhref("$fname$nn",1)}, |
"ответы") . "] " . br; |
"ответы") . "] " . br."\n"; |
} |
} |
if ($n>1) { |
if ($n>1) { |
$bottom .= |
$bottom .= |
Line 1297 sub PrintTour {
|
Line 1348 sub PrintTour {
|
"предыдущий тур") . "] "; |
"предыдущий тур") . "] "; |
$bottom .= |
$bottom .= |
"[" . a({href=>tourhref("$fname.".($n-1),1)}, |
"[" . a({href=>tourhref("$fname.".($n-1),1)}, |
"предыдущий тур с ответами") . "] " . br; |
"предыдущий тур с ответами") . "] " . br."\n"; |
} |
} |
if (&IsTour($dbh, $Tour{'ParentId'}, $n + 1)) { |
if (&IsTour($dbh, $Tour{'ParentId'}, $n + 1)) { |
$bottom .= |
$bottom .= |
Line 1314 sub PrintTour {
|
Line 1365 sub PrintTour {
|
return $output; |
return $output; |
} |
} |
|
|
|
|
|
sub escapeUrl { |
|
my $uri = shift; |
|
$uri=~s/<.*?>//g; |
|
$uri =~ s/([Ю-Ъю-ъ]+)/URI::Escape::uri_escape_utf8(decode("koi8-r",$1))/eg; |
|
return $uri; |
|
} |
|
|
sub PrintField { |
sub PrintField { |
my ($header, $value, $text) = @_; |
my ($header, $value, $text) = @_; |
if ($text) { |
if ($text) { |
Line 1321 sub PrintField {
|
Line 1380 sub PrintField {
|
} else { |
} else { |
if ($header=~/Комментар/) |
if ($header=~/Комментар/) |
{ |
{ |
$value=~s/^\s*$_[\.:]/p."\n".strong("$_").":"/me foreach @softfields; |
$value=~s/^\s*$_[\.:]/p."\n".strong("$_").":\n"/me foreach @softfields; |
} |
} |
|
|
$value =~ s/^\s+/<br> /mg; |
$value =~ s/^\s+/<br>\n /mg; |
$value =~ s/(\s+)-+(\s+)/$1–$2/mg; |
$value =~ s/(\s+)-+(\s+)/$1–$2/mg; |
$value =~ s/\s+\–/ \–/mg |
$value =~ s/\s+\–/ \–/mg |
if $value !~ /^\|/; |
if $value !~ /^\|/; |
$value =~ s/^\|([^\n]*)/<pre>$1<\/pre>/mg; |
$value =~ s/^\|([^\n]*)/<pre>$1<\/pre>/mg; |
$value =~ s/(http:\/\/\S+[^\s\)\(\,\.])/<a href="$1">$1<\/a>/g if $header !~ /^Авто/; |
|
|
$value =~ s/(http:\/\/\S+[^\s\)\(\,\.])/a({href=>escapeUrl($1)},$1)/egm if $header !~ /^Авто/;#!!! |
|
|
|
$value =~ s/\[Раздаточный материал:(.*?)\]\s*$/<div class='razdatka'><div class='razdatka_header'>Раздаточный материал<\/div> $1<\/div>\n/sm; |
|
|
|
|
|
# $value =~ s/(http:\/\/\S+[^\s\)\(\,\.])/make/eg if $header !~ /^Авто/;#!!! |
|
# $value =~ s/(http:\/\/\S+[^\s\)\(\,\.])/<a href="$1">$1<\/a>/g if $header !~ /^Авто/; |
# $value =~ s/(http:\/\/(?:\w+.)+[\w\\\~]+(\?[^\s.]+)?)/<a href="$1">$1<\/a>/g if $header !~ /^Авто/; |
# $value =~ s/(http:\/\/(?:\w+.)+[\w\\\~]+(\?[^\s.]+)?)/<a href="$1">$1<\/a>/g if $header !~ /^Авто/; |
# $value =~ s/(\s)"/$1“/mg; |
# $value =~ s/(\s)"/$1“/mg; |
# $value =~ s/^"/“/mg; |
# $value =~ s/^"/“/mg; |
Line 1341 sub PrintField {
|
Line 1407 sub PrintField {
|
$value . p . "\n"; |
$value . p . "\n"; |
} |
} |
return $text ? "$header:\n$value\n\n" : |
return $text ? "$header:\n$value\n\n" : |
strong("$header: ") . $value . p . "\n"; |
strong("$header: ") . "\n".$value . p . "\n"; |
} |
} |
|
|
# Gets a DB handler (ofcourse) and a question Id. Prints |
# Gets a DB handler (ofcourse) and a question Id. Prints |
Line 1361 sub PrintQuestion {
|
Line 1427 sub PrintQuestion {
|
$Question{'FileName'}=$Tournament{'FileName'}; |
$Question{'FileName'}=$Tournament{'FileName'}; |
$Question{'Title'}=$Tournament{'Title'}; |
$Question{'Title'}=$Tournament{'Title'}; |
$Question{'PlayedAt'}=$Tournament{'PlayedAt'}; |
$Question{'PlayedAt'}=$Tournament{'PlayedAt'}; |
|
$Question{'PlayedAt2'}=$Tournament{'PlayedAt2'}; |
$Question{'TourNumber'}=$Tour{'Number'}; |
$Question{'TourNumber'}=$Tour{'Number'}; |
$Question{'TourTitle'}=$Tour{'Title'}; |
$Question{'TourTitle'}=$Tour{'Title'}; |
} |
} |
Line 1376 sub PrintQuestion {
|
Line 1443 sub PrintQuestion {
|
$titles .= |
$titles .= |
dd(img({src=>"/icons/folder.open.gif"}) . " " . |
dd(img({src=>"/icons/folder.open.gif"}) . " " . |
a({href=>tourhref($fname,0,1)}, |
a({href=>tourhref($fname,0,1)}, |
$Question{'Title'}, $Question{'PlayedAt'}||'')); |
$Question{'Title'}, $Question{'PlayedAt'}||'', |
|
$Question{'PlayedAt2'}?' – '.$Question{'PlayedAt2'}:'')); |
$titles .= |
$titles .= |
dl(dd(img({src=>"/icons/folder.open.gif"}) . " " . |
dl(dd(img({src=>"/icons/folder.open.gif"}) . " " . |
a({href=>tourhref("$fname.$Question{'TourNumber'}#$qnum",1)}, |
a({href=>tourhref("$fname.$Question{'TourNumber'}#$qnum",1)}, |
Line 1483 EOTT
|
Line 1551 EOTT
|
$output.="</span>" |
$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/\(aud: ([^\)]*)\)/<embed type="application\/x-shockwave-flash" src="http:\/\/www.google.com\/reader\/ui\/3247397568-audio-player.swf?audioUrl=\/znatoki\/sounds\/db\/$1" allowscriptaccess="never" width="400" height="27" quality="best" bgcolor="#ff0000" wmode="window" flashvars="playerMode=embedded" \/>/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'); |
my $qid=$fname ? ($fname.".$Question{'Number'}" ): ''; |
my $qid=$fname ? ($fname.".$Question{'Number'}" ): ''; |
|
|
$output.=br.a({href=> $url."?metod=proxy& |
$output.=br."\n".a({href=> "/search/"."?metod=proxy& |
qid=$qid"}, 'Близкие вопросы').p |
qid=$qid"}, 'Близкие вопросы').p |
if $answer>0 && !$text && $qid; |
if $answer>0 && !$text && $qid && $showNearQuestions; |
return $output; |
return $output; |
} |
} |
|
|
Line 1626 sub PrintAll {
|
Line 1699 sub PrintAll {
|
|
|
$output .= dd(img({src=>"/icons/folder.gif", alt=>"[*]"}) . |
$output .= dd(img({src=>"/icons/folder.gif", alt=>"[*]"}) . |
" " . a({href=>tourhref($textid,0,!$SingleTour)}, |
" " . a({href=>tourhref($textid,0,!$SingleTour)}, |
$Tournament{'Title'}) ." " . ($Tournament{'PlayedAt'}||'') . " $New"); |
$Tournament{'Title'}) ." " . ($Tournament{'PlayedAt'}||'') . |
|
($Tournament{'PlayedAt2'}?' – '.$Tournament{'PlayedAt2'}:'') . |
|
" $New"); |
} |
} |
if ($Id == 0 or $Tournament{'Type'} =~ /Г/ or $Tournament{'Type'} eq '') { |
if ($Id == 0 or $Tournament{'Type'} =~ /Г/ or $Tournament{'Type'} eq '') { |
for ($i = 0; $i <= $#Tours; $i++) { |
for ($i = 0; $i <= $#Tours; $i++) { |
Line 1671 sub PrintDates {
|
Line 1746 sub PrintDates {
|
else {$textid=$Tournament{'Id'}}; |
else {$textid=$Tournament{'Id'}}; |
$list .= dd(img({src=>"/icons/folder.gif", alt=>"[*]"}) . |
$list .= dd(img({src=>"/icons/folder.gif", alt=>"[*]"}) . |
" " . a({href=>tourhref($textid,0,1)}, |
" " . a({href=>tourhref($textid,0,1)}, |
$Tournament{'Title'}, $Tournament{'PlayedAt'}||'')); |
$Tournament{'Title'}, $Tournament{'PlayedAt'}||'', |
|
$Tournament{'PlayedAt2'}?' – '.$Tournament{'PlayedAt2'}:'')); |
} |
} |
$sth->finish; |
$sth->finish; |
$output .= dl($list); |
$output .= dl($list); |
Line 1788 sub WriteFile {
|
Line 1864 sub WriteFile {
|
$fname=~s/.*\/(\w+)/$1/; |
$fname=~s/.*\/(\w+)/$1/; |
|
|
my $query= "SELECT Id, Title, Copyright, Info, URL, |
my $query= "SELECT Id, Title, Copyright, Info, URL, |
Editors, EnteredBy, PlayedAt, CreatedAt |
Editors, EnteredBy, PlayedAt, CreatedAt, PlayedAt2 |
from Tournaments where FileName= |
from Tournaments where FileName= |
'$fname' OR FileName=".$dbh->quote("$fname.txt"); |
'$fname' OR FileName=".$dbh->quote("$fname.txt"); |
my $sth=$dbh->prepare($query); |
my $sth=$dbh->prepare($query); |
my (%Question,%editor,%qnumber,%copyright,%author,%vid,%tourtitle); |
my (%Question,%editor,%qnumber,%copyright,%author,%vid,%tourtitle); |
$sth->execute; |
$sth->execute; |
my ($Id, $Title, $Copyright, $Info, $URL, |
my ($Id, $Title, $Copyright, $Info, $URL, |
$Editors, $EnteredBy, $PlayedAt, $CreatedAt)= |
$Editors, $EnteredBy, $PlayedAt, $CreatedAt, $PlayedAt2)= |
$sth->fetchrow; |
$sth->fetchrow; |
return -1 unless $Id; |
return -1 unless $Id; |
open (OUT, ">$TMPDIR/$fname.txt") || print STDERR "Error in $fname.txt\n"; |
open (OUT, ">$TMPDIR/$fname.txt") || print STDERR "Error in $fname.txt\n"; |
Line 1804 sub WriteFile {
|
Line 1880 sub WriteFile {
|
my ($year,$month,$day)=split /-/, $date; |
my ($year,$month,$day)=split /-/, $date; |
# $month=0,$date=0 if $year && $month==1 && $day==1; |
# $month=0,$date=0 if $year && $month==1 && $day==1; |
my $pdate=sprintf("%02d-%3s-%4d",$day,$months[$month],$year); |
my $pdate=sprintf("%02d-%3s-%4d",$day,$months[$month],$year); |
|
if ($PlayedAt2) { |
|
my ($year,$month,$day)=split /-/, $date; |
|
$pdate .= sprintf(" - %02d-%3s-%4d",$day,$months[$month],$year); |
|
} |
|
|
print OUT "Дата:\n$pdate\n\n" if $date; |
print OUT "Дата:\n$pdate\n\n" if $date; |
|
|
Line 1964 MAIN:
|
Line 2044 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 1973 MAIN:
|
Line 2053 MAIN:
|
print end_html; |
print end_html; |
die "Can't connect to DB chgk\n"; |
die "Can't connect to DB chgk\n"; |
}; |
}; |
|
$dbh->do("set names koi8r"); |
|
|
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); |
exit |
exit |
} |
} |
|
|
if ($tour && !param('qnumber') && (!param('answers')||(param('answers')<=1))) |
if (0 && $tour && !param('qnumber') && (!param('answers')||(param('answers')<=1))) |
{ |
{ |
my $n=param('tour'); |
my $n=param('tour'); |
$n=~s/.txt$//; |
$n=~s/.txt$//; |
Line 2093 MAIN:
|
Line 2173 MAIN:
|
$globaloutput.="<style> |
$globaloutput.="<style> |
td {font-size: x-small; font-family : sans-serif} |
td {font-size: x-small; font-family : sans-serif} |
th {font-size: x-small; font-family : sans-serif} |
th {font-size: x-small; font-family : sans-serif} |
|
div.razdatka { |
|
background-color:#EEEEFF; |
|
padding:4px; |
|
border:1px solid black; |
|
} |
|
|
|
div.razdatka_header {font-style:italic;} |
|
|
</style>\n"; |
</style>\n"; |
|
|
$globaloutput.=&Include_virtual("$reklama")||''; |
$globaloutput.=&Include_virtual("$reklama")||''; |
Line 2214 EOT
|
Line 2302 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); |