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