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