db/prgsrc/db.cgi - view

File: [Local Repository] / db / prgsrc / db.cgi
Revision 1.135: download - view: text, annotated - select for diffs - revision graph
Sat Aug 28 23:47:41 2004 UTC (19 years, 9 months ago) by roma7
Branches: MAIN
CVS tags: HEAD

PassCriteria is added

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