db/prgsrc/db.cgi - view

File: [Local Repository] / db / prgsrc / db.cgi
Revision 1.132: download - view: text, annotated - select for diffs - revision graph
Wed Mar 17 10:26:31 2004 UTC (20 years, 2 months ago) by roma7
Branches: MAIN
CVS tags: HEAD

?tour=smth#nn&answers=1 bug fixed

1: #!/usr/bin/perl -w 2: 3: use DBI; 4: use CGI ':all'; 5: #use strict; 6: use Time::Local; 7: my $proxyredirect=1; 8: use POSIX qw(locale_h); 9: use locale; 10: use vars qw($opt_z); 11: use Getopt::Std; 12: #my ($dbuser,$dbname,$dbpass,$dbhost); 13: require "dbdefs.pl"; 14: my $url=url||''; 15: $dbuser||="piataev"; 16: $dbname||="chgk"; 17: $dbpass||=""; 18: $dbhost||="localhost"; 19: getopts('z'); 20: $opt_z||=param("makehtml"); 21: my $timestamp="_timestamp.tmp"; 22: my $usehash=0; 23: my $paramtour; 24: my $withanswers=param('answer')||param('answers'); 25: open STDERR, ">/var/tmp/errors1"; 26: my $newsurl='http://news.chgk.info/'; 27: my $reklama="../dimrub/db/reklama.html"; 28: my $footer="../dimrub/db/footer.html"; 29: $footer="../../chgk/footer.html" if $url=~/zaba/; 30: $reklama="../../chgk/reklama.html" if $url=~/zaba/; 31: my $datefooter="../dimrub/db/date"; 32: $datefooter="../../chgk/date" if $url=~/zaba/; 33: 34: my $fname; 35: $reklama="../reklama.html" if $opt_z; 36: $footer="../footer.html" if $opt_z; 37: $datefooter="../date" if $opt_z; 38: my $HTMLDIR="/znatoki/dimrub/db/baza/"; 39: $HTMLDIR="/files/"; 40: my $realHTMLDIR; 41: if ($^O =~ /win/i) { 42: $realHTMLDIR="/html/znatoki/baza/"; 43: } else 44: { 45: $realHTMLDIR="/home/piataev/public_html/dimrub/db/files/"; 46: } 47: 48: 49: my $usehtml=$opt_z||0; 50: $usehtml=1; 51: $usehtml=0 if $url=~/zaba/; 52: 53: my $usewas=0; 54: my $cashednumber=500; 55: my $outputnumber=10; 56: my ($proxyptext,$proxysstr); 57: my $printqueries=0; 58: my $qs=query_string; 59: my $globaloutput; 60: my %forbidden=(); 61: my $debug=0; #added by R7 62: my $metod=param('metod')||''; 63: my $outputkvo=param('kvo') ||$outputnumber; 64: $outputkvo=100 if $outputkvo>100; 65: 66: if (param('debug')) {$debug=1; $printqueries=1} 67: *STDERR=*STDOUT if $debug; 68: if ($url !~ /db\.chgk\.info/ && $url !~ /localhost/ && $url !~ /bilbo/ && $url !~ /zaba/) { 69: my $u="http://db.chgk.info/cgi-bin/db.cgi?$qs"; 70: Redirect ($u); 71: exit; 72: } 73: 74: if ($proxyredirect && $metod=~/proxy/ && $url !~ /localhost/ && $url !~ /bilbo/ && $url !~ /zaba/) { 75: my $u="http://chgk.zaba.ru/cgi-bin/db.cgi?$qs"; 76: Redirect ($u); 77: exit; 78: } 79: 80: #if (!param('sstr') && param('all')) { 81: # my $destination='http://db.chgk.info/all.html'; 82: # Redirect($destination); 83: # exit; 84: #} 85: my $thislocale; 86: if ($^O =~ /win/i) { 87: $thislocale = "Russian_Russia.20866"; 88: } else { 89: $thislocale = "ru_RU.KOI8-R"; 90: } 91: POSIX::setlocale( &POSIX::LC_ALL, $thislocale ); 92: 93: if ((uc 'а') ne 'А') {print STDERR "Koi8-r locale not installed!\n"}; 94: 95: my %fieldname= (0,'Question', 1, 'Answer', 2, 'Comments', 3, 'Authors', 4, 'Sources'); 96: my %rusfieldname=('Question','Вопрос', 'Answer', 'Ответ', 97: 'Comments', 'Комментарии', 'Authors', 'Автор', 98: 'Sources', 'Источник','old','Старый','rus','Новый', 99: 'chgk', 'ЧГК', 'brain', 'Брейн-ринг','game', 'Своя игра', 100: 'ehruditka', 'Эрудитка', 'beskrylka', 'Бескрылка', 'igp', 'Интернет' 101: ); 102: my %searchin; 103: my $rl=qr/[йцукенгшщзхъфывапролджэячсмитьбюё]/; 104: my $RL=qr/[ЙЦУКЕНГШЩЗХЪЭЖДЛОРПАВЫФЯЧСМИТЬБЮЁ]/; 105: my $RLrl=qr/(?:(?:${rl})|(?:${RL}))+/; 106: my $l=qr/(?:(?:${RLrl})|(?:[\w\-]))+/; 107: my $Ll=qr/(?:[A-Z])|(?:${RL})/; 108: my %metodchar=('rus',1,'old',2); 109: 110: 111: 112: 113: $searchin{$_}=1 foreach param('searchin'); 114: my %TypeName=('children'=>'Д', 'game'=>'Я', 'igp'=>'И', 115: 'chgk'=>'Ч', 'brain'=>'Б', 'beskrylka'=>'Л','ehruditka'=>'Э'); 116: 117: 118: sub countz { 119: my ($dbh,$type)=@_; 120: 121: my $sth=$dbh->prepare("select count(*) from Questions where Type LIKE '%$type%'"); 122: $sth->execute(); 123: my ($tmp)=$sth->fetchrow(); 124: return $tmp; 125: } 126: 127: my $all=param('all'); 128: $all=0 if lc $all eq 'no'; 129: my ($PWD) = `pwd` if $^O!~/win/i; 130: chomp $PWD if $PWD; 131: my ($SRCPATH) = "/home/piataev/public_html/dimrub/src"; 132: my ($ZIP) = "/usr/local/bin/zip"; 133: my $DUMPFILE = "/tmp/chgkdump"; 134: my ($SENDMAIL) = "/usr/sbin/sendmail"; 135: my ($TMPDIR) = "/var/tmp"; 136: my ($TMSECS) = 30*24*60*60; 137: my (%RevMonths) = 138: ('Jan', '0', 'Feb', '1', 'Mar', '2', 'Apr', '3', 'May', '4', 'Jun', '5', 139: 'Jul', '6', 'Aug', '7', 'Sep', '8', 'Oct', '9', 'Nov', '10', 140: 'Dec', '11', 141: 'Янв', '0', 'Фев', 1, 'Мар', 2, 'Апр', 3, 'Май', '4', 142: 'Июн', '5', 'Июл', 6, 'Авг', '7', 'Сен', '8', 143: 'Окт', '9', 'Ноя', '19', 'Дек', '11'); 144: my @months=('000','Jan',"Feb","Mar","Apr","May","Jun","Jul","Aug","Sep","Oct", 145: "Nov","Dec"); 146: 147: 148: # Determine whether the given time is within 2 months from now. 149: sub NewEnough { 150: my ($a) = @_; 151: my ($year, $month, $day) = split('-', $a); 152: $month=1 if ($month<=0); 153: $day=1 if ($day<=0); 154: return (time - timelocal(0, 0, 0, $day, $month -1, $year) < $TMSECS); 155: } 156: 157: # Reads one question from the DB. Gets DB handler and Question ID. 158: 159: sub Redirect { 160: my ($destination) = @_; 161: print header.<<EndOfHTML; 162: <head><meta http-equiv="refresh" content="0; URL=$destination"></head> 163: EndOfHTML 164: ; 165: =head 166: 167: print <<EndOfHTML; 168: Content-type: text/html 169: Location: $destination 170: 171: <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN"> 172: <HTML><HEAD><TITLE>Redirection</TITLE></HEAD> 173: <BODY BGCOLOR="#FFFFFF"> 174: <H1>Redirection</H1> 175: <P>It appears that your browser cannot handle redirections 176: automatically. You can proceed to the randomly-selected page 177: by clicking <A HREF="$destination">here</A>.</P> 178: </BODY> 179: </HTML> 180: EndOfHTML 181: ; 182: =cut 183: } 184: 185: 186: 187: 188: sub GetTournament { 189: my ($dbh, $Id) = @_; 190: my (%Tournament, $field, @arr); 191: 192: return %Tournament if ($Id == 0); 193: 194: my ($sth) = $dbh->prepare("SELECT * FROM Tournaments WHERE Id=$Id"); 195: $sth->execute; 196: 197: @arr = $sth->fetchrow; 198: my($i, $name) = 0; 199: foreach $name (@{$sth->{NAME}}) { 200: $Tournament{$name} = $arr[$i++]; 201: } 202: $sth->finish; 203: return %Tournament; 204: } 205: 206: sub fetchquestion { 207: my ($sth,$q,$WithTour)=@_; 208: if ($WithTour) { 209: ($$q{'QuestionId'}, $$q{'Question'},$$q{'Answer'},$$q{'Comments'},$$q{'Authors'},$$q{'Sources'}, 210: $$q{'Number'}, 211: $$q{'Title'}, $$q{'TourTitle'}, $$q{'FileName'},$$q{'PlayedAt'},$$q{'TourNumber'}) = 212: $sth->fetchrow; 213: } else { 214: ($$q{'QuestionId'}, $$q{'Question'},$$q{'Answer'},$$q{'Comments'},$$q{'Authors'},$$q{'Sources'}, 215: $$q{'Number'})= 216: $sth->fetchrow; 217: } 218: } 219: 220: 221: 222: 223: sub SelectQuestions { 224: my ($dbh,$q,$WithTour) = @_; 225: my %q=(); 226: # $_ = "QuestionId=$_" foreach @$q; 227: # my $where=join " OR ",@$q; 228: my $where=join ',',@$q; 229: $where &&= "QuestionId IN (".(join ',',$where).")"; 230: $where||=1; 231: $where="($where) AND Questions.ParentId=t1.Id AND t1.ParentId=t2.Id" 232: if $WithTour; 233: 234: my $query; 235: if ($WithTour) { 236: $query="SELECT QuestionId, Questions.Question, Answer, Comments, Authors, Sources, 237: Questions.Number 238: , t2.Title, t1.Title, t2.FileName, t2.PlayedAt,t1.Number 239: from Questions,Tournaments as t1, Tournaments as t2 240: WHERE $where"; 241: } else { 242: $query="SELECT QuestionId, Questions.Question, Answer, Comments, Authors, Sources, 243: Questions.Number from Questions 244: WHERE $where"; 245: } 246: 247: my $sth; 248: $sth=$dbh->prepare($query); 249: $sth->execute; 250: return $sth; 251: } 252: 253: 254: # Reads one question from the DB. Gets DB handler and Question ID. 255: sub GetQuestion { 256: my ($dbh, $QuestionId) = @_; 257: my (%Question, $field, @arr); 258: 259: my($sth) = $dbh->prepare(" 260: SELECT * FROM Questions WHERE QuestionId=$QuestionId 261: "); 262: 263: $sth->execute; 264: 265: @arr = $sth->fetchrow; 266: my($i, $name) = 0; 267: foreach $name (@{$sth->{NAME}}) { 268: $Question{$name} = $arr[$i++]; 269: } 270: 271: $sth->finish; 272: return %Question; 273: } 274: 275: sub tourhref { 276: my ($t,$a,$gr)=@_; 277: my $res; 278: if ($usehtml) { 279: $res=$t; 280: $res.=$a?"-a":"-q" unless $gr; 281: $res.=".html"; 282: $res=~s/(\#\d+)(.*)$/$2$1/; 283: my $t=$res; 284: $t=~s/\#.*$//; 285: $res=~s/\.1// unless -e "$realHTMLDIR$t"; 286: $t=$res; 287: $t=~s/\#.*$//; 288: $res=~s/\.html/-q\.html/ unless -e "$realHTMLDIR$t"; 289: $res="$HTMLDIR$res" unless $opt_z; 290: return $res; 291: } else { 292: $res=$url; 293: $res.=$a?"?answers=1&":"?"; 294: $res.="tour=$t"; 295: 296: return $res; 297: } 298: 299: } 300: 301: # Gets numbers of all the questions from the given tour. 302: sub GetTourQuestions { 303: my ($dbh, $ParentId) = @_; 304: my (@arr, @Questions); 305: my ($sth) = $dbh->prepare("SELECT QuestionId FROM Questions 306: WHERE ParentId=$ParentId order by Number"); 307: 308: $sth->execute; 309: 310: while (@arr = $sth->fetchrow) { 311: push @Questions, $arr[0]; 312: } 313: 314: $sth->finish; 315: return @Questions; 316: } 317: 318: # Returns list of children of the given tournament. 319: sub GetTours { 320: my ($dbh, $ParentId) = @_; 321: my (@arr, @Tours); 322: 323: my ($sth) = $dbh->prepare("SELECT Id FROM Tournaments 324: WHERE ParentId=$ParentId ORDER BY Id"); 325: 326: $sth->execute; 327: 328: while (@arr = $sth->fetchrow) { 329: push @Tours, $arr[0]; 330: } 331: $sth->finish; 332: return @Tours; 333: } 334: 335: sub count 336: { 337: my ($dbh,$word)=@_; 338: $word=$dbh->quote(uc $word); 339: my $query="SELECT number from nests,nf where $word=w1 AND w2=nf.id"; 340: my $sth=$dbh->prepare($query); 341: $sth->execute; 342: my @a=$sth->fetchrow; 343: $sth->finish; 344: $a[0]||0; 345: } 346: 347: 348: sub printform 349: { 350: 351: my $qnumber=(" "x10)."Выводить по 352: <input type=\"text\" name=\"kvo\" value=$outputkvo size=\"3\" maxlength=\"5\">"; 353: #textfield(-name=>'kvo', 354: # -default=>6, 355: # -size=>3, 356: # -maxlength=>5)." вопросов"; 357: my $sstr=param('sstr'); 358: my @df=keys %searchin; 359: my %checked; 360: $checked{lc $_}="" foreach ('Question','Answer','Comments','Authors','Sources','old','rus', 361: 'chgk','brain','igp','game','ehruditka','beskrylka'); 362: @df=('Question', 'Answer') unless @df; 363: $checked{lc $_}="checked" foreach @df; 364: my $fields=checkbox_group('searchin',['Question','Answer','Comments','Authors','Sources'], [@df], 365: 'false',\%rusfieldname); 366: @df=param('type'); 367: @df=('chgk','brain','igp','game','ehruditka','beskrylka') unless @df; 368: $checked{lc $_}="checked" foreach @df; 369: my $all=param('all') && param('all') eq 'yes'; 370: 371: $checked{'all'}=$all?"checked":""; 372: $checked{'any'}=$all?"":"checked"; 373: $checked{lc param('metod')}="checked"; 374: $checked{'rus'}=1 unless $checked{'rus'} || $checked{'old'}; 375: 376: ################################################# 377: return 378: <<EOT 379: <form method="get" enctype="application/x-www-form-urlencoded" 380: action="/znatoki/cgi-bin/db.cgi"> 381: <h2>Поиск в базе вопросов</h2> 382: 383: <input type="text" name="sstr" value="$sstr" size="30" maxlength="50"> 384: <input type="submit" value="Поиск"> $qnumber 385: <p> 386: 387: <table border="1" cellpadding=4 cellspacing=0> 388: <tr> 389: <th align="left" rowspan=3 width="20%"> Вариант поиска: 390: </td><td rowspan=2 colspan=2> 391: <input type="radio" $checked{'old'} name="metod" value="old"> Простой (старый) 392: </td><td> 393: <input type="checkbox" $checked{'chgk'} name="type" value="chgk"> "Что? Где? Когда?" 394: </td><td><nobr> 395: <input type="checkbox" $checked{'brain'} name="type" value="brain"> "Брейн-Ринг"</nobr> 396: </td><td> 397: <input type="checkbox" $checked{'igp'} name="type" value="igp"> "Интернет" 398: </td> 399: </tr><tr> 400: <td> 401: <input type="checkbox" $checked{'game'} name="type" value="game"> "Своя игра" 402: </td><td> 403: <input type="checkbox" $checked{'ehruditka'} name="type" value="ehruditka"> "Эрудитка" 404: </td><td> 405: <input type="checkbox" $checked{'beskrylka'} name="type" value="beskrylka"> "Бескрылка" 406: </td> 407: </tr><tr> 408: <td colspan=5><input type="radio" $checked{'rus'} name="metod" value="rus"> Расширенный (с учетом грамматики, в вопросах всех типов) 409: </td> 410: </tr><tr> 411: <th align="left">Искать: 412: </td><td colspan=2> 413: <input type="radio" $checked{'all'} name="all" value="yes">Все слова 414: </td><td colspan=3> 415: <input type="radio" $checked{'any'} name="all" value="no">Любое слово 416: </td> 417: </tr><tr> 418: <th align="left">Поля для поиска: 419: </td><td width="15%"> 420: <input type="checkbox" name="searchin" value="Question" $checked{'question'}>Вопрос 421: </td><td width="15%"> 422: <input type="checkbox" name="searchin" value="Answer" $checked{'answer'}>Ответ<br> 423: </td><td width="15%"> 424: <input type="checkbox" name="searchin" value="Comments" $checked{'comments'}>Комментарии<br> 425: </td><td width="15%"> 426: <input type="checkbox" name="searchin" value="Authors" $checked{'authors'}>Автор<br> 427: </td><td width="15%"> 428: <input type="checkbox" name="searchin" value="Sources" $checked{'sources'}>Источник<br> 429: </td> 430: </tr> 431: </table> 432: <p><i>Если при попытке поиска выдаётся сообщение об ошибке, 433: попробуйте воспользоваться 434: <a href="http://chgk.zaba.ru/search.html">зеркалом базы</a></i> 435: </center> 436: 437: EOT 438: .endform 439: .hr 440: 441: } 442: 443: sub proxy 444: { 445: my ($dbh,$ptext,$allnf)=@_; 446: my $sstr=makeproxysstr($dbh,$ptext,$allnf); 447: return russearch($dbh,$sstr,0,$allnf); 448: } 449: 450: sub makeproxysstr { 451: my ($dbh,$ptext)=@_; 452: my $text=$$ptext; 453: POSIX::setlocale( &POSIX::LC_ALL, $thislocale ); 454: $text=~tr/ёЁ/еЕ/; 455: $text=~s/(${RLrl})p(${RLrl})/$1p$2/gom; 456: $text=~s/p(${RLrl})/р$1/gom; 457: $text=~s/(${RLrl})p/$1р/gom; 458: $text=~s/\s+/ /gmo; 459: $text=~s/[^йцукенгшщзхъфывапролджэячсмитьбюЙЦУКЕНГШЩЗХЪФЫВАПРОЛДЖЭЯЧСМИТЬБЮQWERTYUIOPASDFGHJKLZXCVBNM0-9]/ /g; 460: $text=uc $text; 461: my @list= $text=~m/(?:(?:${RLrl})+)|(?:[A-Za-z0-9]+)/gom; 462: 463: my (%c, %good,$sstr); 464: foreach (@list) 465: { 466: $c{$_}=count($dbh,$_)||10000; 467: } 468: my @words=sort {$c{$a}<=> $c{$b}} @list; 469: 470: # $good{$words[$_]}=1 foreach 0..4; 471: foreach (@words) 472: { 473: $good{$_}=1 if $c{$_}<200 && length $_>2; 474: } 475: 476: $good{$words[$_]}=0 foreach 16..$#words; 477: 478: $sstr.=" $_" foreach grep {$good{$_}} @list; 479: $$ptext=$sstr; 480: return $sstr; 481: } 482: 483: 484: sub russearch { 485: my ($dbh, $sstr, $all,$allnf)=@_; 486: my (@qw,@w,@tasks,$qw,@arr,$nf,$sth,@nf,$w,$where,$e,@where,%good,$i,%where,$from); 487: my($number,@good,$t,$task,@rho,$rank,%rank,$r2,$r1,$word,$n,@last,$good,@words,%number,$taskid); 488: my ($hi, $lo, $wordnumber,$query,$blob,$field,$sf,$ii); 489: my @frequence; 490: my (@arr1,@ar,@sf,@arr2); 491: my %tasks; 492: my $tasks; 493: my @verybad; 494: my %nf; 495: my %tasksof; 496: my %wordsof; 497: my %relevance; 498: my @blob; 499: my %count; 500: POSIX::setlocale( &POSIX::LC_ALL, $thislocale ); 501: $sstr=~tr/йцукенгшщзхъфывапролджэячсмитьбю/ЙЦУКЕНГШЩЗХЪФЫВАПРОЛДЖЭЯЧСМИТЬБЮ/; 502: # @qw=@w =split (' ', uc $sstr); 503: my $ts=uc $sstr; 504: @qw=@w= $ts=~m/(?:(?:${RLrl})+)|(?:[A-Za-z0-9]+)/gom; 505: 506: 507: #----------- 508: foreach $i (0..$#w) # заполняем массив @nf начальных форм 509: # $nf[$i] -- ссылка на массив возможных 510: # начальных форм словоформы $i 511: { 512: $qw= $dbh->quote (uc $w[$i]); 513: $query=" select distinct w2 from nests 514: where w1=$qw"; 515: $sth=$dbh -> prepare($query); 516: $sth -> execute; 517: @{$nf[$i]}=(); 518: while (@arr = $sth->fetchrow) 519: { 520: push (@{$nf[$i]},$arr[0]) 521: } 522: $sth->finish; 523: } 524: 525: 526: my @bad=grep {!@{$nf[$_]}} 0..$#w; # @bad -- номера словоформ, 527: # которых нет в словаре 528: 529: if (@bad) #есть неопознанные словоформы 530: { 531: require "cw.pl"; 532: foreach $i(@bad) 533: { 534: if (@arr=checkword($dbh,$w[$i])) 535: {push (@{$nf[$i]}, @arr);} 536: else 537: {push (@verybad,$i);} 538: } 539: } 540: return () if ($all && @verybad); 541: 542: 543: my $kvo=0; 544: push @$allnf, @{$_} foreach @nf; 545: 546: foreach $i (0..$#w) #запросы в базу... 547: { 548: @arr=@{$nf[$i]} if $nf[$i]; 549: @arr2=@arr1=@arr; 550: 551: 552: 553: 554: $_= " word2question.word=$_" foreach @arr; 555: $_= " nf.id=".$_. ' ' foreach @arr1; 556: # @arr=(0) unless @arr; 557: $query="select questions from word2question where (". (join ' OR ', @arr).") AND length(questions)<80000"; 558: 559: $sth=$dbh -> prepare($query); 560: $sth->execute; 561: 562: @blob=(); 563: while (@arr=$sth->fetchrow) 564: { 565: @blob=(@blob,unpack 'C*',$arr[0]); 566: } 567: $sth->finish; 568: $query="select number from nf where ".(join ' OR ', @arr1); 569: $sth=$dbh -> prepare($query); 570: $sth->execute; 571: 572: while (@arr=$sth->fetchrow) 573: { 574: $frequence[$i]+=$arr[0]; 575: } 576: $sth->finish; 577: 578: 579: if (@blob < 4) 580: { 581: $tasksof{$i}=undef; 582: } else 583: { 584: $kvo++; 585: $ii=0; 586: while ($ii<$#blob) # создаём хэш %tasksof, ключи которого -- 587: # номера искомых словоформ, а значения -- 588: # списки вопросов, в которых есть соответствующа 589: # словоформа. 590: # Каждый список в свою очередь также оформлен в 591: # виде хэша, ключи которого -- номера вопросов, 592: # а значения -- списки номеров вхождений. Вот. 593: { 594: ($field,$lo,$hi,$wordnumber)=@blob[$ii..($ii+3)]; 595: $ii+=4; 596: my $addnumber=($field >> 4) << 16; 597: $number=(($field >> 4) << 16)+($hi << 8) + $lo; 598: $field=$fieldname{$field & 0xF}; 599: if ($searchin{$field}) 600: { 601: push @{$tasksof{$i}{$number}}, $wordnumber; 602: # дополнили в хэше, висящем на 603: # словоформе $i в %tasksof список 604: # вхождений $i в вопрос $number. 605: push @{$wordsof{$number}{$i}}, $wordnumber; 606: # дополнили в хэше, висящем на 607: # вопросе $number в %wordsof список 608: # вхождений $i в вопрос $number. 609: 610: 611: } 612: } #while ($ii<$#blob) 613: } 614: } #foreach $i 615: 616: #Ищем пересечение или объединение списков вопросов (значений %tasksof) 617: foreach $sf (keys %tasksof) 618: { 619: $count{$_}++ foreach keys %{$tasksof{$sf}}; 620: } 621: @tasks= ($all ? (grep {$count{$_}==$kvo} keys %count) : 622: keys %count) ; 623: 624: 625: ############ Сортировка найденных вопросов 626: 627: foreach (keys %wordsof) 628: { 629: $relevance{$_}=&relevance($#w,$wordsof{$_},\@frequence) if $_ 630: } 631: 632: @tasks=sort {$relevance{$b}<=>$relevance{$a}} @tasks; 633: 634: ############ 635: 636: 637: return @tasks; 638: } 639: 640: 641: sub distance { 642: # на входе -- номера словоформ и ссылки на 643: # списки вхождений. На выходе -- расстояние, 644: # вычисляемое по формуле min(|b-a-pb+pa|) 645: # pb,pa 646: # (pb и pa -- позиции слов b и a) 647: my ($a,$b,$lista,$listb)=@_; 648: my ($pa,$pb,$min,$curmin); 649: $min=10000; 650: foreach $pa (@$lista) 651: { 652: foreach $pb (@$listb) 653: { 654: $curmin=abs($b-$a-$pb+$pa); 655: $min= $curmin if $curmin<$min; 656: } 657: } 658: return $min; 659: 660: } 661: 662: sub relevance { 663: # На входе -- количество искомых словоформ -1 и 664: # ссылка на hash, ключи которого -- 665: # номера словоформ, а значения -- списки вхождений 666: 667: my ($n,$words,$frequence)=@_; 668: my $relevance=0; 669: my ($first,$second,$d); 670: foreach $first (0..$n) 671: { 672: $relevance+=scalar @{$$words{$first}}+1000+1000/$$frequence[$first] 673: if $$words{$first}; 674: foreach $second ($first+1..$n) 675: { 676: $d=&distance($first,$second,$$words{$first},$$words{$second}); 677: $relevance+=($d>10?0:10-$d)*10; 678: } 679: } 680: return $relevance; 681: } 682: 683: 684: 685: # Returns list of QuestionId's, that have the search string in them. 686: sub Search { 687: my ($dbh, $s,$metod,$all,$allnf) = @_; 688: my $sstr=$$s; 689: my (@arr, @Questions, @fields); 690: my (@sar, $i, $sth,$where,$query); 691: if ($metod eq 'rus') 692: { 693: my @tasks=russearch($dbh,$sstr,$all,$allnf); 694: return @tasks 695: } 696: elsif ($metod eq 'proxy') 697: { 698: my @task=proxy($dbh,$s,$allnf); 699: return @task 700: } 701: 702: 703: 704: ###Simple and advanced query processing. Added by R7 705: if ($metod eq 'simple' || $metod eq 'advanced') 706: { 707: foreach (qw/Question Answer Sources Authors Comments/) { 708: if (param($_)) { 709: push @fields, $_; 710: } 711: } 712: 713: @fields=(qw/Question Answer Sources Authors Comments/) unless scalar @fields; 714: my $fields=join ",", @fields; 715: my $q=new Text::Query($sstr, 716: -parse => 'Text::Query::'. 717: (($metod eq 'simple') ? 'ParseSimple':'ParseAdvanced'), 718: -solve => 'Text::Query::SolveSQL', 719: -build => 'Text::Query::BuildSQLMySQL', 720: -fields_searched => $fields); 721: 722: $where= $$q{'matchexp'}; 723: $query= "SELECT Questionid FROM Questions 724: WHERE $where"; 725: 726: $sth = $dbh->prepare($query); 727: } else 728: ###### 729: { 730: 731: # foreach (qw/Question Answer Sources Authors Comments/) { 732: foreach (param('searchin')) { 733: # if (param($_)) { 734: push @fields, "IFNULL($_, '')"; 735: # } 736: } 737: @sar = split " ", $sstr; 738: for $i (0 .. $#sar) { 739: $sar[$i] = $dbh->quote("%${sar[$i]}%"); 740: } 741: $_.=' ' foreach (@fields); # Это чтобы последнее слово поля 742: # не сливалось с первым словом 743: # следующего поля, R7 744: my($f) = "CONCAT(" . join(',', @fields) . ")"; 745: if (param('all') eq 'yes') { 746: $sstr = join " AND $f LIKE ", @sar; 747: } else { 748: $sstr = join " OR $f LIKE ", @sar; 749: } 750: 751: my $query; 752: $query="SELECT QuestionId FROM Questions 753: WHERE ($f LIKE $sstr) AND (".&makewhere.") ORDER BY QuestionId"; 754: 755: 756: $sth = $dbh->prepare($query) 757: } #else -- processing old-style query (R7) 758: 759: $sth->execute; 760: while (@arr = $sth->fetchrow) { 761: push @Questions, $arr[0] unless $forbidden{$arr[0]}; 762: } 763: $sth->finish; 764: 765: return @Questions; 766: } 767: 768: sub makewhere { 769: my @type=param('type'); 770: my $type=''; 771: 772: $type .= ($_=$TypeName{$_}) foreach @type; 773: my $where=' 0 '; 774: foreach (@type) { 775: $where.= " OR (Type ='$_') OR (Type ='$_Д') OR (Type ='Д$_') "; 776: } 777: $where.= "OR (Type='ЧБ')" if ($type=~/Ч|Б/); 778: return $where; 779: } 780: 781: # Substitute every letter by a pair (for case insensitive search). 782: my (@letters) = qw/аА бБ вВ гГ дД еЕ жЖ зЗ иИ йЙ кК лЛ мМ нН оО 783: пП рР сС тТ уУ фФ хХ цЦ чЧ шШ щЩ ьЬ ыЫ эЭ юЮ яЯ/; 784: 785: sub NoCase { 786: my ($sstr) = shift; 787: my ($res); 788: 789: if (($res) = grep(/$sstr/, @letters)) { 790: return "[$res]"; 791: } else { 792: return $sstr; 793: } 794: } 795: 796: sub PrintList { 797: my ($dbh,$Questions,$shablon,$was)=@_; 798: my $Output; 799: my $first=param('first') ||1; 800: $first=$first-($first-1)%$outputkvo; 801: my $fkvo=param('fkvo')||($#$Questions+1); 802: my $last=$first+$outputkvo-1; 803: $last=$fkvo if $fkvo<$last; 804: my($f,$l); 805: my $nav=''; 806: my $qs=query_string; 807: $qs=~s/\;/\&/g; 808: $qs=~s/\&first\=[^\&]+//g; 809: my $sstr=param('sstr')||''; 810: $qs=~s/sstr=[^\&]+/sstr=$sstr/; 811: if ($usewas) { 812: $qs=~s/\&was=[^\&]+//; 813: $qs.="&was=$was" if $was; 814: $qs.="&fkvo=$fkvo" if $was; 815: } 816: if ($first>$outputkvo*3+1) 817: { 818: $nav.= 819: (" "x4). 820: a({href=>$url."?".$qs."\&first=1"},"<<").(" "x4). 821: a({href=>($url."?".$qs."\&first=".($first-$outputkvo))},"<").(" "x4) 822: } 823: else {$nav.=' 'x15;} 824: 825: my ($fprint,$lprint); 826: my $llprint=$fkvo- ($fkvo)%$outputkvo+1; # 827: if ($fkvo<=$outputkvo*7) 828: { $fprint=1; 829: $lprint=$llprint; 830: } 831: elsif ($first>$outputkvo*3 && $fkvo-$first>$outputkvo*3) 832: { 833: $fprint=$first-$outputkvo*3; 834: $lprint=$first+$outputkvo*3; 835: } 836: elsif ($first<=$outputkvo*3) 837: { 838: $fprint=1; $lprint=6*$outputkvo+1; 839: } 840: else 841: { 842: $lprint=$llprint; 843: $fprint=$lprint-$outputkvo*6 844: } 845: 846: # my $fprint=($first>$outputkvo*3) ? $first-$outputkvo*3 : 1; 847: # my $lprint=$#$Questions+1-$fprint>$outputkvo*7 ? $outputkvo*7 :$#$Questions+1; 848: # if ($lprint-$fprint<$outputkvo*6 && $fprint>1) 849: # { 850: # $fprint=$lprint-$outputkvo*6; 851: # $fprint=1 if ($fprint<=0) 852: # } 853: 854: 855: 856: for($f=$fprint; $f<=$lprint; $f+=$outputkvo) 857: { 858: # next if $first-$f>$outputkvo*3; 859: $l=$f+$outputkvo-1; 860: $l=$fkvo if $l>$fkvo+1; 861: if ($f==$first) {$nav.="[$f-$l] ";} 862: else { 863: $nav.= "[".a({href=>($url."?".$qs."\&first=$f")},"$f-$l")."] ";} 864: } 865: if ($lprint+$outputkvo<$fkvo) 866: { 867: $nav.= 868: (" "x4). 869: a({href=>($url."?".$qs."\&first=".($first+$outputkvo))},">").(" "x4). 870: a({href=>$url."?".$qs."\&first=$llprint"},">>").(" "x4) 871: } 872: $Output.= "$nav".br."\n"; 873: my @q=@$Questions[$first-1..$last-1]; 874: my %q=(); 875: my $sth=SelectQuestions($dbh,\@q,1); 876: my $qq; 877: my @Q; 878: for (0..$#q) { 879: %{$Q[$_]}=(); 880: fetchquestion($sth,$Q[$_],1); 881: $q{$Q[$_]{'QuestionId'}}=$Q[$_]; 882: } 883: 884: for (my $i = $first; $i <= $last; $i++) { 885: my $q=$q{$$Questions[$i-1]}; 886: my $output; 887: $output = &PrintQuestion($dbh, $q, 1, 0, 1,0,1 ); 888: # if (param('metod') && (param('metod') eq 'rus' || param('metod') eq 'proxy')) 889: { 890: $output=~s/\b($shablon)\b/\<strong\>$1\<\/strong\>/gi; 891: $output=~s/($shablon)/\<strong\>$1\<\/strong\>/gi; 892: } 893: $Output.= $output; 894: } 895: $sth->finish; 896: 897: $Output.= "$nav".br."\n"; 898: return $Output; 899: } 900: 901: sub PrintSearch { 902: my $Output=''; 903: my ($dbh, $sstr, $metod,$was) = @_; 904: my $t=time; 905: $Output.= printform; 906: my @allnf; 907: my @Questions; 908: $was=0 if $metod eq 'proxy'; 909: if ($usewas && $was && ($metod ne 'proxy')) 910: { 911: my $sth=$dbh->prepare ("select sstr,questions,allnf from lastqueries where id=".param('was')); 912: $sth->execute; 913: my ($q,$nf); 914: ($sstr, $q,$nf)=($sth->fetchrow); 915: @Questions=unpack 'L*',$q; 916: @allnf=unpack 'L*',$nf; 917: $sth->finish; 918: } 919: if (!$was || ($metod eq 'proxy') || (param('first')+$outputkvo>$cashednumber)) 920: { 921: @Questions=&Search($dbh, \$sstr,$metod,$all,\@allnf); 922: $cashednumber=$#Questions if $cashednumber>$#Questions; 923: my $tmp=$dbh->quote(pack("L*",@Questions[0..$cashednumber])); 924: my $qsstr=$dbh->quote($sstr); 925: my $nf=$dbh->quote(pack("L*", @allnf)); 926: my $ss=200; 927: if ($usewas) { 928: do 929: { 930: $was=int rand(32000); 931: } 932: while (--$ss && (!$dbh->do ("insert into lastqueries (id,sstr,questions,allnf) 933: values ($was, $qsstr,$tmp,$nf)"))); 934: $Output.= "Something is wrong...".br unless $ss; 935: } 936: } 937: 938: 939: 940: $Output.= p. "Время поиска: " . (time-$t) ." сек.".p; 941: my ($output, $i, $suffix, $hits) = ('', 0, '', $#Questions + 1); 942: 943: my $shablon; 944: $metod='rus' if $metod eq 'proxy'; 945: if ($metod eq 'rus') 946: { 947: my $where='0'; 948: $where.= " or w2=$_ " foreach @allnf; 949: my $query="select w1 from nests where $where"; 950: my $sth=$dbh->prepare($query); 951: 952: $sth->execute; 953: my @shablon; 954: while (my @arr = $sth->fetchrow) 955: { 956: push @shablon,"(?:$arr[0])"; 957: } 958: $sth->finish; 959: $shablon= join "|", @shablon; 960: $shablon=~s/[её]/\[ЕЁ\]/gi; 961: # $shablon=~s/([йцукенгшщзхъфывапролджэячсмитьбюЙЦУКЕНГШЩЗХЪФЫВАПРОЛДЖЭЯЧСМИТЬБЮ])/&NoCase($1)/ge; 962: $shablon=qr/$shablon/i; 963: 964: } 965: 966: $hits=param("fkvo")||$hits; 967: 968: if ($hits =~ /1.$/ || $hits =~ /[5-90]$/) { 969: $suffix = 'й'; 970: } elsif ($hits =~ /1$/) { 971: $suffix = 'е'; 972: } else { 973: $suffix = 'я'; 974: } 975: 976: $Output.= p({align=>"center"}, "Результаты поиска на " . strong($sstr) 977: . " : $hits попадани$suffix."); 978: 979: if (param('word')) { 980: $sstr = '[ \.\,:;]' . $sstr . '[ \.\,:\;]'; 981: } 982: 983: # $sstr =~ s/(.)/&NoCase($1)/ge; 984: 985: my @sar; 986: if ($metod ne 'rus') 987: { 988: my $ss=$sstr; 989: (@sar) = split(' ', $ss); 990: s/(\W)/\\$1/g foreach (@sar); 991: $shablon=join "|",@sar; 992: } 993: $Output.=PrintList($dbh,\@Questions,$shablon,$was); 994: return $Output; 995: } 996: 997: sub PrintRandom { 998: my ($dbh, $type, $num, $text) = @_; 999: my $razd=param('razd'); 1000: my %q; 1001: my $answer=$razd?0:1; 1002: my @answers; 1003: #my $t=time; 1004: my (@Questions) = &Get12Random($dbh, $type, $num); 1005: 1006: my ($output, $i) = ('', 0); 1007: #$output.="time=".(time-$t).p; 1008: if ($text) { 1009: $output .= " $num случайных вопросов.\n\n"; 1010: } else { 1011: $output .= 1012: h2({align=>"center"}, "$num случайных вопросов."); 1013: } 1014: my $sth=SelectQuestions($dbh,\@Questions,0); 1015: for ($i = 0; $i <= $#Questions; $i++) { 1016: fetchquestion($sth,\%q,0); 1017: $output .= 1018: &PrintQuestion($dbh, \%q, $answer, $i + 1, 0, $text,1); 1019: push @answers, $q{'Answer'}; 1020: } 1021: $sth->finish; 1022: unless ($answer ) 1023: { 1024: $output.=$text?"\n".('-'x 20)."\nОтветы\n~~~~~~\n\n":h2('Ответы'); 1025: $sth=SelectQuestions($dbh,\@Questions,0); 1026: for ($i = 0; $i <= $#Questions; $i++) { 1027: # fetchquestion($sth,\%q,0); 1028: # $output .= 1029: # &PrintQuestion($dbh, \%q, -1, $i + 1, 0, $text,1); 1030: $output.=$text?("Ответ ". ($i+1).": $answers[$i]\n\n"): 1031: b("Ответ ". ($i+1).": "). $answers[$i].p; 1032: } 1033: } 1034: 1035: return $output; 1036: } 1037: 1038: sub PrintEditor { 1039: my $t=shift; #ссылка на Хэш с полями 1040: my $ed=$$t{'Editors'}||''; 1041: my $edname=($ed=~/\,/ ) ? "Редакторы" : "Редактор" ; 1042: return $ed? h4({align=>"center"},"$edname: $ed" ): ''; 1043: } 1044: 1045: sub PrintTournament { 1046: my ($dbh, $Id, $answer) = @_; 1047: my (%Tournament, @Tours, $i, $list, $qnum, $imgsrc, $alt, 1048: $SingleTour); 1049: my ($output) = ''; 1050: 1051: %Tournament = &GetTournament($dbh, $Id) if ($Id); 1052: 1053: my ($URL) = $Tournament{'URL'}||''; 1054: $URL=~s/http:\/znatoki\/boris\/reports\//$newsurl/ if $url=~/kulichki/ || $url=~/db.chgk.info/; 1055: $URL=~s/\/znatoki\/boris\/reports\//$newsurl/ if url=~/kulichki/ || $url=~/db.chgk.info/; 1056: my ($Info) = $Tournament{'Info'}; 1057: my ($Copyright) = $Tournament{'Copyright'}; 1058: my $fname=$Tournament{'FileName'}; 1059: @Tours = &GetTours($dbh, $Id); 1060: $list=''; 1061: my $textid; 1062: if ($Id) { 1063: for ($Tournament{'Type'}) { 1064: /Г/ && do { 1065: $output .= h2({align=>"center"}, 1066: "Группа: $Tournament{'Title'} ", 1067: $Tournament{'PlayedAt'}||'') . p . "\n"; 1068: last; 1069: }; 1070: /Ч/ && do { 1071: return &PrintTour($dbh, $Tours[0], $answer) 1072: if ($#Tours == 0); 1073: 1074: my $title="Пакет: $Tournament{'Title'}"; 1075: if ($Tournament{'PlayedAt'}) { 1076: $title .= " $Tournament{'PlayedAt'}"; 1077: } 1078: 1079: $output .= h2({align=>"center"}, 1080: "$title") . p . "\n"; 1081: $output.=&PrintEditor(\%Tournament); 1082: last; 1083: }; 1084: /Т/ && do { 1085: return &PrintTour($dbh, $Id, $answer); 1086: }; 1087: } 1088: } else { 1089: my ($qnum) = GetQNum($dbh,0); 1090: my ($qnum1) = GetQNum($dbh,1); 1091: $output .= h2("База вопросов"). 1092: h3("$qnum запис".&Suffix2($qnum). 1093: " (уникальных $qnum1)"); 1094: 1095: # h4("<table>". 1096: # Tr(td("Из них:"), td("Вопросов ЧГК: ".countz($dbh,'Ч'))). 1097: # Tr(td(" "), td("Вопросов для брейна: ".countz($dbh,'Б'))). 1098: # Tr(td(" "), td("Вопросов для ЧГК и брейна: ".countz($dbh,'ЧБ'))). 1099: # Tr(td(" "), td("Интернет-вопросов: ".countz($dbh,'И'))). 1100: # Tr(td(" "), td("Бескрылок: ".countz($dbh,'Л'))). 1101: # Tr(td(" "),td("Заданий для Своей Игры: ".countz($dbh,'Я'))). 1102: # Tr(td(" "),td("Эрудиток: ".countz($dbh,'Э'))))."</table>" 1103: } 1104: 1105: for ($i = 0; $i <= $#Tours; $i++) { 1106: %Tournament = &GetTournament($dbh, $Tours[$i]); 1107: 1108: if ($Tournament{'Type'} =~ /Ч/) { 1109: $SingleTour = 0; 1110: my (@Tours) = &GetTours($dbh, $Tournament{'Id'}); 1111: $SingleTour = 1 1112: if ($#Tours == 0); 1113: } 1114: if ($Tournament{'QuestionsNum'} > 0) { 1115: $qnum = " ($Tournament{'QuestionsNum'} вопрос" . 1116: &Suffix($Tournament{'QuestionsNum'}) . ")\n"; 1117: } else { 1118: $qnum = ''; 1119: } 1120: if ($Tournament{'Type'} !~ /[ТЧ]/) { 1121: $SingleTour=0; 1122: $imgsrc = "/icons/folder.gif"; 1123: $alt = "[*]"; 1124: } else { 1125: $imgsrc = "/icons/folder.gif"; 1126: $alt = "[-]"; 1127: } 1128: 1129: my $textid; 1130: if ($textid=$Tournament{'FileName'}) 1131: { 1132: $textid=~s/\.txt//; 1133: } 1134: elsif ($textid=$Tournament{'Number'}) 1135: { 1136: $fname=~s/\.txt//; 1137: $textid="$fname.$textid"; 1138: } 1139: else {$textid=$Tournament{'Id'}}; 1140: 1141: 1142: if ($SingleTour or ($Tournament{'Type'} =~ /Т/)) { 1143: $list .= dd(img({src=>$imgsrc, alt=>$alt}) 1144: . " " . $Tournament{'Title'} . " " . 1145: ($Tournament{'PlayedAt'}||"") . $qnum) . 1146: dl( 1147: dd("[" 1148: . a({href=>tourhref($textid,0)}, 1149: "вопросы") . "] [" 1150: . a({href=>tourhref($textid,1)}, 1151: "вопросы + ответы") . "]") 1152: ); 1153: } else { 1154: $list .= dd(a({href=> 1155: $url . "?tour=$textid&comp=1"}, 1156: img({src=>'/icons/compressed.gif', alt=>'[ZIP]', border=>1})) . 1157: " " . 1158: img({src=>$imgsrc, alt=>$alt}) 1159: . " " . a({href=>tourhref($textid,0,1)}, 1160: $Tournament{'Title'}. " ". 1161: ($Tournament{'PlayedAt'}||'')) . $qnum); 1162: } 1163: } 1164: $output .= dl($list); 1165: 1166: if ($URL) { 1167: if ($url=~/zaba\.ru/ && $URL=~/^\//){$URL="http://info.chgk.info$URL"} 1168: $output .= 1169: p("Дополнительная информация об этом турнире - по адресу " . 1170: a({-'href'=>$URL}, $URL)); 1171: } 1172: 1173: if ($Copyright) { 1174: $output .= p("Копирайт: " . $Copyright); 1175: } 1176: 1177: 1178: 1179: if ($Info) { 1180: $output .= p($Info); 1181: } 1182: return $output; 1183: } 1184: 1185: sub Suffix { 1186: my ($qnum) = @_; 1187: my ($suffix) = 'а' if $qnum =~ /[234]$/; 1188: $suffix = '' if $qnum =~ /1$/; 1189: $suffix = 'ов' if $qnum =~ /[567890]$/ || $qnum =~ /1.$/; 1190: return $suffix; 1191: } 1192: 1193: 1194: sub Suffix1 { 1195: my ($qnum) = @_; 1196: my ($suffix) = 'я' if $qnum =~ /[234]$/; 1197: $suffix = 'е' if $qnum =~ /1$/; 1198: $suffix = 'й' if $qnum =~ /[567890]$/ || $qnum =~ /1.$/; 1199: return $suffix; 1200: } 1201: 1202: sub Suffix2 { 1203: my ($qnum) = @_; 1204: my ($suffix) = 'и' if $qnum =~ /[234]$/; 1205: $suffix = 'ь' if $qnum =~ /1$/; 1206: $suffix = 'ей' if $qnum =~ /[567890]$/ || $qnum =~ /1.$/; 1207: return $suffix; 1208: } 1209: 1210: sub IsTour { 1211: my ($dbh, $Id,$n) = @_; 1212: 1213: my ($sth) ; 1214: 1215: if (defined $n) 1216: { $sth=$dbh->prepare ("select Id FROM Tournaments 1217: WHERE ParentId=$Id AND Number=$n"); 1218: } 1219: else 1220: { 1221: $sth=$dbh->prepare("SELECT Id FROM Tournaments 1222: WHERE Id=$Id"); 1223: } 1224: $sth->execute; 1225: my $a=($sth->fetchrow)[0]; 1226: $sth->finish; 1227: return $a; 1228: } 1229: 1230: # Gets a DB handler (ofcourse) and a tour Id. Prints all the 1231: # question of that tour, according to the options. 1232: sub PrintTour { 1233: my ($dbh, $Id, $answer) = @_; 1234: my ($output, $q, $bottom, $field) = ('', 0, '', ''); 1235: 1236: my (%Tour) = &GetTournament($dbh, $Id); 1237: my (@Tours) = &GetTours($dbh, $Tour{'ParentId'}); 1238: my (%Tournament) = &GetTournament($dbh, $Tour{'ParentId'}); 1239: my %q; 1240: 1241: return 0 1242: if ($Tour{'Type'} !~ /Т/); 1243: 1244: my ($fname)=$Tournament{'FileName'}; 1245: $fname=~s/\.txt//; 1246: my ($qnum) = $Tour{'QuestionsNum'}; 1247: my ($suffix) = &Suffix($qnum); 1248: 1249: $output .= h2({align=>"center"}, $Tournament{"Title"}, 1250: $Tournament{'PlayedAt'}||'', 1251: "<br>", $Tour{"Title"} . 1252: " ($qnum вопрос$suffix)\n") . p; 1253: $output .=&PrintEditor(\%Tour); 1254: 1255: my (@Questions) = &GetTourQuestions($dbh, $Id); 1256: my $sth=SelectQuestions($dbh,\@Questions,0); 1257: for ($q = 0; $q <= $#Questions; $q++) { 1258: fetchquestion($sth,\%q,0); 1259: $output .= &PrintQuestion($dbh, \%q, $answer, 0,0,0,1); 1260: } 1261: $sth->finish; 1262: $output .= hr({-'align'=>'center', -'width'=>'80%'}); 1263: 1264: if ($Tournament{'URL'}) { 1265: $output .= 1266: p("Дополнительная информация об этом турнире - по адресу " . 1267: a({-'href'=>$Tournament{'URL'}}, $Tournament{'URL'})); 1268: } 1269: 1270: if ($Tournament{'Copyright'}) { 1271: $output .= p("Копирайт: " . $Tournament{'Copyright'}); 1272: } 1273: 1274: if ($Tournament{'Info'}) { 1275: $output .= p($Tournament{'Info'}); 1276: } 1277: 1278: my $n=$Tour{'Number'}; 1279: if ($answer == 0) { 1280: my $nn=".$n"; 1281: $nn="" if ($n==1 && !&IsTour($dbh, $Tour{'ParentId'}, $n + 1)); 1282: 1283: $bottom .= 1284: "[" . a({href=>tourhref("$fname$nn",1)}, 1285: "ответы") . "] " . br; 1286: } 1287: if ($n>1) { 1288: $bottom .= 1289: "[" . a({href=>tourhref("$fname.".($n-1),0)}, 1290: "предыдущий тур") . "] "; 1291: $bottom .= 1292: "[" . a({href=>tourhref("$fname.".($n-1),1)}, 1293: "предыдущий тур с ответами") . "] " . br; 1294: } 1295: if (&IsTour($dbh, $Tour{'ParentId'}, $n + 1)) { 1296: $bottom .= 1297: "[" . a({href=>tourhref("$fname.".($n+1),0)}, 1298: "следующий тур") . "] "; 1299: $bottom .= 1300: "[" . a({href=>tourhref("$fname.".($n+1),1)}, 1301: "следующий тур с ответами") . "] "; 1302: } 1303: 1304: $output .= 1305: p({align=>"center"}, font({size=>-1}, $bottom)); 1306: 1307: return $output; 1308: } 1309: 1310: sub PrintField { 1311: my ($header, $value, $text) = @_; 1312: if ($text) { 1313: $value =~ s/<[\/\w]*?>//sg; 1314: } else { 1315: $value =~ s/^\s+/<br>    /mg; 1316: $value =~ s/(\s+)-+(\s+)/$1$2/mg; 1317: $value =~ s/\s+\&#0150/ \&#0150/mg 1318: if $value !~ /^\|/; 1319: $value =~ s/^\|([^\n]*)/<pre>$1<\/pre>/mg; 1320: $value =~ s/(http:\/\/\S+[^\s\)\(\,\.])/<a href="$1">$1<\/a>/g if $header !~ /^Авто/; 1321: # $value =~ s/(http:\/\/(?:\w+.)+[\w\\\~]+(\?[^\s.]+)?)/<a href="$1">$1<\/a>/g if $header !~ /^Авто/; 1322: # $value =~ s/(\s)"/$1/mg; 1323: # $value =~ s/^"//mg; 1324: # $value =~ s/"//mg; 1325: } 1326: 1327: 1328: return $text ? "$header:\n$value\n\n" : 1329: strong("$header: ") . $value . p . "\n"; 1330: } 1331: 1332: # Gets a DB handler (ofcourse) and a question Id. Prints 1333: # that question, according to the options. 1334: sub PrintQuestion { 1335: my ($dbh, $Id, $answer, $qnum, $title, $text,$h) = @_; 1336: my ($output, $titles) = ('', ''); 1337: my (%Question); 1338: if ($h) { 1339: %Question=%$Id; 1340: } else { 1341: %Question = &GetQuestion($dbh, $Id); 1342: if ($title) { 1343: my (%Tour) = GetTournament($dbh, $Question{'ParentId'}); 1344: my (%Tournament) = GetTournament($dbh, $Tour{'ParentId'}); 1345: $Question{'FileName'}=$Tournament{'FileName'}; 1346: $Question{'Title'}=$Tournament{'Title'}; 1347: $Question{'PlayedAt'}=$Tournament{'PlayedAt'}; 1348: $Question{'TourNumber'}=$Tour{'Number'}; 1349: $Question{'TourTitle'}=$Tour{'Title'}; 1350: } 1351: 1352: } 1353: $qnum = $Question{'Number'} 1354: if ($qnum == 0); 1355: if (!$text) { 1356: $output .= hr({width=>"50%"}) if $answer>=0; 1357: if ($title) { 1358: my $fname=$Question{'FileName'}; 1359: $fname=~s/\.txt//; 1360: $titles .= 1361: dd(img({src=>"/icons/folder.open.gif"}) . " " . 1362: a({href=>tourhref($fname,0,1)}, 1363: $Question{'Title'}, $Question{'PlayedAt'}||'')); 1364: $titles .= 1365: dl(dd(img({src=>"/icons/folder.open.gif"}) . " " . 1366: a({href=>tourhref("$fname.$Question{'TourNumber'}#$qnum",1)}, 1367: $Question{'TourTitle'}))); 1368: } 1369: $output .= dl(strong($titles)); 1370: } 1371: 1372: 1373: $output.= "<a NAME=\"$qnum\">" unless $text; 1374: 1375: if ($answer>=0) {$output .= 1376: &PrintField("Вопрос $qnum", $Question{'Question'}, $text);} 1377: else {$output .="$qnum. "} 1378: if ($answer==1|| $answer==-1) { 1379: $output .= 1380: &PrintField("Ответ", $Question{'Answer'}, $text); 1381: 1382: if ($Question{'Authors'} ) { 1383: my $q=$Question{'Authors'}; 1384: ###АВТОРА!! 1385: # my $sth=$dbh->prepare("select Authors.CharId,Name, Surname, Nicks from Authors, A2Q 1386: # where Authors.Id=Author And Question=$Id"); 1387: # $sth->execute; 1388: # my ($AuthorId,$Name, $Surname,$other,$Nicks); 1389: # if (!$text) { 1390: # while ((($AuthorId,$Name, $Surname,$Nicks)=$sth->fetchrow),$AuthorId) 1391: # { 1392: # my ($firstletter)=$Name=~m/^./g; 1393: # $Name=~s/\./\\\./g; 1394: # $Name=~s/ё/[её]/g; 1395: # $Surname=~s/ё/[её]/g; 1396: # my $sha="(?:$Name\\s+$Surname)|(?:$Surname\\s+$Name)|(?:$firstletter\\.\\s*$Surname)|(?:$Surname\\s+$firstletter\\.)|(?:$Surname)"; 1397: # if ($Nicks) 1398: # { 1399: # $Nicks=~s/^\|//; 1400: # foreach (split /\|/, $Nicks) 1401: # { 1402: # s/\s+/ /g; 1403: # s/\s+$//; 1404: # s/ /\\s+/g; 1405: # s/\./\\\./g; 1406: # if (s/>$//) {$sha="$sha|(?:$_)"} 1407: # else {$sha="(?:$_)|$sha"} 1408: # } 1409: # } 1410: # $q=~s/($sha)/a({href=>url."?qofauthor=$AuthorId"},$1)/ei; 1411: # unless ($1) 1412: # { 1413: # $q=~s/$Name/a({href=>url."?qofauthor=$AuthorId"},$1)/ei; 1414: # } 1415: # } 1416: # } 1417: $output .= &PrintField("Автор(ы)", $q, $text); 1418: 1419: } 1420: 1421: if ($Question{'Sources'}) { 1422: $output .= &PrintField("Источник(и)", $Question{'Sources'}, $text); 1423: } 1424: 1425: if ($Question{'Comments'}) { 1426: $output .= &PrintField("Комментарии", $Question{'Comments'}, $text); 1427: } 1428: } 1429: elsif ($answer==2) { 1430: my $text=$Question{'Answer'}; 1431: $text=~s/\n/<option>/mg; 1432: $output.="<select><option selected>Ответ:<option>$text</select>"; 1433: $text=$Question{'Comments'}||''; 1434: if ($text) { 1435: $text=~s/\n/<option>/mg; 1436: $output.="<select><option selected>Комментарий:<option>$text</select>" 1437: } 1438: } 1439: elsif ($answer==3) { 1440: $output.= <<EOTT 1441: <div align=right STYLE="cursor:hand;" OnStart="toggle(document.all.HideShow$qnum);" OnClick="toggle(document.all.HideShow$qnum);"> 1442: <font size=-2 color=red> Показать/убрать ответ</font></div> 1443: <span style="display:none" id=HideShow$qnum> 1444: EOTT 1445: .&PrintField("Ответ", $Question{'Answer'}, $text); 1446: if ($Question{'Authors'}) { 1447: $output .= &PrintField("Автор(ы)", $Question{'Authors'}, $text); 1448: } 1449: if ($Question{'Sources'}) { 1450: $output .= &PrintField("Источник(и)", $Question{'Sources'}, $text); 1451: } 1452: 1453: if ($Question{'Comments'}) { 1454: $output .= &PrintField("Комментарии", $Question{'Comments'}, $text); 1455: } 1456: 1457: 1458: 1459: $output.="</span>" 1460: 1461: } 1462: $output=~s/$pic: ([^$]*)\)/<p><img src="\/znatoki\/images\/db\/$1"><p>/g unless $text; 1463: $paramtour||=param("tour"); 1464: my $qid=$paramtour ? ($paramtour.".$Question{'Number'}" ): ''; 1465: 1466: $output.=br.a({href=> $url."?metod=proxy& 1467: qid=$qid"}, 'Близкие вопросы').p 1468: if $answer>0 && !$text && $qid; 1469: return $output; 1470: } 1471: 1472: # Returns the total number of questions currently in the DB. 1473: sub GetQNum { 1474: my ($dbh,$x) = @_; 1475: my ($sth) = $dbh->prepare("SELECT COUNT(*) FROM Questions"); 1476: $sth->execute; 1477: my $tmp=($sth->fetchrow)[0]; 1478: $sth->finish; 1479: ($sth)= $dbh -> prepare("select distinct count(first) FROM equalto"); 1480: $sth -> execute; 1481: my ($c)=$sth->fetchrow; 1482: 1483: # $i++ while ( my ($first, $second)=$sth -> fetchrow) 1484: # { 1485: # $forbidden{$first}=1; 1486: # } 1487: $sth->finish; 1488: 1489: return $tmp-($x?$c:0); 1490: } 1491: sub GetMaxQId { 1492: my ($dbh) = @_; 1493: my ($sth) = $dbh->prepare("SELECT MAX(QuestionId) FROM Questions"); 1494: $sth->execute; 1495: my $tmp=($sth->fetchrow)[0]; 1496: $sth->finish; 1497: return $tmp; 1498: 1499: } 1500: 1501: # Returns Id's of 12 random questions 1502: sub Get12Random { 1503: my ($dbh, $type, $num) = @_; 1504: my ($i, @questions, $q, $t, $sth); 1505: my ($qnum) = &GetMaxQId($dbh); 1506: my (%chosen); 1507: srand; 1508: my $where=0; 1509: my $r=int (rand(10000)); 1510: my $w1=$r<5000? "QuestionId<50000 ":"QuestionId>=50000"; 1511: $w1=1 if $url=~/zaba/; 1512: $w1=1 if $type!~/Ч/; 1513: foreach (split '', $type) 1514: { 1515: $where.= " OR (Type ='$_') OR (Type ='$_Д') "; 1516: } 1517: $where.= "OR (Type='ЧБ')" if ($type=~/Ч|Б/); 1518: 1519: # $q="select QuestionId, QuestionId/$r-floor(QuestionId/$r) as val 1520: # from Questions where $where order by val limit $num"; 1521: # Когда на куличках появится mysql >=3.23 надо заменить на order by rand(); 1522: $q="select QuestionId from Questions where ($w1) AND ($where) order by rand() limit $num"; 1523: 1524: 1525: $sth=$dbh->prepare($q); 1526: $sth->execute; 1527: while (($i)=$sth->fetchrow) 1528: { 1529: push @questions,$i; 1530: } 1531: $sth->finish; 1532: for ($i=@questions; --$i;){ 1533: my $j=rand ($i+1); 1534: @questions[$i,$j]=@questions[$j,$i] unless $i==$j; 1535: } 1536: return @questions; 1537: } 1538: 1539: sub Include_virtual { 1540: my ($fn, $output) = (@_, ''); 1541: return "\n\n" if ($opt_z); 1542: open F , $fn 1543: or return ""; #die "Can't open the file $fn: $!\n"; 1544: 1545: while (<F>) { 1546: if (//&Include_virtual($1)/e; 1548: } 1549: if (//`$1`/e; 1551: } 1552: $output .= $_; 1553: } 1554: return $output||""; 1555: } 1556: 1557: sub PrintArchive { 1558: my($dbh, $Id) = @_; 1559: my ($output, @list, $i); 1560: 1561: my (%Tournament) = &GetTournament($dbh, $Id); 1562: my (@Tours) = &GetTours($dbh, $Id); 1563: if ($Tournament{'Type'} =~ /Г/ || $Id == 0) { 1564: for ($i = 0; $i <= $#Tours; $i++) { 1565: push(@list ,&PrintArchive($dbh, $Tours[$i])); 1566: } 1567: return @list; 1568: } 1569: # return "$SRCPATH/$Tournament{'FileName'} "; 1570: return "$TMPDIR/$Tournament{'FileName'} "; 1571: } 1572: 1573: sub PrintAll { 1574: my ($dbh, $Id,$fname) = @_; 1575: my ($output, $list, $i); 1576: 1577: my (%Tournament) = &GetTournament($dbh, $Id); 1578: my (@Tours) = &GetTours($dbh, $Id); 1579: my $SingleTour = $#Tours == 0; 1580: 1581: my ($New) = ($Id and $Tournament{'Type'} eq 'Ч' and 1582: &NewEnough($Tournament{"CreatedAt"})) ? 1583: img({src=>"/znatoki/dimrub/db/new-sml.gif", alt=>"NEW!"}) : ""; 1584: 1585: if ($Id == 0) { 1586: $output = h3("Все турниры"); 1587: } else { 1588: my $textid; 1589: if ($textid=$Tournament{'FileName'}) 1590: { 1591: $textid=~s/\.txt//; 1592: } 1593: elsif ($textid=$Tournament{'Number'}) 1594: { 1595: $fname=~s/\.txt//; 1596: $textid="$fname.$textid"; 1597: } 1598: else {$textid=$Tournament{'Id'}}; 1599: 1600: 1601: $output .= dd(img({src=>"/icons/folder.gif", alt=>"[*]"}) . 1602: " " . a({href=>tourhref($textid,0,!$SingleTour)}, 1603: $Tournament{'Title'}) ." " . ($Tournament{'PlayedAt'}||'') . " $New"); 1604: } 1605: if ($Id == 0 or $Tournament{'Type'} =~ /Г/ or $Tournament{'Type'} eq '') { 1606: for ($i = 0; $i <= $#Tours; $i++) { 1607: $list .= &PrintAll($dbh, $Tours[$i],$Tournament{'FileName'}); 1608: } 1609: $output .= dl($list); 1610: } 1611: return $output; 1612: } 1613: 1614: sub PrintDates { 1615: my ($dbh) = @_; 1616: my ($from) = param('from_year') . "-" . param('from_month') . 1617: "-" . param('from_day'); 1618: my ($to) = param('to_year') . "-" . param('to_month') . "-" . param('to_day'); 1619: $from = $dbh->quote($from); 1620: $to = $dbh->quote($to); 1621: my ($sth) = $dbh->prepare(" 1622: SELECT DISTINCT Id 1623: FROM Tournaments 1624: WHERE PlayedAt >= $from AND PlayedAt <= $to 1625: AND Type = 'Ч' 1626: "); 1627: $sth->execute; 1628: my (%Tournament, @array, $output, $list); 1629: 1630: $output = h3("Список турниров, проходивших между $from и $to."); 1631: while (@array = $sth->fetchrow) { 1632: next 1633: if (!$array[0]); 1634: %Tournament = &GetTournament($dbh, $array[0]); 1635: my $textid; 1636: if ($textid=$Tournament{'FileName'}) 1637: { 1638: $textid=~s/\.txt//; 1639: } 1640: elsif ($textid=$Tournament{'Number'}) 1641: { 1642: $fname=~s/\.txt//; 1643: $textid="$fname.$textid"; 1644: } 1645: else {$textid=$Tournament{'Id'}}; 1646: $list .= dd(img({src=>"/icons/folder.gif", alt=>"[*]"}) . 1647: " " . a({href=>tourhref($textid,0,1)}, 1648: $Tournament{'Title'}, $Tournament{'PlayedAt'}||'')); 1649: } 1650: $sth->finish; 1651: $output .= dl($list); 1652: return $output; 1653: } 1654: 1655: sub PrintQOfAuthor 1656: { 1657: 1658: my ($dbh, $id) = @_; 1659: my $Output=''; 1660: unless ($id=~/^\d+$/) { 1661: $id=$dbh->quote($id); 1662: my $sth = $dbh->prepare("SELECT Id FROM Authors WHERE CharId=$id"); 1663: $sth->execute; 1664: ($id)=$sth->fetchrow; 1665: $sth->finish; 1666: } 1667: $id=$dbh->quote($id); 1668: 1669: my $sth = $dbh->prepare("SELECT Name, Surname FROM Authors WHERE Id=$id"); 1670: $sth->execute; 1671: my ($name,$surname)=$sth->fetchrow; 1672: 1673: $sth = $dbh->prepare("SELECT Question FROM A2Q WHERE Author=$id"); 1674: $sth->execute; 1675: my $q; 1676: my @Questions; 1677: while (($q)=$sth->fetchrow,$q) 1678: {push @Questions,$q unless $forbidden{$q}} 1679: $sth->finish; 1680: 1681: my ($output, $i, $suffix, $hits) = ('', 0, '', $#Questions + 1); 1682: 1683: if ($hits =~ /1.$/ || $hits =~ /[5-90]$/) { 1684: $suffix = 'й'; 1685: } elsif ($hits =~ /1$/) { 1686: $suffix = 'е'; 1687: } else { 1688: $suffix = 'я'; 1689: } 1690: $Output.= printform; 1691: $Output.= p({align=>"center"}, "Автор ".strong("$name $surname. ") 1692: . " : $hits попадани$suffix."); 1693: 1694: 1695: # for ($i = 0; $i <= $#Questions; $i++) { 1696: # $output = &PrintQuestion($dbh, $Questions[$i], 1, $i + 1, 1); 1697: # print $output; 1698: # } 1699: $Output.=PrintList($dbh,\@Questions,'gdfgdfgdfgdfg'); 1700: } 1701: 1702: 1703: sub PrintAuthors 1704: { 1705: my ($dbh,$sort)=@_; 1706: my($output,$out1,@array,$sth); 1707: if ($sort eq 'surname') 1708: { 1709: $sth = 1710: $dbh->prepare("SELECT Id, Name, Surname, QNumber FROM Authors order by Surname, Name"); 1711: } 1712: elsif($sort eq 'name') 1713: { 1714: $sth = 1715: $dbh->prepare("SELECT Id, Name, Surname, QNumber FROM Authors order by Name, Surname"); 1716: } 1717: else 1718: { 1719: $sth = 1720: $dbh->prepare("SELECT Id, Name, Surname, QNumber FROM Authors Order by QNumber DESC, Surname"); 1721: } 1722: 1723: $output.=h2("Авторы вопросов")."\n"; 1724: $output.="<TABLE>"; 1725: 1726: 1727: $sth->execute; 1728: $output.=Tr(th[a({href=>$url."?authors=name"},"Имя") 1729: .", ". 1730: a({href=>$url."?authors=surname"},"фамилия") 1731: , a({href=>$url."?authors=kvo"},"Количество вопросов")]); 1732: 1733: $out1=''; 1734: 1735: my $ar=$sth->fetchall_arrayref; 1736: 1737: $sth->finish; 1738: 1739: 1740: foreach my $arr(@$ar) 1741: { 1742: 1743: my ($id,$name,$surname,$kvo)=@$arr; 1744: if (!$name || !$surname) { 1745: } else 1746: { 1747: my $add=Tr(td([a({href=>$url."?qofauthor=$id"},"$name $surname"), $kvo]))."\n"; 1748: $output.=$add; 1749: } 1750: } 1751: $output.="</TABLE>"; 1752: $sth->finish; 1753: return $output; 1754: } 1755: 1756: 1757: sub WriteFile { 1758: my ($dbh,$fname) = @_; 1759: $fname=~s/\s+$//; 1760: $fname=~s/^\s+//; 1761: $fname=~s/\.txt$//; 1762: $fname=~s/.*\/(\w+)/$1/; 1763: 1764: my $query= "SELECT Id, Title, Copyright, Info, URL, 1765: Editors, EnteredBy, PlayedAt, CreatedAt 1766: from Tournaments where FileName= 1767: '$fname' OR FileName=".$dbh->quote("$fname.txt"); 1768: my $sth=$dbh->prepare($query); 1769: my (%Question,%editor,%qnumber,%copyright,%author,%vid,%tourtitle); 1770: $sth->execute; 1771: my ($Id, $Title, $Copyright, $Info, $URL, 1772: $Editors, $EnteredBy, $PlayedAt, $CreatedAt)= 1773: $sth->fetchrow; 1774: return -1 unless $Id; 1775: open (OUT, ">$TMPDIR/$fname.txt") || print STDERR "Error in $fname.txt\n"; 1776: print OUT "Чемпионат:\n$Title\n\n"; 1777: my $date=$PlayedAt||'00-00-00'; 1778: my ($year,$month,$day)=split /-/, $date; 1779: # $month=0,$date=0 if $year && $month==1 && $day==1; 1780: my $pdate=sprintf("%02d-%3s-%4d",$day,$months[$month],$year); 1781: 1782: print OUT "Дата:\n$pdate\n\n" if $date; 1783: 1784: print OUT "URL:\n$URL\n\n" if $URL; 1785: 1786: print OUT "Инфо:\n$Info\n\n" if $Info; 1787: 1788: print OUT "Копирайт:\n$Copyright\n\n" if $Copyright; 1789: 1790: print OUT "Редактор:\n$Editors\n\n" if $Editors; 1791: 1792: 1793: $query= "SELECT Id, Title, Copyright, Editors from Tournaments where ParentId=$Id order by Id"; 1794: $sth=$dbh->prepare($query); 1795: $sth->execute; 1796: my ($tourid,$tourtitle,$cright,$editor,@tours,$vid,$author,$tourauthor); 1797: 1798: 1799: while (($tourid,$tourtitle,$cright,$editor)=$sth->fetchrow,$tourid) 1800: { 1801: # $text{$tourid}="Тур:\n$tourtitle\n\n"; 1802: $query= "SELECT * from Questions where ParentId=$tourid order by QuestionId"; 1803: my $sth1=$dbh->prepare($query); 1804: $sth1->execute; 1805: push(@tours,$tourid); 1806: $tourtitle{$tourid}=$tourtitle; 1807: $copyright{$tourid}=$cright; 1808: $editor{$tourid}=$editor; 1809: $vid=''; 1810: my $author=''; 1811: my $eqauthor=1; 1812: my $qnumber=0; 1813: my @arr; 1814: while ( (@arr=$sth1->fetchrow), $arr[0]) 1815: { 1816: my($i, $name); 1817: $i=0; 1818: $qnumber++; 1819: foreach $name (@{$sth1->{NAME}}) { 1820: if ($arr[$i]) { 1821: $arr[$i]=~s/^(.*?)\s*$/$1/; 1822: $Question{$tourid}[$qnumber]{$name} = $arr[$i]; 1823: } else { 1824: $Question{$tourid}[$qnumber]{$name} = 1825: ''} 1826: $i++; 1827: } 1828: if ($vid) 1829: { 1830: if ($vid ne $Question{$tourid}[$qnumber]{'Type'}) {print STDERR "Warning: Different types for Tournament $tourid\n"} 1831: } else 1832: { 1833: $vid=$Question{$tourid}[$qnumber]{'Type'}; 1834: } 1835: 1836: if ($author) 1837: { 1838: if ($author ne $Question{$tourid}[$qnumber]{'Authors'}) 1839: { 1840: $eqauthor=0; 1841: } 1842: } else 1843: { 1844: $author=$Question{$tourid}[$qnumber]{'Authors'}; 1845: $eqauthor=0 unless $author; 1846: } 1847: } 1848: $vid{$tourid}=$vid; 1849: $qnumber{$tourid}=$qnumber; 1850: $author{$tourid}=$eqauthor ? $author : ''; 1851: } 1852: 1853: 1854: $vid=''; 1855: my $eqvid=1; 1856: my $eqauthor=1; 1857: foreach (@tours) 1858: { 1859: $vid||=$vid{$_}; 1860: if ($vid{$_} ne $vid) 1861: { 1862: $eqvid=0; 1863: } 1864: $author||=$author{$_}; 1865: if (!$author{$_} || ($author{$_} ne $author)) 1866: { 1867: $eqauthor=0; 1868: } 1869: } 1870: 1871: print OUT "Вид:\n$vid\n\n" if $eqvid; 1872: print OUT "Автор:\n$author\n\n" if $eqauthor; 1873: 1874: foreach my $tour(@tours) 1875: { 1876: print OUT "Тур:\n$tourtitle{$tour}\n\n"; 1877: print OUT "Вид:\n$vid{$tour}\n\n" if !$eqvid; 1878: print OUT "Копирайт:\n$copyright{$tour}\n\n" if $copyright{$tour} && ($copyright{$tour} ne $Copyright); 1879: print OUT "Редактор:\n$editor{$tour}\n\n" if $editor{$tour} && ($editor{$tour} ne $Editors); 1880: $tourauthor=0; 1881: if (!$eqauthor && $author{$tour}) 1882: { 1883: print OUT "Автор:\n$author{$tour}\n\n"; 1884: $tourauthor=1; 1885: } 1886: foreach my $q(1..$qnumber{$tour}) 1887: { 1888: print OUT "Вопрос $q:\n".$Question{$tour}[$q]{'Question'}."\n\n"; 1889: print OUT "Ответ:\n".$Question{$tour}[$q]{'Answer'}."\n\n"; 1890: print OUT "Автор:\n".$Question{$tour}[$q]{'Authors'}."\n\n" 1891: if !$tourauthor && !$eqauthor && $Question{$tour}[$q]{'Authors'}; 1892: print OUT "Комментарий:\n".$Question{$tour}[$q]{'Comments'}."\n\n" 1893: if $Question{$tour}[$q]{'Comments'}; 1894: print OUT "Источник:\n".$Question{$tour}[$q]{'Sources'}."\n\n" 1895: if $Question{$tour}[$q]{'Sources'}; 1896: print OUT "Рейтинг:\n".$Question{$tour}[$q]{'Rating'}."\n\n" 1897: if $Question{$tour}[$q]{'Rating'}; 1898: 1899: } 1900: } 1901: 1902: close OUT; 1903: 1904: 1905: 1906: } 1907: 1908: sub Bottom 1909: { 1910: my $output.=&Include_virtual("$footer")||""; 1911: $output.=p."<center><font size=-2>Обновление: ".&Include_virtual("$datefooter")."</center></font>"; 1912: $output.=<<EEE 1913: <SCRIPT LANGUAGE="JavaScript"> 1914: function toggle(e) { 1915: if (e.style.display == "none") { 1916: e.style.display=""; 1917: } else { 1918: e.style.display = "none"; 1919: } 1920: } 1921: </SCRIPT> 1922: EEE 1923: ; 1924: $output.=end_html; 1925: return $output; 1926: } 1927: 1928: 1929: MAIN: 1930: { 1931: 1932: setlocale(LC_CTYPE,'russian'); 1933: POSIX::setlocale( &POSIX::LC_ALL, $thislocale ); 1934: my($i, $tour); 1935: my($text) = (param('text')) ? 1 : 0; 1936: $tour = (param('tour')) ? param('tour') : 0; 1937: my $texttour=$tour; 1938: my ($sth,$dbh); 1939: my($dsn) = "DBI:mysql:database=$dbname;host=$dbhost"; 1940: $dbh = DBI->connect($dsn, $dbuser, $dbpass) 1941: # $dbh = DBI->connect("DBI:mysql:$dbname", $username, $dbpass) 1942: or do { 1943: print header.h1("Временные проблемы") . "База вопросов временно не 1944: работает. Заходите попозже."; 1945: print &Include_virtual("$reklama") if $url!~/localhost/; 1946: print end_html; 1947: die "Can't connect to DB chgk\n"; 1948: }; 1949: 1950: 1951: if (param('qid') && (param('qid')=~/^\d+$/) || $tour && $tour=~/^\d+$/) { 1952: my $destination='http://chgk.zaba.ru/search.html'; 1953: # print header (-'Content-Type' => 'text/html', 1954: # -'Location:'=> 'http:\\db.chgk.info'); 1955: Redirect($destination); 1956: exit 1957: } 1958: 1959: if ($tour && !param('qnumber') && (!param('answers')||(param('answers')<=1))) 1960: { 1961: my $n=param('tour'); 1962: $n=~s/.txt$//; 1963: my $gr=($n=~/^[A-Z]/) || (-e "$realHTMLDIR$n.html"); 1964: my $destination=tourhref($tour,param('answers')||0,$gr); 1965: my $d=$destination; 1966: $d=~s/$HTMLDIR/$realHTMLDIR/; 1967: # print header.$destination; 1968: # print header."$d|".(-e "$realHTMLDIR$n.html"); 1969: if (-e $d) { 1970: Redirect($destination); 1971: exit 1972: } 1973: $d=~s/\.\d+//; 1974: $destination=~s/\.\d+//; 1975: if (-e $d) { 1976: Redirect($destination); 1977: exit 1978: } 1979: 1980: } 1981: 1982: if ($tour !~ /^[0-9]*$/) { 1983: if ($tour=~/\./) 1984: { 1985: my ($fname,$n)= split /\./ , $tour; 1986: 1987: $sth = $dbh->prepare( 1988: "SELECT t2.Id FROM Tournaments as t1, 1989: Tournaments as t2 1990: WHERE (t1.FileName = '$fname.txt' OR t1.FileName='$fname') 1991: AND t1.Id=t2.ParentId AND t2.Number=$n"); 1992: } 1993: else 1994: { 1995: $sth = $dbh->prepare("SELECT Id FROM Tournaments 1996: WHERE FileName = '$tour.txt' OR 1997: FileName = '$tour'"); 1998: } 1999: $sth->execute; 2000: $tour = ($sth->fetchrow)[0]; 2001: $sth->finish; 2002: } 2003: 2004: 2005: if ($text && !param ('comp')) { 2006: print header('text/plain'); 2007: } elsif (!param('comp')) { 2008: print header(-charset =>'koi8-r')} 2009: my $sstr=param('sstr'); 2010: $opt_z||=param("makehtml"); 2011: if (param('qid')) { 2012: my $sth; 2013: my $qid=param('qid'); 2014: # if ($qid !~ /^[0-9]+$/) 2015: { 2016: my ($fname,$t,$n)= split /\./ , $qid; 2017: $n=$t,$t='' unless $n; 2018: $t||=1; 2019: if ($t) 2020: { 2021: $sth = $dbh->prepare( 2022: "SELECT t2.Id FROM Tournaments as t1, 2023: Tournaments as t2 2024: WHERE (t1.FileName = '$fname.txt' OR t1.FileName='$fname') 2025: AND t1.Id=t2.ParentId AND t2.Number=$t"); 2026: } 2027: # else 2028: # { 2029: # $sth = $dbh->prepare("SELECT Id FROM Tournaments 2030: # WHERE FileName = '$fname.txt' OR FileName = '$fname'" ); 2031: # } 2032: $sth->execute; 2033: $tour = ($sth->fetchrow)[0]; 2034: $sth->finish; 2035: $sth = $dbh->prepare( 2036: "SELECT QuestionId FROM 2037: Questions 2038: WHERE ParentId=$tour AND 2039: Questions.Number=$n"); 2040: $sth->execute; 2041: $qid = ($sth->fetchrow)[0]; 2042: my $query="SELECT Question, Answer from Questions where QuestionId=$qid"; 2043: $sth=$dbh->prepare($query); 2044: $sth->execute; 2045: $sstr= join ' ',$sth->fetchrow; 2046: $sth->finish; 2047: $searchin{'Question'}=1; 2048: $searchin{'Answer'}=1; 2049: $sstr=~tr/ёЁ/еЕ/; 2050: $sstr=~s/[^йцукенгшщзхъфывапролджэячсмитьбюЙЦУКЕНГШЩЗХЪФЫВАПРОЛДЖЭЯЧСМИТЬБЮa-zA-Z0-9]/ /gi; 2051: $proxysstr=$sstr; 2052: $proxysstr=makeproxysstr($dbh,\$proxysstr); 2053: } 2054: 2055: } 2056: 2057: 2058: if (!param('comp') and !param('sqldump') and !$text) { 2059: my $title="Результаты поиска на \"". ($proxysstr||$sstr) .'"' 2060: if ($proxysstr||$sstr); 2061: $title||="База вопросов"; 2062: $globaloutput.=start_html(-"title"=>$title, 2063: -author=>'dimrub@icomverse.com', 2064: -bgcolor=>'#fff0e0', 2065: -vlink=>'#800020');#} 2066: $globaloutput.="<style> 2067: td {font-size: x-small; font-family : sans-serif} 2068: th {font-size: x-small; font-family : sans-serif} 2069: </style>\n"; 2070: 2071: $globaloutput.=&Include_virtual("$reklama")||''; 2072: } 2073: 2074: if ($usehash && !$opt_z && length ($qs)<=255 && $qs !~ /(sstr)|(rand)|(comp)|(all=)/i) { 2075: my $sth=$dbh->prepare("SELECT page,times,t from hash where query=".$dbh->quote($qs)); 2076: $sth->execute(); 2077: my ($p,$times,$t)=$sth->fetchrow(); 2078: $sth->finish; 2079: if ($p) { 2080: print ".$p"; 2081: $dbh->disconnect; 2082: exit ; 2083: } 2084: } 2085: 2086: 2087: 2088: 2089: if (param('hideequal')) { 2090: my ($sth)= $dbh -> prepare("select first, second FROM equalto"); 2091: $sth -> execute; 2092: while ( my ($first, $second)=$sth -> fetchrow) 2093: { 2094: $forbidden{$first}=1; 2095: } 2096: $sth->finish; 2097: } 2098: 2099: 2100: if (param('rand')) { 2101: my ($type, $qnum) = ('', 12); 2102: $type.=$TypeName{$_} foreach param('type'); 2103: # $type .= 'Б' if (param('brain')); 2104: # $type .= 'Ч' if (param('chgk')); 2105: $qnum = param('qnum') if (param('qnum') =~ /^\d+$/); 2106: $qnum = 0 if (!$type); 2107: my $Email; 2108: if (($Email=param('email')) && -x $SENDMAIL && 2109: open(F, "| $SENDMAIL $Email")) { 2110: my ($mime_type) = $text ? "plain" : "html"; 2111: print F <<EOT; 2112: To: $Email 2113: From: olegstepanov\@mail.ru 2114: Subject: Sluchajnij Paket Voprosov "Chto? Gde? Kogda?" 2115: MIME-Version: 1.0 2116: Content-type: text/$mime_type; charset="koi8-r" 2117: 2118: EOT 2119: print F &PrintRandom($dbh, $type, $qnum, $text); 2120: close F; 2121: $globaloutput.= "Пакет случайно выбранных вопросов послан по адресу $Email. Нажмите 2122: на <B>Reload</B> для получения еще одного пакета"; 2123: } else { 2124: $globaloutput.= &PrintRandom($dbh, $type, $qnum, $text); 2125: } 2126: } 2127: elsif (param('authors')){ 2128: $globaloutput.= &PrintAuthors($dbh,param('authors')); 2129: } 2130: elsif (param('qofauthor')){ 2131: $globaloutput.= &PrintQOfAuthor($dbh,param('qofauthor')); 2132: } 2133: elsif (param('sstr')||param('was')) { 2134: $globaloutput.=&PrintSearch($dbh, $sstr||' ', param('metod')||'',param('was')); 2135: $dbh->do("delete from lastqueries where 2136: (TO_DAYS(NOW()) - TO_DAYS(t) >= 2) OR 2137: (time_to_sec(now())-time_to_sec(t) >3600)") if $usewas && random(30)==0; 2138: } 2139: elsif (param('qid')) { 2140: $globaloutput.=&PrintSearch($dbh, $sstr||'', 'proxy'); 2141: } 2142: elsif (param('getfile')){ 2143: $globaloutput.=&writefile 2144: } elsif (param('all')) { 2145: # my $destination='http://db.chgk.info/all.html'; 2146: # Redirect($destination); 2147: # exit; 2148: $globaloutput.=&PrintAll($dbh, 0); 2149: } elsif (param('from_year') && param('to_year')) { 2150: $globaloutput.=&PrintDates($dbh); 2151: } elsif (param('comp')) { 2152: print "Content-Type: application/octet-stream\n"; 2153: print "Content-Type: application/force-download\n"; 2154: print "Content-Type: application/download\n"; 2155: print "Content-Type: application/x-zip-compressed; name=$texttour.zip\n"; 2156: print "Content-Disposition: attachment; filename=$texttour.zip \n\n"; 2157: $tour ||= 0; 2158: my (@files) = &PrintArchive($dbh, $tour); 2159: WriteFile($dbh,$_) foreach @files; 2160: open F, "$ZIP -j - @files |"; 2161: binmode(F); 2162: binmode(STDOUT); 2163: print join "",<F>; 2164: close F; 2165: $dbh->disconnect; 2166: exit; 2167: } elsif (param('sqldump')) { 2168: print header( 2169: -'Content-Type' => 'application/x-zip-compressed; name="dump.zip"', 2170: -'Content-Disposition' => 'attachment; filename="dump.zip"' 2171: ); 2172: open F, "$ZIP -j - $DUMPFILE |"; 2173: print (<F>); 2174: close F; 2175: $dbh->disconnect; 2176: exit; 2177: 2178: } 2179: elsif (!$opt_z && !param("makehtml")) { 2180: my $QuestionNumber=0; 2181: my $qnum; 2182: if ($qnum=param('qnumber')){ 2183: my ($sth) = $dbh->prepare("SELECT QuestionId FROM Questions 2184: WHERE ParentId=$tour AND Number=$qnum"); 2185: $sth->execute; 2186: $QuestionNumber=($sth->fetchrow)[0]||0; 2187: } 2188: if ($QuestionNumber) { 2189: $globaloutput.= &PrintQuestion($dbh, $QuestionNumber, $withanswers||0, $qnum, 1,0,0); 2190: # $dbh, $Id, $answer, $qnum, $title, $text 2191: } else { 2192: $globaloutput.=&PrintTournament($dbh, $tour, $withanswers); 2193: } 2194: } 2195: else { 2196: $opt_z=1; 2197: $url="http://db.chgk.info/cgi-bin/db.cgi"; 2198: open TS, $timestamp; 2199: my $d=$dbh->quote(<TS>); 2200: close TS; 2201: open FF, ">${realHTMLDIR}index.html" or die "ERROR! - ${HTMLDIR}index.html\n"; 2202: my $o=$globaloutput; 2203: $o.=&PrintTournament($dbh, 0, 0); 2204: $o.=&Bottom; 2205: print FF $o; 2206: close FF; 2207: open FF, ">${realHTMLDIR}all.html" or die "ERROR! - ${HTMLDIR}all.html\n"; 2208: $o=$globaloutput; 2209: $o.=&PrintAll($dbh,0); 2210: $o.=&Bottom; 2211: print FF $o; 2212: close FF; 2213: 2214: 2215: # my ($sth) = $dbh->prepare("SELECT t1.Id, t1.FileName, t1.Type, 2216: # count(t2.Id) 2217: # FROM Tournaments as t1, Tournaments as t2 2218: # WHERE t1.CreatedAt>$d AND t2.ParentId=t1.Id GROUP BY t1.Id"); 2219: my ($sth) = $dbh->prepare("SELECT t1.Id, t1.FileName, t1.Type, count(t2.Id) FROM Tournaments as t1 LEFT JOIN Tournaments as t2 2220: ON t2.ParentId=t1.id WHERE t1.CreatedAt>=$d GROUP BY t1.Id"); 2221: $sth->execute; 2222: my ($Id,$fname,$type,$c); 2223: while (($Id,$fname,$type,$c)=$sth->fetchrow,$Id) { 2224: next unless $fname; 2225: print "$fname\n"; 2226: $fname=~s/\.txt$//; 2227: if ($type=~/Т/ || $c<=1) 2228: { 2229: open FF, ">$realHTMLDIR$fname-q.html" or die "ERROR! - $fname-q.html\n"; 2230: my $o=$globaloutput; 2231: $paramtour=$fname; 2232: $o.=&PrintTournament($dbh, $Id, 0); 2233: $o.=&Bottom; 2234: print FF $o; 2235: close FF; 2236: open FF, ">$realHTMLDIR$fname-a.html"; 2237: $o=$globaloutput; 2238: $o.=&PrintTournament($dbh, $Id, 1); 2239: $o.=&Bottom; 2240: print FF $o; 2241: close FF; 2242: } 2243: else { 2244: open FF, ">$realHTMLDIR$fname.html" or die "ERROR! - $fname-q.html\n"; 2245: my $o=$globaloutput; 2246: $o.=&PrintTournament($dbh, $Id, 0); 2247: $o.=&Bottom; 2248: print FF $o; 2249: close FF; 2250: 2251: } 2252: } 2253: } 2254: if (!$text) { 2255: $globaloutput.=&Bottom; 2256: } 2257: if (!$opt_z){ 2258: print $globaloutput; 2259: if (($qs!~ /(rand)|(sstr)|(comp)/i) && (length $qs<=255) && $usehash) { 2260: $globaloutput= $dbh->quote($globaloutput); 2261: $dbh->do("insert into hash (query,page) values (". 2262: $dbh->quote($qs). 2263: ",$globaloutput)"); 2264: } 2265: } 2266: 2267: $dbh->disconnect; 2268: }