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