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: } else {
397: $value =~ s/^\s+/<br> /mg;
398: $value =~ s/^\|([^\n]*)/<pre>$1<\/pre>/mg;
399: }
400: return $text ? "$header:\n$value\n\n" :
401: strong("$header: ") . $value . p . "\n";
402: }
403:
404: # Gets a DB handler (ofcourse) and a question Id. Prints
405: # that question, according to the options.
406: sub PrintQuestion {
407: my ($dbh, $Id, $answer, $qnum, $title, $text) = @_;
408: my ($output, $titles) = ('', '');
409:
410: my (%Question) = &GetQuestion($dbh, $Id);
411: if (!$text) {
412: $output .= hr({width=>"50%"});
413: if ($title) {
414: my (%Tour) = GetTournament($dbh, $Question{'ParentId'});
415: my (%Tournament) = GetTournament($dbh, $Tour{'ParentId'});
416: $titles .=
417: dd(img({src=>"/icons/folder.open.gif"}) . " " .
418: a({href=>url . "?tour=$Tournament{'Id'}"}, $Tournament{'Title'}));
419: $titles .=
420: dl(dd(img({src=>"/icons/folder.open.gif"}) . " " .
421: a({href=>url . "?tour=$Tour{'Id'}"}, $Tour{'Title'})));
422: }
423: $output .= dl(strong($titles));
424: }
425:
426: $qnum = $Question{'Number'}
427: if ($qnum == 0);
428:
429: $output .=
430: &PrintField("Вопрос $qnum", $Question{'Question'}, $text);
431:
432: if ($answer) {
433: $output .=
434: &PrintField("Ответ", $Question{'Answer'}, $text);
435:
436: if ($Question{'Authors'}) {
437: $output .= &PrintField("Автор(ы)", $Question{'Authors'}, $text);
438: }
439:
440: if ($Question{'Sources'}) {
441: $output .= &PrintField("Источник(и)", $Question{'Sources'}, $text);
442: }
443:
444: if ($Question{'Comments'}) {
445: $output .= &PrintField("Комментарии", $Question{'Comments'}, $text);
446: }
447: }
448: return $output;
449: }
450:
451: # Returns the total number of questions currently in the DB.
452: sub GetQNum {
453: my ($dbh) = @_;
454: my ($sth) = $dbh->prepare("SELECT COUNT(*) FROM Questions");
455: $sth->execute;
456: return ($sth->fetchrow)[0];
457: }
458:
459: # Returns Id's of 12 random questions
460: sub Get12Random {
461: my ($dbh, $type, $num) = @_;
462: my ($i, @questions, $q, $t, $sth);
463: my ($qnum) = &GetQNum($dbh);
464: my (%chosen);
465: srand;
466:
467: for ($i = 0; $i < $num; $i++) {
468: do {
469: $q = int(rand($qnum));
470: $sth = $dbh->prepare("SELECT Type FROM Questions
471: WHERE QuestionId=$q");
472: $sth->execute;
473: $t = ($sth->fetchrow)[0];
474: } until !$chosen{$q} && $t =~ /$type/;
475: $chosen{$q} = 'y';
476: push @questions, $q;
477: }
478: return @questions;
479: }
480:
481: sub Include_virtual {
482: my ($fn, $output) = (@_, '');
483:
484: open F , $fn
485: or return; #die "Can't open the file $fn: $!\n";
486:
487: while (<F>) {
488: if (/<!--#include/o) {
489: s/<!--#include virtual="\/(.*)" -->/&Include_virtual($1)/e;
490: }
491: if (/<!--#exec/o) {
492: s/<!--#exec.*cmd\s*=\s*"([^"]*)".*-->/`$1`/e;
493: }
494: $output .= $_;
495: }
496: return $output;
497: }
498:
499: sub PrintArchive {
500: my($dbh, $Id) = @_;
501: my ($output, @list, $i);
502:
503: my (%Tournament) = &GetTournament($dbh, $Id);
504: my (@Tours) = &GetTours($dbh, $Id);
505:
506: if ($Tournament{'Type'} =~ /Г/ || $Id == 0) {
507: for ($i = 0; $i <= $#Tours; $i++) {
508: push(@list ,&PrintArchive($dbh, $Tours[$i]));
509: }
510: return @list;
511: }
512: return "$SRCPATH/$Tournament{'FileName'} ";
513: }
514:
515: sub PrintAll {
516: my ($dbh, $Id) = @_;
517: my ($output, $list, $i);
518:
519: my (%Tournament) = &GetTournament($dbh, $Id);
520: my (@Tours) = &GetTours($dbh, $Id);
521: my ($New) = ($Id and $Tournament{'Type'} eq 'Ч' and
522: &NewEnough($Tournament{"CreatedAt"})) ?
523: img({src=>"/znatoki/dimrub/db/new-sml.gif", alt=>"NEW!"}) : "";
524:
525: if ($Id == 0) {
526: $output = h3("Все турниры");
527: } else {
528: $output .= dd(img({src=>"/icons/folder.gif", alt=>"[*]"}) .
529: " " . a({href=>url . "?tour=$Tournament{'Id'}&answer=0"},
530: $Tournament{'Title'}) . " $New");
531: }
532: if ($Id == 0 or $Tournament{'Type'} =~ /Г/) {
533: for ($i = 0; $i <= $#Tours; $i++) {
534: $list .= &PrintAll($dbh, $Tours[$i]);
535: }
536: $output .= dl($list);
537: }
538: return $output;
539: }
540:
541: sub PrintDates {
542: my ($dbh) = @_;
543: my ($from) = param('from_year') . "-" . param('from_month') .
544: "-" . param('from_day');
545: my ($to) = param('to_year') . "-" . param('to_month') . "-" . param('to_day');
546: $from = $dbh->quote($from);
547: $to = $dbh->quote($to);
548: my ($sth) = $dbh->prepare("
549: SELECT DISTINCT Id
550: FROM Tournaments
551: WHERE PlayedAt >= $from AND PlayedAt <= $to
552: AND Type = 'Ч'
553: ");
554: $sth->execute;
555: my (%Tournament, @array, $output, $list);
556:
557: $output = h3("Список турниров, проходивших между $from и $to.");
558: while (@array = $sth->fetchrow) {
559: next
560: if (!$array[0]);
561: %Tournament = &GetTournament($dbh, $array[0]);
562: $list .= dd(img({src=>"/icons/folder.gif", alt=>"[*]"}) .
563: " " . a({href=>url . "?tour=$Tournament{'Id'}&answer=0"},
564: $Tournament{'Title'}));
565: }
566: $output .= dl($list);
567: return $output;
568: }
569:
570: MAIN:
571: {
572: setlocale(LC_CTYPE,'russian');
573: my($i, $tour);
574: my($text) = (param('text')) ? 1 : 0;
575: my($dbh) = DBI->connect("DBI:mysql:chgk", "piataev", "")
576: or do {
577: print h1("Временные проблемы") . "База данных временно не
578: работает. Заходите попозже.";
579: print &Include_virtual("../dimrub/db/reklama.html");
580: print end_html;
581: die "Can't connect to DB chgk\n";
582: };
583: if (!param('comp') and !$text) {
584: print header;
585: print start_html(-"title"=>'Database of the questions',
586: -author=>'dimrub@icomverse.com',
587: -bgcolor=>'#fff0e0',
588: -vlink=>'#800020');
589: print &Include_virtual("../dimrub/db/reklama.html");
590: }
591:
592: if ($text) {
593: print header('text/plain');
594: }
595:
596: if (param('rand')) {
597: my ($type, $qnum) = ('Ч', 12);
598: $type = 'Б' if (param('brain'));
599: $qnum = param('qnum') if (param('qnum') =~ /^\d+$/);
600: if (param('email') && -x $SENDMAIL &&
601: open(F, "| $SENDMAIL -t -n")) {
602: my ($Email) = param('email');
603: my ($mime_type) = $text ? "plain" : "html";
604: print F <<EOT;
605: To: $Email
606: From: dimrub\@icomverse.com
607: Subject: Sluchajnij Paket Voprosov "Chto? Gde? Kogda?"
608: MIME-Version: 1.0
609: Content-type: text/$mime_type; charset="koi8-r"
610:
611: EOT
612: print F &PrintRandom($dbh, $type, $qnum, $text);
613: close F;
614: print "Пакет случайно выбранных вопросов послан. Нажмите
615: на <B>Reload</B> для получения еще одного пакета";
616: } else {
617: print &PrintRandom($dbh, $type, $qnum, $text);
618: }
619: } elsif (param('sstr')) {
620: &PrintSearch($dbh, param('sstr'));
621: } elsif (param('all')) {
622: print &PrintAll($dbh, 0);
623: } elsif (param('from_year') && param('to_year')) {
624: print &PrintDates($dbh);
625: } elsif (param('comp')) {
626: print header(
627: -'Content-Type' => 'application/x-zip-compressed; name="db.zip"',
628: -'Content-Disposition' => 'attachment; filename="db.zip"'
629: );
630: $tour = (param('tour')) ? param('tour') : 0;
631: my (@files) = &PrintArchive($dbh, $tour);
632: open F, "$ZIP -j - $SRCPATH/COPYRIGHT @files |";
633: print (<F>);
634: close F;
635: $dbh->disconnect;
636: exit;
637: } else {
638: $tour = (param('tour')) ? param('tour') : 0;
639: if ($tour !~ /^[0-9]*$/) {
640: my ($sth) = $dbh->prepare("SELECT Id FROM Tournaments
641: WHERE FileName = '$tour.txt'");
642: $sth->execute;
643: $tour = ($sth->fetchrow)[0];
644: }
645: print &PrintTournament($dbh, $tour, param('answer'));
646: }
647: if (!$text) {
648: print &Include_virtual("../dimrub/db/footer.html");
649: print end_html;
650: }
651: $dbh->disconnect;
652: }
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