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/Question 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'} ",
228: "$Tournament{'PlayedAt'}") . p . "\n";
229: last;
230: };
231: /Ч/ && do {
232: return &PrintTour($dbh, $Tours[0], $answer)
233: if ($#Tours == 0);
234:
235: my $title="Пакет: $Tournament{'Title'}";
236: if ($Tournament{'PlayedAt'}) {
237: $title .= " $Tournament{'PlayedAt'}";
238: }
239:
240: $output .= h2({align=>"center"},
241: "$title") . p . "\n";
242: last;
243: };
244: /Т/ && do {
245: return &PrintTour($dbh, $Id, $answer);
246: };
247: }
248: } else {
249: my ($qnum) = GetQNum($dbh);
250: $output .= h2("Банк Вопросов: $qnum вопросов") . p . "\n";
251: }
252:
253: for ($i = 0; $i <= $#Tours; $i++) {
254: %Tournament = &GetTournament($dbh, $Tours[$i]);
255:
256: if ($Tournament{'Type'} =~ /Ч/) {
257: $SingleTour = 0;
258: my (@Tours) = &GetTours($dbh, $Tournament{'Id'});
259: $SingleTour = 1
260: if ($#Tours == 0);
261: }
262: if ($Tournament{'QuestionsNum'} > 0) {
263: $qnum = " ($Tournament{'QuestionsNum'} вопрос" .
264: &Suffix($Tournament{'QuestionsNum'}) . ")\n";
265: } else {
266: $qnum = '';
267: }
268: if ($Tournament{'Type'} =~ /Г/) {
269: $imgsrc = "/icons/folder.gif";
270: $alt = "[*]";
271: } else {
272: $imgsrc = "/icons/folder.gif";
273: $alt = "[-]";
274: }
275:
276: if ($SingleTour or $Tournament{'Type'} =~ /Т/) {
277: $list .= dd(img({src=>$imgsrc, alt=>$alt})
278: . " " . $Tournament{'Title'} . " " .
279: $Tournament{'PlayedAt'} . $qnum) .
280: dl(
281: dd("["
282: . a({href=>url . "?tour=$Tournament{'Id'}&answer=0"},
283: "вопросы") . "] ["
284: . a({href=>url . "?tour=$Tournament{'Id'}&answer=1"},
285: "вопросы + ответы") . "]")
286: );
287: } else {
288: $list .= dd(a({href=>url . "?tour=$Tournament{'Id'}&comp=1"},
289: img({src=>'/icons/compressed.gif', alt=>'[ZIP]', border=>1}))
290: . " " . img({src=>$imgsrc, alt=>$alt})
291: . " " . a({href=>url . "?tour=$Tournament{'Id'}&answer=0"},
292: $Tournament{'Title'}. " ".
293: $Tournament{'PlayedAt'}) . $qnum);
294: }
295: }
296: $output .= dl($list);
297:
298: if ($URL) {
299: $output .=
300: p("Дополнительная информация об этом турнире - по адресу " .
301: a({-'href'=>$URL}, $URL));
302: }
303:
304: if ($Copyright) {
305: $output .= p("Копирайт: " . $Copyright);
306: }
307:
308: if ($Info) {
309: $output .= p($Info);
310: }
311:
312: return $output;
313: }
314:
315: sub Suffix {
316: my ($qnum) = @_;
317: my ($suffix) = 'а' if $qnum =~ /[234]$/;
318: $suffix = '' if $qnum =~ /1$/;
319: $suffix = 'ов' if $qnum =~ /[567890]$/ || $qnum =~ /1.$/;
320: return $suffix;
321: }
322:
323: sub IsTour {
324: my ($dbh, $Id) = @_;
325: my ($sth) = $dbh->prepare("SELECT Type FROM Tournaments
326: WHERE Id=$Id");
327: $sth->execute;
328: return ($sth->fetchrow)[0] =~ /Т/;
329: }
330:
331: # Gets a DB handler (ofcourse) and a tour Id. Prints all the
332: # question of that tour, according to the options.
333: sub PrintTour {
334: my ($dbh, $Id, $answer) = @_;
335: my ($output, $q, $bottom, $field) = ('', 0, '', '');
336:
337: my (%Tour) = &GetTournament($dbh, $Id);
338: my (@Tours) = &GetTours($dbh, $Tour{'ParentId'});
339: my (%Tournament) = &GetTournament($dbh, $Tour{'ParentId'});
340:
341: return 0
342: if ($Tour{'Type'} !~ /Т/);
343:
344: my ($qnum) = $Tour{'QuestionsNum'};
345: my ($suffix) = &Suffix($qnum);
346:
347: $output .= h2({align=>"center"}, $Tournament{"Title"},
348: $Tournament{'PlayedAt'},
349: "<br>", $Tour{"Title"} .
350: " ($qnum вопрос$suffix)\n") . p;
351:
352: my (@Questions) = &GetTourQuestions($dbh, $Id);
353: for ($q = 0; $q <= $#Questions; $q++) {
354: $output .= &PrintQuestion($dbh, $Questions[$q], $answer, 0);
355: }
356:
357: $output .= hr({-'align'=>'center', -'width'=>'80%'});
358:
359: if ($Tournament{'URL'}) {
360: $output .=
361: p("Дополнительная информация об этом турнире - по адресу " .
362: a({-'href'=>$Tournament{'URL'}}, $Tournament{'URL'}));
363: }
364:
365: if ($Tournament{'Copyright'}) {
366: $output .= p("Копирайт: " . $Tournament{'Copyright'});
367: }
368:
369: if ($Tournament{'Info'}) {
370: $output .= p($Tournament{'Info'});
371: }
372:
373:
374: if ($answer == 0) {
375: $bottom .=
376: "[" . a({href=>url . "?tour=$Id&answer=1"}, "ответы") . "] " . br;
377: }
378: if (&IsTour($dbh, $Id - 1)) {
379: $bottom .=
380: "[" . a({href=>url . "?tour=" . ($Id - 1) . "&answer=0"},
381: "предыдущий тур") . "] ";
382: $bottom .=
383: "[" . a({href=>url . "?tour=" . ($Id - 1) . "&answer=1"},
384: "предыдущий тур с ответами") . "] " . br;
385: }
386: if (&IsTour($dbh, $Id + 1)) {
387: $bottom .=
388: "[" . a({href=>url . "?tour=" . ($Id + 1) . "&answer=0"},
389: "следующий тур") . "] ";
390: $bottom .=
391: "[" . a({href=>url . "?tour=" . ($Id + 1) . "&answer=1"},
392: "следующий тур с ответами") . "] ";
393: }
394:
395: $output .=
396: p({align=>"center"}, font({size=>-1}, $bottom));
397:
398: return $output;
399: }
400:
401: sub PrintField {
402: my ($header, $value, $text) = @_;
403: if ($text) {
404: $value =~ s/<[\/\w]*>//sg;
405: } else {
406: $value =~ s/^\s+/<br> /mg;
407: $value =~ s/^\|([^\n]*)/<pre>$1<\/pre>/mg;
408: }
409: return $text ? "$header:\n$value\n\n" :
410: strong("$header: ") . $value . p . "\n";
411: }
412:
413: # Gets a DB handler (ofcourse) and a question Id. Prints
414: # that question, according to the options.
415: sub PrintQuestion {
416: my ($dbh, $Id, $answer, $qnum, $title, $text) = @_;
417: my ($output, $titles) = ('', '');
418:
419: my (%Question) = &GetQuestion($dbh, $Id);
420: if (!$text) {
421: $output .= hr({width=>"50%"});
422: if ($title) {
423: my (%Tour) = GetTournament($dbh, $Question{'ParentId'});
424: my (%Tournament) = GetTournament($dbh, $Tour{'ParentId'});
425: $titles .=
426: dd(img({src=>"/icons/folder.open.gif"}) . " " .
427: a({href=>url . "?tour=$Tournament{'Id'}"}, $Tournament{'Title'}, $Tournament{'PlayedAt'}));
428: $titles .=
429: dl(dd(img({src=>"/icons/folder.open.gif"}) . " " .
430: a({href=>url . "?tour=$Tour{'Id'}"}, $Tour{'Title'})));
431: }
432: $output .= dl(strong($titles));
433: }
434:
435: $qnum = $Question{'Number'}
436: if ($qnum == 0);
437:
438: $output .=
439: &PrintField("Вопрос $qnum", $Question{'Question'}, $text);
440:
441: if ($answer) {
442: $output .=
443: &PrintField("Ответ", $Question{'Answer'}, $text);
444:
445: if ($Question{'Authors'}) {
446: $output .= &PrintField("Автор(ы)", $Question{'Authors'}, $text);
447: }
448:
449: if ($Question{'Sources'}) {
450: $output .= &PrintField("Источник(и)", $Question{'Sources'}, $text);
451: }
452:
453: if ($Question{'Comments'}) {
454: $output .= &PrintField("Комментарии", $Question{'Comments'}, $text);
455: }
456: }
457: return $output;
458: }
459:
460: # Returns the total number of questions currently in the DB.
461: sub GetQNum {
462: my ($dbh) = @_;
463: my ($sth) = $dbh->prepare("SELECT COUNT(*) FROM Questions");
464: $sth->execute;
465: return ($sth->fetchrow)[0];
466: }
467:
468: # Returns Id's of 12 random questions
469: sub Get12Random {
470: my ($dbh, $type, $num) = @_;
471: my ($i, @questions, $q, $t, $sth);
472: my ($qnum) = &GetQNum($dbh);
473: my (%chosen);
474: srand;
475:
476: for ($i = 0; $i < $num; $i++) {
477: do {
478: $q = int(rand($qnum));
479: $sth = $dbh->prepare("SELECT Type FROM Questions
480: WHERE QuestionId=$q");
481: $sth->execute;
482: $t = ($sth->fetchrow)[0];
483: } until !$chosen{$q} && $t =~ /$type/;
484: $chosen{$q} = 'y';
485: push @questions, $q;
486: }
487: return @questions;
488: }
489:
490: sub Include_virtual {
491: my ($fn, $output) = (@_, '');
492:
493: open F , $fn
494: or return; #die "Can't open the file $fn: $!\n";
495:
496: while (<F>) {
497: if (/<!--#include/o) {
498: s/<!--#include virtual="\/(.*)" -->/&Include_virtual($1)/e;
499: }
500: if (/<!--#exec/o) {
501: s/<!--#exec.*cmd\s*=\s*"([^"]*)".*-->/`$1`/e;
502: }
503: $output .= $_;
504: }
505: return $output;
506: }
507:
508: sub PrintArchive {
509: my($dbh, $Id) = @_;
510: my ($output, @list, $i);
511:
512: my (%Tournament) = &GetTournament($dbh, $Id);
513: my (@Tours) = &GetTours($dbh, $Id);
514:
515: if ($Tournament{'Type'} =~ /Г/ || $Id == 0) {
516: for ($i = 0; $i <= $#Tours; $i++) {
517: push(@list ,&PrintArchive($dbh, $Tours[$i]));
518: }
519: return @list;
520: }
521: return "$SRCPATH/$Tournament{'FileName'} ";
522: }
523:
524: sub PrintAll {
525: my ($dbh, $Id) = @_;
526: my ($output, $list, $i);
527:
528: my (%Tournament) = &GetTournament($dbh, $Id);
529: my (@Tours) = &GetTours($dbh, $Id);
530: my ($New) = ($Id and $Tournament{'Type'} eq 'Ч' and
531: &NewEnough($Tournament{"CreatedAt"})) ?
532: img({src=>"/znatoki/dimrub/db/new-sml.gif", alt=>"NEW!"}) : "";
533:
534: if ($Id == 0) {
535: $output = h3("Все турниры");
536: } else {
537: $output .= dd(img({src=>"/icons/folder.gif", alt=>"[*]"}) .
538: " " . a({href=>url . "?tour=$Tournament{'Id'}&answer=0"},
539: $Tournament{'Title'}) ." " . $Tournament{'PlayedAt'} . " $New");
540: }
541: if ($Id == 0 or $Tournament{'Type'} =~ /Г/) {
542: for ($i = 0; $i <= $#Tours; $i++) {
543: $list .= &PrintAll($dbh, $Tours[$i]);
544: }
545: $output .= dl($list);
546: }
547: return $output;
548: }
549:
550: sub PrintDates {
551: my ($dbh) = @_;
552: my ($from) = param('from_year') . "-" . param('from_month') .
553: "-" . param('from_day');
554: my ($to) = param('to_year') . "-" . param('to_month') . "-" . param('to_day');
555: $from = $dbh->quote($from);
556: $to = $dbh->quote($to);
557: my ($sth) = $dbh->prepare("
558: SELECT DISTINCT Id
559: FROM Tournaments
560: WHERE PlayedAt >= $from AND PlayedAt <= $to
561: AND Type = 'Ч'
562: ");
563: $sth->execute;
564: my (%Tournament, @array, $output, $list);
565:
566: $output = h3("Список турниров, проходивших между $from и $to.");
567: while (@array = $sth->fetchrow) {
568: next
569: if (!$array[0]);
570: %Tournament = &GetTournament($dbh, $array[0]);
571: $list .= dd(img({src=>"/icons/folder.gif", alt=>"[*]"}) .
572: " " . a({href=>url . "?tour=$Tournament{'Id'}&answer=0"},
573: $Tournament{'Title'}, $Tournament{'PlayedAt'}));
574: }
575: $output .= dl($list);
576: return $output;
577: }
578:
579: MAIN:
580: {
581: setlocale(LC_CTYPE,'russian');
582: my($i, $tour);
583: my($text) = (param('text')) ? 1 : 0;
584: my($dbh) = DBI->connect("DBI:mysql:chgk", "piataev", "")
585: or do {
586: print h1("Временные проблемы") . "База данных временно не
587: работает. Заходите попозже.";
588: print &Include_virtual("../dimrub/db/reklama.html");
589: print end_html;
590: die "Can't connect to DB chgk\n";
591: };
592: if (!param('comp') and !$text) {
593: print header;
594: print start_html(-"title"=>'Database of the questions',
595: -author=>'dimrub@icomverse.com',
596: -bgcolor=>'#fff0e0',
597: -vlink=>'#800020');
598: print &Include_virtual("../dimrub/db/reklama.html");
599: }
600:
601: if ($text) {
602: print header('text/plain');
603: }
604:
605: if (param('rand')) {
606: my ($type, $qnum) = ('Ч', 12);
607: $type = 'Б' if (param('brain'));
608: $qnum = param('qnum') if (param('qnum') =~ /^\d+$/);
609: if (param('email') && -x $SENDMAIL &&
610: open(F, "| $SENDMAIL -t -n")) {
611: my ($Email) = param('email');
612: my ($mime_type) = $text ? "plain" : "html";
613: print F <<EOT;
614: To: $Email
615: From: dimrub\@icomverse.com
616: Subject: Sluchajnij Paket Voprosov "Chto? Gde? Kogda?"
617: MIME-Version: 1.0
618: Content-type: text/$mime_type; charset="koi8-r"
619:
620: EOT
621: print F &PrintRandom($dbh, $type, $qnum, $text);
622: close F;
623: print "Пакет случайно выбранных вопросов послан. Нажмите
624: на <B>Reload</B> для получения еще одного пакета";
625: } else {
626: print &PrintRandom($dbh, $type, $qnum, $text);
627: }
628: } elsif (param('sstr')) {
629: &PrintSearch($dbh, param('sstr'));
630: } elsif (param('all')) {
631: print &PrintAll($dbh, 0);
632: } elsif (param('from_year') && param('to_year')) {
633: print &PrintDates($dbh);
634: } elsif (param('comp')) {
635: print header(
636: -'Content-Type' => 'application/x-zip-compressed; name="db.zip"',
637: -'Content-Disposition' => 'attachment; filename="db.zip"'
638: );
639: $tour = (param('tour')) ? param('tour') : 0;
640: my (@files) = &PrintArchive($dbh, $tour);
641: open F, "$ZIP -j - $SRCPATH/COPYRIGHT @files |";
642: print (<F>);
643: close F;
644: $dbh->disconnect;
645: exit;
646: } else {
647: $tour = (param('tour')) ? param('tour') : 0;
648: if ($tour !~ /^[0-9]*$/) {
649: my ($sth) = $dbh->prepare("SELECT Id FROM Tournaments
650: WHERE FileName = '$tour.txt'");
651: $sth->execute;
652: $tour = ($sth->fetchrow)[0];
653: }
654: print &PrintTournament($dbh, $tour, param('answer'));
655: }
656: if (!$text) {
657: print &Include_virtual("../dimrub/db/footer.html");
658: print end_html;
659: }
660: $dbh->disconnect;
661: }
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