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:
9: my ($PWD) = `pwd`;
10: chomp $PWD;
11: my ($SRCPATH) = "$PWD/../dimrub/src";
12: my ($ZIP) = "/usr/bin/zip";
13: my ($SENDMAIL) = "/usr/sbin/sendmail";
14: my ($TMSECS) = 30*24*60*60;
15: my (%RevMonths) =
16: ('Jan', '0', 'Feb', '1', 'Mar', '2', 'Apr', '3', 'May', '4', 'Jun', '5',
17: 'Jul', '6', 'Aug', '7', 'Sep', '8', 'Oct', '9', 'Nov', '10',
18: 'Dec', '11',
19: 'Янв', '0', 'Фев', 1, 'Мар', 2, 'Апр', 3, 'Май', '4',
20: 'Июн', '5', 'Июл', 6, 'Авг', '7', 'Сен', '8',
21: 'Окт', '9', 'Ноя', '19', 'Дек', '11');
22:
23: # Determine whether the given time is within 2 months from now.
24: sub NewEnough {
25: my ($a) = @_;
26: my ($year, $month, $day) = split('-', $a);
27:
28: return (time - timelocal(0, 0, 0, $day, $month -1, $year) < $TMSECS);
29: }
30:
31: # Reads one question from the DB. Gets DB handler and Question ID.
32: sub GetTournament {
33: my ($dbh, $Id) = @_;
34: my (%Tournament, $field, @arr);
35:
36: return %Tournament if ($Id == 0);
37:
38: my ($sth) = $dbh->prepare("SELECT * FROM Tournaments WHERE Id=$Id");
39: $sth->execute;
40:
41: @arr = $sth->fetchrow;
42: my($i, $name) = 0;
43: foreach $name (@{$sth->{NAME}}) {
44: $Tournament{$name} = $arr[$i++];
45: }
46:
47: return %Tournament;
48: }
49:
50: # Reads one question from the DB. Gets DB handler and Question ID.
51: sub GetQuestion {
52: my ($dbh, $QuestionId) = @_;
53: my (%Question, $field, @arr);
54:
55: my($sth) = $dbh->prepare("
56: SELECT * FROM Questions WHERE QuestionId=$QuestionId
57: ");
58:
59: $sth->execute;
60:
61: @arr = $sth->fetchrow;
62: my($i, $name) = 0;
63: foreach $name (@{$sth->{NAME}}) {
64: $Question{$name} = $arr[$i++];
65: }
66:
67: return %Question;
68: }
69:
70: # Gets numbers of all the questions from the given tour.
71: sub GetTourQuestions {
72: my ($dbh, $ParentId) = @_;
73: my (@arr, @Questions);
74:
75: my ($sth) = $dbh->prepare("SELECT QuestionId FROM Questions
76: WHERE ParentId=$ParentId ORDER BY QuestionId");
77:
78: $sth->execute;
79:
80: while (@arr = $sth->fetchrow) {
81: push @Questions, $arr[0];
82: }
83:
84: return @Questions;
85: }
86:
87: # Returns list of children of the given tournament.
88: sub GetTours {
89: my ($dbh, $ParentId) = @_;
90: my (@arr, @Tours);
91:
92: my ($sth) = $dbh->prepare("SELECT Id FROM Tournaments
93: WHERE ParentId=$ParentId ORDER BY Id");
94:
95: $sth->execute;
96:
97: while (@arr = $sth->fetchrow) {
98: push @Tours, $arr[0];
99: }
100:
101: return @Tours;
102: }
103:
104:
105: # Returns list of QuestionId's, that have the search string in them.
106: sub Search {
107: my ($dbh, $sstr) = @_;
108: my (@arr, @Questions, @fields);
109: my (@sar, $i, $sth);
110:
111: push @fields, 'Question';
112: foreach (qw/Answer Sources Authors Comments/) {
113: if (param($_)) {
114: push @fields, "IFNULL($_, '')";
115: }
116: }
117:
118: @sar = split " ", $sstr;
119: for $i (0 .. $#sar) {
120: $sar[$i] = $dbh->quote("%${sar[$i]}%");
121: }
122:
123: my($f) = "CONCAT(" . join(',', @fields) . ")";
124: if (param('all') eq 'yes') {
125: $sstr = join " AND $f LIKE ", @sar;
126: } else {
127: $sstr = join " OR $f LIKE ", @sar;
128: }
129:
130: $sth = $dbh->prepare("SELECT QuestionId FROM Questions
131: WHERE $f LIKE $sstr ORDER BY QuestionId");
132:
133: $sth->execute;
134: while (@arr = $sth->fetchrow) {
135: push @Questions, $arr[0];
136: }
137:
138: return @Questions;
139: }
140:
141: # Substitute every letter by a pair (for case insensitive search).
142: my (@letters) = qw/аА бБ вВ гГ дД еЕ жЖ зЗ иИ йЙ кК лЛ мМ нН оО
143: пП рР сС тТ уУ фФ хХ цЦ чЧ шШ щЩ ьЬ ыЫ эЭ юЮ яЯ/;
144:
145: sub NoCase {
146: my ($sstr) = shift;
147: my ($res);
148:
149: if (($res) = grep(/$sstr/, @letters)) {
150: return "[$res]";
151: } else {
152: return $sstr;
153: }
154: }
155:
156: sub PrintSearch {
157: my ($dbh, $sstr) = @_;
158: my (@Questions) = &Search($dbh, $sstr);
159: my ($output, $i, $suffix, $hits) = ('', 0, '', $#Questions + 1);
160:
161: if ($hits =~ /1.$/ || $hits =~ /[5-90]$/) {
162: $suffix = 'й';
163: } elsif ($hits =~ /1$/) {
164: $suffix = 'е';
165: } else {
166: $suffix = 'я';
167: }
168:
169: print p({align=>"center"}, "Результаты поиска на " . strong($sstr)
170: . " : $hits попадани$suffix.");
171:
172: if (param('word')) {
173: $sstr = '[ \.\,:;]' . $sstr . '[ \.\,:\;]';
174: }
175:
176: $sstr =~ s/(.)/&NoCase($1)/ge;
177:
178: my(@sar) = split(/\s/, $sstr);
179: for ($i = 0; $i <= $#Questions; $i++) {
180: $output = &PrintQuestion($dbh, $Questions[$i], 1, $i + 1, 1);
181: foreach (@sar) {
182: $output =~ s/$_/<strong>$&<\/strong>/gs;
183: }
184: print $output;
185: }
186: }
187:
188: sub PrintRandom {
189: my ($dbh, $type, $num, $text) = @_;
190: my (@Questions) = &Get12Random($dbh, $type, $num);
191: my ($output, $i) = ('', 0);
192:
193: if ($text) {
194: $output .= " $num случайных вопросов.\n\n";
195: } else {
196: $output .=
197: h2({align=>"center"}, "$num случайных вопросов.");
198: }
199:
200: for ($i = 0; $i <= $#Questions; $i++) {
201: # Passing DB handler, question ID, print answer, question
202: # number, print title, print text/html
203: $output .=
204: &PrintQuestion($dbh, $Questions[$i], 1, $i + 1, 0, $text);
205: }
206: return $output;
207: }
208:
209: sub PrintTournament {
210: my ($dbh, $Id, $answer) = @_;
211: my (%Tournament, @Tours, $i, $list, $qnum, $imgsrc, $alt,
212: $SingleTour);
213: my ($output) = '';
214:
215: %Tournament = &GetTournament($dbh, $Id) if ($Id);
216:
217: my ($URL) = $Tournament{'URL'};
218: my ($Info) = $Tournament{'Info'};
219: my ($Copyright) = $Tournament{'Copyright'};
220:
221: @Tours = &GetTours($dbh, $Id);
222:
223: if ($Id) {
224: for ($Tournament{'Type'}) {
225: /Г/ && do {
226: $output .= h2({align=>"center"},
227: "Группа: $Tournament{'Title'}") . p . "\n";
228: last;
229: };
230: /Ч/ && do {
231: return &PrintTour($dbh, $Tours[0], $answer)
232: if ($#Tours == 0);
233:
234: $output .= h2({align=>"center"},
235: "Чемпионат: $Tournament{'Title'}") . p . "\n";
236: last;
237: };
238: /Т/ && do {
239: return &PrintTour($dbh, $Id, $answer);
240: };
241: }
242: } else {
243: my ($qnum) = GetQNum($dbh);
244: $output .= h2("Банк Вопросов: $qnum вопросов") . p . "\n";
245: }
246:
247: for ($i = 0; $i <= $#Tours; $i++) {
248: %Tournament = &GetTournament($dbh, $Tours[$i]);
249:
250: if ($Tournament{'Type'} =~ /Ч/) {
251: $SingleTour = 0;
252: my (@Tours) = &GetTours($dbh, $Tournament{'Id'});
253: $SingleTour = 1
254: if ($#Tours == 0);
255: }
256: if ($Tournament{'QuestionsNum'} > 0) {
257: $qnum = " ($Tournament{'QuestionsNum'} вопрос" .
258: &Suffix($Tournament{'QuestionsNum'}) . ")\n";
259: } else {
260: $qnum = '';
261: }
262: if ($Tournament{'Type'} =~ /Г/) {
263: $imgsrc = "/icons/folder.gif";
264: $alt = "[*]";
265: } else {
266: $imgsrc = "/icons/folder.gif";
267: $alt = "[-]";
268: }
269:
270: if ($SingleTour or $Tournament{'Type'} =~ /Т/) {
271: $list .= dd(img({src=>$imgsrc, alt=>$alt})
272: . " " . $Tournament{'Title'} . $qnum) .
273: dl(
274: dd("["
275: . a({href=>url . "?tour=$Tournament{'Id'}&answer=0"},
276: "вопросы") . "] ["
277: . a({href=>url . "?tour=$Tournament{'Id'}&answer=1"},
278: "вопросы + ответы") . "]")
279: );
280: } else {
281: $list .= dd(a({href=>url . "?tour=$Tournament{'Id'}&comp=1"},
282: img({src=>'/icons/compressed.gif', alt=>'[ZIP]', border=>1}))
283: . " " . img({src=>$imgsrc, alt=>$alt})
284: . " " . a({href=>url . "?tour=$Tournament{'Id'}&answer=0"},
285: $Tournament{'Title'}) . $qnum);
286: }
287: }
288: $output .= dl($list);
289:
290: if ($URL) {
291: $output .=
292: p("Дополнительная информация об этом турнире - по адресу " .
293: a({-'href'=>$URL}, $URL));
294: }
295:
296: if ($Copyright) {
297: $output .= p("Копирайт: " . $Copyright);
298: }
299:
300: if ($Info) {
301: $output .= p($Info);
302: }
303:
304: return $output;
305: }
306:
307: sub Suffix {
308: my ($qnum) = @_;
309: my ($suffix) = 'а' if $qnum =~ /[234]$/;
310: $suffix = '' if $qnum =~ /1$/;
311: $suffix = 'ов' if $qnum =~ /[567890]$/ || $qnum =~ /1.$/;
312: return $suffix;
313: }
314:
315: sub IsTour {
316: my ($dbh, $Id) = @_;
317: my ($sth) = $dbh->prepare("SELECT Type FROM Tournaments
318: WHERE Id=$Id");
319: $sth->execute;
320: return ($sth->fetchrow)[0] =~ /Т/;
321: }
322:
323: # Gets a DB handler (ofcourse) and a tour Id. Prints all the
324: # question of that tour, according to the options.
325: sub PrintTour {
326: my ($dbh, $Id, $answer) = @_;
327: my ($output, $q, $bottom, $field) = ('', 0, '', '');
328:
329: my (%Tour) = &GetTournament($dbh, $Id);
330: my (@Tours) = &GetTours($dbh, $Tour{'ParentId'});
331: my (%Tournament) = &GetTournament($dbh, $Tour{'ParentId'});
332:
333: return 0
334: if ($Tour{'Type'} !~ /Т/);
335:
336: my ($qnum) = $Tour{'QuestionsNum'};
337: my ($suffix) = &Suffix($qnum);
338:
339: $output .= h2({align=>"center"}, $Tournament{"Title"},
340: "<br>", $Tour{"Title"} .
341: " ($qnum вопрос$suffix)\n") . p;
342:
343: my (@Questions) = &GetTourQuestions($dbh, $Id);
344: for ($q = 0; $q <= $#Questions; $q++) {
345: $output .= &PrintQuestion($dbh, $Questions[$q], $answer, 0);
346: }
347:
348: $output .= hr({-'align'=>'center', -'width'=>'80%'});
349:
350: if ($Tournament{'URL'}) {
351: $output .=
352: p("Дополнительная информация об этом турнире - по адресу " .
353: a({-'href'=>$Tournament{'URL'}}, $Tournament{'URL'}));
354: }
355:
356: if ($Tournament{'Copyright'}) {
357: $output .= p("Копирайт: " . $Tournament{'Copyright'});
358: }
359:
360: if ($Tournament{'Info'}) {
361: $output .= p($Tournament{'Info'});
362: }
363:
364:
365: if ($answer == 0) {
366: $bottom .=
367: "[" . a({href=>url . "?tour=$Id&answer=1"}, "ответы") . "] " . br;
368: }
369: if (&IsTour($dbh, $Id - 1)) {
370: $bottom .=
371: "[" . a({href=>url . "?tour=" . ($Id - 1) . "&answer=0"},
372: "предыдущий тур") . "] ";
373: $bottom .=
374: "[" . a({href=>url . "?tour=" . ($Id - 1) . "&answer=1"},
375: "предыдущий тур с ответами") . "] " . br;
376: }
377: if (&IsTour($dbh, $Id + 1)) {
378: $bottom .=
379: "[" . a({href=>url . "?tour=" . ($Id + 1) . "&answer=0"},
380: "следующий тур") . "] ";
381: $bottom .=
382: "[" . a({href=>url . "?tour=" . ($Id + 1) . "&answer=1"},
383: "следующий тур с ответами") . "] ";
384: }
385:
386: $output .=
387: p({align=>"center"}, font({size=>-1}, $bottom));
388:
389: return $output;
390: }
391:
392: sub PrintField {
393: my ($header, $value, $text) = @_;
394: if ($text) {
395: $value =~ s/<[\/\w]*>//sg;
396: }
397: return $text ? "$header:\n$value\n\n" :
398: strong("$header: ") . $value . p . "\n";
399: }
400:
401: # Gets a DB handler (ofcourse) and a question Id. Prints
402: # that question, according to the options.
403: sub PrintQuestion {
404: my ($dbh, $Id, $answer, $qnum, $title, $text) = @_;
405: my ($output, $titles) = ('', '');
406:
407: my (%Question) = &GetQuestion($dbh, $Id);
408: if (!$text) {
409: $output .= hr({width=>"50%"});
410: if ($title) {
411: my (%Tour) = GetTournament($dbh, $Question{'ParentId'});
412: my (%Tournament) = GetTournament($dbh, $Tour{'ParentId'});
413: $titles .=
414: dd(img({src=>"/icons/folder.open.gif"}) . " " .
415: a({href=>url . "?tour=$Tournament{'Id'}"}, $Tournament{'Title'}));
416: $titles .=
417: dl(dd(img({src=>"/icons/folder.open.gif"}) . " " .
418: a({href=>url . "?tour=$Tour{'Id'}"}, $Tour{'Title'})));
419: }
420: $output .= dl(strong($titles));
421: }
422:
423: $qnum = $Question{'Number'}
424: if ($qnum == 0);
425:
426: $output .=
427: &PrintField("Вопрос $qnum", $Question{'Question'}, $text);
428:
429: if ($answer) {
430: $output .=
431: &PrintField("Ответ", $Question{'Answer'}, $text);
432:
433: if ($Question{'Authors'}) {
434: $output .= &PrintField("Автор(ы)", $Question{'Authors'}, $text);
435: }
436:
437: if ($Question{'Sources'}) {
438: $output .= &PrintField("Источник(и)", $Question{'Sources'}, $text);
439: }
440:
441: if ($Question{'Comments'}) {
442: $output .= &PrintField("Комментарии", $Question{'Comments'}, $text);
443: }
444: }
445: return $output;
446: }
447:
448: # Returns the total number of questions currently in the DB.
449: sub GetQNum {
450: my ($dbh) = @_;
451: my ($sth) = $dbh->prepare("SELECT COUNT(*) FROM Questions");
452: $sth->execute;
453: return ($sth->fetchrow)[0];
454: }
455:
456: # Returns Id's of 12 random questions
457: sub Get12Random {
458: my ($dbh, $type, $num) = @_;
459: my ($i, @questions, $q, $t, $sth);
460: my ($qnum) = &GetQNum($dbh);
461: my (%chosen);
462: srand;
463:
464: for ($i = 0; $i < $num; $i++) {
465: do {
466: $q = int(rand($qnum));
467: $sth = $dbh->prepare("SELECT Type FROM Questions
468: WHERE QuestionId=$q");
469: $sth->execute;
470: $t = ($sth->fetchrow)[0];
471: } until !$chosen{$q} && $t =~ /$type/;
472: $chosen{$q} = 'y';
473: push @questions, $q;
474: }
475: return @questions;
476: }
477:
478: sub Include_virtual {
479: my ($fn, $output) = (@_, '');
480:
481: open F , $fn
482: or return; #die "Can't open the file $fn: $!\n";
483:
484: while (<F>) {
485: if (/<!--#include/o) {
486: s/<!--#include virtual="\/(.*)" -->/&Include_virtual($1)/e;
487: }
488: if (/<!--#exec/o) {
489: s/<!--#exec.*cmd\s*=\s*"([^"]*)".*-->/`$1`/e;
490: }
491: $output .= $_;
492: }
493: return $output;
494: }
495:
496: sub PrintArchive {
497: my($dbh, $Id) = @_;
498: my ($output, @list, $i);
499:
500: my (%Tournament) = &GetTournament($dbh, $Id);
501: my (@Tours) = &GetTours($dbh, $Id);
502:
503: if ($Tournament{'Type'} =~ /Г/ || $Id == 0) {
504: for ($i = 0; $i <= $#Tours; $i++) {
505: push(@list ,&PrintArchive($dbh, $Tours[$i]));
506: }
507: return @list;
508: }
509: return "$SRCPATH/$Tournament{'FileName'} ";
510: }
511:
512: sub PrintAll {
513: my ($dbh, $Id) = @_;
514: my ($output, $list, $i);
515:
516: my (%Tournament) = &GetTournament($dbh, $Id);
517: my (@Tours) = &GetTours($dbh, $Id);
518: my ($New) = ($Id and $Tournament{'Type'} eq 'Ч' and
519: &NewEnough($Tournament{"CreatedAt"})) ?
520: img({src=>"/znatoki/dimrub/db/new-sml.gif", alt=>"NEW!"}) : "";
521:
522: if ($Id == 0) {
523: $output = h3("Все турниры");
524: } else {
525: $output .= dd(img({src=>"/icons/folder.gif", alt=>"[*]"}) .
526: " " . a({href=>url . "?tour=$Tournament{'Id'}&answer=0"},
527: $Tournament{'Title'}) . " $New");
528: }
529: if ($Id == 0 or $Tournament{'Type'} =~ /Г/) {
530: for ($i = 0; $i <= $#Tours; $i++) {
531: $list .= &PrintAll($dbh, $Tours[$i]);
532: }
533: $output .= dl($list);
534: }
535: return $output;
536: }
537:
538: sub PrintDates {
539: my ($dbh) = @_;
540: my ($from) = param('from_year') . "-" . param('from_month') .
541: "-" . param('from_day');
542: my ($to) = param('to_year') . "-" . param('to_month') . "-" . param('to_day');
543: $from = $dbh->quote($from);
544: $to = $dbh->quote($to);
545: my ($sth) = $dbh->prepare("
546: SELECT DISTINCT Id
547: FROM Tournaments
548: WHERE PlayedAt >= $from AND PlayedAt <= $to
549: AND Type = 'Ч'
550: ");
551: $sth->execute;
552: my (%Tournament, @array, $output, $list);
553:
554: $output = h3("Список турниров, проходивших между $from и $to.");
555: while (@array = $sth->fetchrow) {
556: next
557: if (!$array[0]);
558: %Tournament = &GetTournament($dbh, $array[0]);
559: $list .= dd(img({src=>"/icons/folder.gif", alt=>"[*]"}) .
560: " " . a({href=>url . "?tour=$Tournament{'Id'}&answer=0"},
561: $Tournament{'Title'}));
562: }
563: $output .= dl($list);
564: return $output;
565: }
566:
567: MAIN:
568: {
569: setlocale(LC_CTYPE,'russian');
570: my($i, $tour);
571: my($text) = (param('text')) ? 1 : 0;
572: my($dbh) = DBI->connect("DBI:mysql:chgk", "piataev", "")
573: or do {
574: print h1("Временные проблемы") . "База данных временно не
575: работает. Заходите попозже.";
576: print &Include_virtual("../dimrub/db/reklama.html");
577: print end_html;
578: die "Can't connect to DB chgk\n";
579: };
580: if (!param('comp') and !$text) {
581: print header;
582: print start_html(-"title"=>'Database of the questions',
583: -author=>'dimrub@icomverse.com',
584: -bgcolor=>'#fff0e0',
585: -vlink=>'#800020');
586: print &Include_virtual("../dimrub/db/reklama.html");
587: }
588:
589: if ($text) {
590: print header('text/plain');
591: }
592:
593: if (param('rand')) {
594: my ($type, $qnum) = ('Ч', 12);
595: $type = 'Б' if (param('brain'));
596: $qnum = param('qnum') if (param('qnum') =~ /^\d+$/);
597: if (param('email') && -x $SENDMAIL &&
598: open(F, "| $SENDMAIL -t -n")) {
599: my ($Email) = param('email');
600: my ($mime_type) = $text ? "plain" : "html";
601: print F <<EOT;
602: To: $Email
603: From: dimrub\@icomverse.com
604: Subject: Sluchajnij Paket Voprosov "Chto? Gde? Kogda?"
605: MIME-Version: 1.0
606: Content-type: text/$mime_type; charset="koi8-r"
607:
608: EOT
609: print F &PrintRandom($dbh, $type, $qnum, $text);
610: close F;
611: print "Пакет случайно выбранных вопросов послан. Нажмите
612: на <B>Reload</B> для получения еще одного пакета";
613: } else {
614: print &PrintRandom($dbh, $type, $qnum, $text);
615: }
616: } elsif (param('sstr')) {
617: &PrintSearch($dbh, param('sstr'));
618: } elsif (param('all')) {
619: print &PrintAll($dbh, 0);
620: } elsif (param('from_year') && param('to_year')) {
621: print &PrintDates($dbh);
622: } elsif (param('comp')) {
623: print header(
624: -'Content-Type' => 'application/x-zip-compressed; name="db.zip"',
625: -'Content-Disposition' => 'attachment; filename="db.zip"'
626: );
627: $tour = (param('tour')) ? param('tour') : 0;
628: my (@files) = &PrintArchive($dbh, $tour);
629: open F, "$ZIP -j - $SRCPATH/COPYRIGHT @files |";
630: print (<F>);
631: close F;
632: $dbh->disconnect;
633: exit;
634: } else {
635: $tour = (param('tour')) ? param('tour') : 0;
636: if ($tour !~ /^[0-9]*$/) {
637: my ($sth) = $dbh->prepare("SELECT Id FROM Tournaments
638: WHERE FileName = '$tour.txt'");
639: $sth->execute;
640: $tour = ($sth->fetchrow)[0];
641: }
642: print &PrintTournament($dbh, $tour, param('answer'));
643: }
644: if (!$text) {
645: print &Include_virtual("../dimrub/db/footer.html");
646: print end_html;
647: }
648: $dbh->disconnect;
649: }
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