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