db/prgsrc/db.cgi - view

File: [Local Repository] / db / prgsrc / db.cgi
Revision 1.131: download - view: text, annotated - select for diffs - revision graph
Tue Mar 16 12:03:38 2004 UTC (20 years, 2 months ago) by roma7
Branches: MAIN
CVS tags: HEAD

pereadresatsiya "Blizkie voposy"->zaba.ru ubrana

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