Annotation of db/prgsrc/db.cgi, revision 1.20
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.1 boris 163:
1.14 roma7 164: $sth = $dbh->prepare("SELECT QuestionId FROM Questions
1.1 boris 165: WHERE $f LIKE $sstr ORDER BY QuestionId");
166:
1.14 roma7 167: } #else -- processing old-style query (R7)
168:
1.1 boris 169: $sth->execute;
170: while (@arr = $sth->fetchrow) {
171: push @Questions, $arr[0];
172: }
1.20 ! roma7 173: print br, "Search time: ",time-$btime," sec",br if $debug;
1.1 boris 174: return @Questions;
175: }
176:
177: # Substitute every letter by a pair (for case insensitive search).
178: my (@letters) = qw/аА бБ вВ гГ дД еЕ жЖ зЗ иИ йЙ кК лЛ мМ нН оО
179: пП рР сС тТ уУ фФ хХ цЦ чЧ шШ щЩ ьЬ ыЫ эЭ юЮ яЯ/;
180:
181: sub NoCase {
182: my ($sstr) = shift;
183: my ($res);
184:
185: if (($res) = grep(/$sstr/, @letters)) {
186: return "[$res]";
187: } else {
188: return $sstr;
189: }
190: }
191:
192: sub PrintSearch {
1.14 roma7 193: my ($dbh, $sstr, $metod) = @_;
194: my (@Questions) = &Search($dbh, $sstr,$metod);
1.1 boris 195: my ($output, $i, $suffix, $hits) = ('', 0, '', $#Questions + 1);
196:
197: if ($hits =~ /1.$/ || $hits =~ /[5-90]$/) {
198: $suffix = 'й';
199: } elsif ($hits =~ /1$/) {
200: $suffix = 'е';
201: } else {
202: $suffix = 'я';
203: }
204:
205: print p({align=>"center"}, "Результаты поиска на " . strong($sstr)
206: . " : $hits попадани$suffix.");
207:
208: if (param('word')) {
209: $sstr = '[ \.\,:;]' . $sstr . '[ \.\,:\;]';
210: }
211:
212: $sstr =~ s/(.)/&NoCase($1)/ge;
213:
1.13 roma7 214: my(@sar) = split(' ', $sstr);
1.1 boris 215: for ($i = 0; $i <= $#Questions; $i++) {
216: $output = &PrintQuestion($dbh, $Questions[$i], 1, $i + 1, 1);
217: foreach (@sar) {
218: $output =~ s/$_/<strong>$&<\/strong>/gs;
219: }
220: print $output;
221: }
222: }
223:
224: sub PrintRandom {
225: my ($dbh, $type, $num, $text) = @_;
226: my (@Questions) = &Get12Random($dbh, $type, $num);
227: my ($output, $i) = ('', 0);
228:
229: if ($text) {
230: $output .= " $num случайных вопросов.\n\n";
231: } else {
232: $output .=
233: h2({align=>"center"}, "$num случайных вопросов.");
234: }
235:
236: for ($i = 0; $i <= $#Questions; $i++) {
237: # Passing DB handler, question ID, print answer, question
238: # number, print title, print text/html
239: $output .=
240: &PrintQuestion($dbh, $Questions[$i], 1, $i + 1, 0, $text);
241: }
242: return $output;
243: }
244:
245: sub PrintTournament {
246: my ($dbh, $Id, $answer) = @_;
247: my (%Tournament, @Tours, $i, $list, $qnum, $imgsrc, $alt,
248: $SingleTour);
249: my ($output) = '';
250:
251: %Tournament = &GetTournament($dbh, $Id) if ($Id);
252:
253: my ($URL) = $Tournament{'URL'};
254: my ($Info) = $Tournament{'Info'};
255: my ($Copyright) = $Tournament{'Copyright'};
256:
257: @Tours = &GetTours($dbh, $Id);
258:
259: if ($Id) {
260: for ($Tournament{'Type'}) {
261: /Г/ && do {
262: $output .= h2({align=>"center"},
1.6 boris 263: "Группа: $Tournament{'Title'} ",
264: "$Tournament{'PlayedAt'}") . p . "\n";
1.1 boris 265: last;
266: };
267: /Ч/ && do {
268: return &PrintTour($dbh, $Tours[0], $answer)
269: if ($#Tours == 0);
1.6 boris 270:
271: my $title="Пакет: $Tournament{'Title'}";
272: if ($Tournament{'PlayedAt'}) {
273: $title .= " $Tournament{'PlayedAt'}";
274: }
1.1 boris 275:
276: $output .= h2({align=>"center"},
1.6 boris 277: "$title") . p . "\n";
1.1 boris 278: last;
279: };
280: /Т/ && do {
281: return &PrintTour($dbh, $Id, $answer);
282: };
283: }
284: } else {
285: my ($qnum) = GetQNum($dbh);
286: $output .= h2("Банк Вопросов: $qnum вопросов") . p . "\n";
287: }
288:
289: for ($i = 0; $i <= $#Tours; $i++) {
290: %Tournament = &GetTournament($dbh, $Tours[$i]);
291:
292: if ($Tournament{'Type'} =~ /Ч/) {
293: $SingleTour = 0;
294: my (@Tours) = &GetTours($dbh, $Tournament{'Id'});
295: $SingleTour = 1
296: if ($#Tours == 0);
297: }
298: if ($Tournament{'QuestionsNum'} > 0) {
299: $qnum = " ($Tournament{'QuestionsNum'} вопрос" .
300: &Suffix($Tournament{'QuestionsNum'}) . ")\n";
301: } else {
302: $qnum = '';
303: }
304: if ($Tournament{'Type'} =~ /Г/) {
305: $imgsrc = "/icons/folder.gif";
306: $alt = "[*]";
307: } else {
308: $imgsrc = "/icons/folder.gif";
309: $alt = "[-]";
310: }
311:
312: if ($SingleTour or $Tournament{'Type'} =~ /Т/) {
313: $list .= dd(img({src=>$imgsrc, alt=>$alt})
1.6 boris 314: . " " . $Tournament{'Title'} . " " .
315: $Tournament{'PlayedAt'} . $qnum) .
1.1 boris 316: dl(
317: dd("["
318: . a({href=>url . "?tour=$Tournament{'Id'}&answer=0"},
319: "вопросы") . "] ["
320: . a({href=>url . "?tour=$Tournament{'Id'}&answer=1"},
321: "вопросы + ответы") . "]")
322: );
323: } else {
324: $list .= dd(a({href=>url . "?tour=$Tournament{'Id'}&comp=1"},
325: img({src=>'/icons/compressed.gif', alt=>'[ZIP]', border=>1}))
326: . " " . img({src=>$imgsrc, alt=>$alt})
327: . " " . a({href=>url . "?tour=$Tournament{'Id'}&answer=0"},
1.6 boris 328: $Tournament{'Title'}. " ".
329: $Tournament{'PlayedAt'}) . $qnum);
1.1 boris 330: }
331: }
332: $output .= dl($list);
333:
334: if ($URL) {
335: $output .=
336: p("Дополнительная информация об этом турнире - по адресу " .
337: a({-'href'=>$URL}, $URL));
338: }
339:
340: if ($Copyright) {
341: $output .= p("Копирайт: " . $Copyright);
342: }
343:
344: if ($Info) {
345: $output .= p($Info);
346: }
347:
348: return $output;
349: }
350:
351: sub Suffix {
352: my ($qnum) = @_;
353: my ($suffix) = 'а' if $qnum =~ /[234]$/;
354: $suffix = '' if $qnum =~ /1$/;
355: $suffix = 'ов' if $qnum =~ /[567890]$/ || $qnum =~ /1.$/;
356: return $suffix;
357: }
358:
359: sub IsTour {
360: my ($dbh, $Id) = @_;
361: my ($sth) = $dbh->prepare("SELECT Type FROM Tournaments
362: WHERE Id=$Id");
363: $sth->execute;
364: return ($sth->fetchrow)[0] =~ /Т/;
365: }
366:
367: # Gets a DB handler (ofcourse) and a tour Id. Prints all the
368: # question of that tour, according to the options.
369: sub PrintTour {
370: my ($dbh, $Id, $answer) = @_;
371: my ($output, $q, $bottom, $field) = ('', 0, '', '');
372:
373: my (%Tour) = &GetTournament($dbh, $Id);
374: my (@Tours) = &GetTours($dbh, $Tour{'ParentId'});
375: my (%Tournament) = &GetTournament($dbh, $Tour{'ParentId'});
376:
377: return 0
378: if ($Tour{'Type'} !~ /Т/);
379:
380: my ($qnum) = $Tour{'QuestionsNum'};
381: my ($suffix) = &Suffix($qnum);
382:
1.4 boris 383: $output .= h2({align=>"center"}, $Tournament{"Title"},
1.6 boris 384: $Tournament{'PlayedAt'},
1.4 boris 385: "<br>", $Tour{"Title"} .
1.1 boris 386: " ($qnum вопрос$suffix)\n") . p;
387:
388: my (@Questions) = &GetTourQuestions($dbh, $Id);
389: for ($q = 0; $q <= $#Questions; $q++) {
390: $output .= &PrintQuestion($dbh, $Questions[$q], $answer, 0);
391: }
392:
393: $output .= hr({-'align'=>'center', -'width'=>'80%'});
394:
395: if ($Tournament{'URL'}) {
396: $output .=
397: p("Дополнительная информация об этом турнире - по адресу " .
398: a({-'href'=>$Tournament{'URL'}}, $Tournament{'URL'}));
399: }
400:
401: if ($Tournament{'Copyright'}) {
402: $output .= p("Копирайт: " . $Tournament{'Copyright'});
403: }
404:
405: if ($Tournament{'Info'}) {
406: $output .= p($Tournament{'Info'});
407: }
408:
409:
410: if ($answer == 0) {
411: $bottom .=
412: "[" . a({href=>url . "?tour=$Id&answer=1"}, "ответы") . "] " . br;
413: }
414: if (&IsTour($dbh, $Id - 1)) {
415: $bottom .=
416: "[" . a({href=>url . "?tour=" . ($Id - 1) . "&answer=0"},
417: "предыдущий тур") . "] ";
418: $bottom .=
419: "[" . a({href=>url . "?tour=" . ($Id - 1) . "&answer=1"},
420: "предыдущий тур с ответами") . "] " . br;
421: }
422: if (&IsTour($dbh, $Id + 1)) {
423: $bottom .=
424: "[" . a({href=>url . "?tour=" . ($Id + 1) . "&answer=0"},
425: "следующий тур") . "] ";
426: $bottom .=
427: "[" . a({href=>url . "?tour=" . ($Id + 1) . "&answer=1"},
428: "следующий тур с ответами") . "] ";
429: }
430:
431: $output .=
432: p({align=>"center"}, font({size=>-1}, $bottom));
433:
434: return $output;
435: }
436:
437: sub PrintField {
438: my ($header, $value, $text) = @_;
439: if ($text) {
1.5 boris 440: $value =~ s/<[\/\w]*>//sg;
441: } else {
442: $value =~ s/^\s+/<br> /mg;
443: $value =~ s/^\|([^\n]*)/<pre>$1<\/pre>/mg;
1.1 boris 444: }
445: return $text ? "$header:\n$value\n\n" :
446: strong("$header: ") . $value . p . "\n";
447: }
448:
449: # Gets a DB handler (ofcourse) and a question Id. Prints
450: # that question, according to the options.
451: sub PrintQuestion {
452: my ($dbh, $Id, $answer, $qnum, $title, $text) = @_;
453: my ($output, $titles) = ('', '');
454:
455: my (%Question) = &GetQuestion($dbh, $Id);
456: if (!$text) {
457: $output .= hr({width=>"50%"});
458: if ($title) {
459: my (%Tour) = GetTournament($dbh, $Question{'ParentId'});
460: my (%Tournament) = GetTournament($dbh, $Tour{'ParentId'});
461: $titles .=
462: dd(img({src=>"/icons/folder.open.gif"}) . " " .
1.6 boris 463: a({href=>url . "?tour=$Tournament{'Id'}"}, $Tournament{'Title'}, $Tournament{'PlayedAt'}));
1.1 boris 464: $titles .=
465: dl(dd(img({src=>"/icons/folder.open.gif"}) . " " .
466: a({href=>url . "?tour=$Tour{'Id'}"}, $Tour{'Title'})));
467: }
468: $output .= dl(strong($titles));
469: }
470:
471: $qnum = $Question{'Number'}
472: if ($qnum == 0);
473:
474: $output .=
475: &PrintField("Вопрос $qnum", $Question{'Question'}, $text);
476:
477: if ($answer) {
478: $output .=
479: &PrintField("Ответ", $Question{'Answer'}, $text);
480:
481: if ($Question{'Authors'}) {
482: $output .= &PrintField("Автор(ы)", $Question{'Authors'}, $text);
483: }
484:
485: if ($Question{'Sources'}) {
486: $output .= &PrintField("Источник(и)", $Question{'Sources'}, $text);
487: }
488:
489: if ($Question{'Comments'}) {
490: $output .= &PrintField("Комментарии", $Question{'Comments'}, $text);
491: }
492: }
493: return $output;
494: }
495:
496: # Returns the total number of questions currently in the DB.
497: sub GetQNum {
498: my ($dbh) = @_;
499: my ($sth) = $dbh->prepare("SELECT COUNT(*) FROM Questions");
500: $sth->execute;
501: return ($sth->fetchrow)[0];
502: }
1.12 boris 503: sub GetMaxQId {
504: my ($dbh) = @_;
505: my ($sth) = $dbh->prepare("SELECT MAX(QuestionId) FROM Questions");
506: $sth->execute;
507: return ($sth->fetchrow)[0];
508: }
1.1 boris 509:
510: # Returns Id's of 12 random questions
511: sub Get12Random {
512: my ($dbh, $type, $num) = @_;
513: my ($i, @questions, $q, $t, $sth);
1.12 boris 514: my ($qnum) = &GetMaxQId($dbh);
1.1 boris 515: my (%chosen);
516: srand;
517:
1.11 boris 518: for ($i = 0; $i < $num; $i++) {
519: do {
520: $q = int(rand($qnum));
521: $sth = $dbh->prepare("SELECT Type FROM Questions
1.1 boris 522: WHERE QuestionId=$q");
1.11 boris 523: $sth->execute;
524: $t = ($sth->fetchrow)[0];
525: } until !$chosen{$q} && $t && $type =~ /[$t]/;
526: $chosen{$q} = 'y';
527: push @questions, $q;
528: }
529: return @questions;
1.1 boris 530: }
531:
532: sub Include_virtual {
533: my ($fn, $output) = (@_, '');
534:
535: open F , $fn
1.2 boris 536: or return; #die "Can't open the file $fn: $!\n";
1.1 boris 537:
538: while (<F>) {
539: if (/<!--#include/o) {
540: s/<!--#include virtual="\/(.*)" -->/&Include_virtual($1)/e;
541: }
542: if (/<!--#exec/o) {
543: s/<!--#exec.*cmd\s*=\s*"([^"]*)".*-->/`$1`/e;
544: }
545: $output .= $_;
546: }
547: return $output;
548: }
549:
550: sub PrintArchive {
551: my($dbh, $Id) = @_;
552: my ($output, @list, $i);
553:
554: my (%Tournament) = &GetTournament($dbh, $Id);
555: my (@Tours) = &GetTours($dbh, $Id);
556:
557: if ($Tournament{'Type'} =~ /Г/ || $Id == 0) {
558: for ($i = 0; $i <= $#Tours; $i++) {
559: push(@list ,&PrintArchive($dbh, $Tours[$i]));
560: }
561: return @list;
562: }
563: return "$SRCPATH/$Tournament{'FileName'} ";
564: }
565:
566: sub PrintAll {
567: my ($dbh, $Id) = @_;
568: my ($output, $list, $i);
569:
570: my (%Tournament) = &GetTournament($dbh, $Id);
571: my (@Tours) = &GetTours($dbh, $Id);
572: my ($New) = ($Id and $Tournament{'Type'} eq 'Ч' and
573: &NewEnough($Tournament{"CreatedAt"})) ?
574: img({src=>"/znatoki/dimrub/db/new-sml.gif", alt=>"NEW!"}) : "";
575:
576: if ($Id == 0) {
577: $output = h3("Все турниры");
578: } else {
579: $output .= dd(img({src=>"/icons/folder.gif", alt=>"[*]"}) .
580: " " . a({href=>url . "?tour=$Tournament{'Id'}&answer=0"},
1.6 boris 581: $Tournament{'Title'}) ." " . $Tournament{'PlayedAt'} . " $New");
1.1 boris 582: }
583: if ($Id == 0 or $Tournament{'Type'} =~ /Г/) {
584: for ($i = 0; $i <= $#Tours; $i++) {
585: $list .= &PrintAll($dbh, $Tours[$i]);
586: }
587: $output .= dl($list);
588: }
589: return $output;
590: }
591:
592: sub PrintDates {
593: my ($dbh) = @_;
594: my ($from) = param('from_year') . "-" . param('from_month') .
595: "-" . param('from_day');
596: my ($to) = param('to_year') . "-" . param('to_month') . "-" . param('to_day');
597: $from = $dbh->quote($from);
598: $to = $dbh->quote($to);
599: my ($sth) = $dbh->prepare("
600: SELECT DISTINCT Id
601: FROM Tournaments
602: WHERE PlayedAt >= $from AND PlayedAt <= $to
603: AND Type = 'Ч'
604: ");
605: $sth->execute;
606: my (%Tournament, @array, $output, $list);
607:
608: $output = h3("Список турниров, проходивших между $from и $to.");
609: while (@array = $sth->fetchrow) {
610: next
611: if (!$array[0]);
612: %Tournament = &GetTournament($dbh, $array[0]);
613: $list .= dd(img({src=>"/icons/folder.gif", alt=>"[*]"}) .
614: " " . a({href=>url . "?tour=$Tournament{'Id'}&answer=0"},
1.6 boris 615: $Tournament{'Title'}, $Tournament{'PlayedAt'}));
1.1 boris 616: }
617: $output .= dl($list);
618: return $output;
619: }
620:
621: MAIN:
622: {
623: setlocale(LC_CTYPE,'russian');
624: my($i, $tour);
625: my($text) = (param('text')) ? 1 : 0;
626: my($dbh) = DBI->connect("DBI:mysql:chgk", "piataev", "")
627: or do {
628: print h1("Временные проблемы") . "База данных временно не
629: работает. Заходите попозже.";
630: print &Include_virtual("../dimrub/db/reklama.html");
631: print end_html;
632: die "Can't connect to DB chgk\n";
633: };
1.11 boris 634: if (!param('comp') and !param('sqldump') and !$text) {
1.1 boris 635: print header;
636: print start_html(-"title"=>'Database of the questions',
637: -author=>'dimrub@icomverse.com',
638: -bgcolor=>'#fff0e0',
639: -vlink=>'#800020');
640: print &Include_virtual("../dimrub/db/reklama.html");
641: }
642:
643: if ($text) {
644: print header('text/plain');
645: }
646:
647: if (param('rand')) {
1.7 boris 648: my ($type, $qnum) = ('', 12);
649: $type .= 'Б' if (param('brain'));
650: $type .= 'Ч' if (param('chgk'));
1.1 boris 651: $qnum = param('qnum') if (param('qnum') =~ /^\d+$/);
1.7 boris 652: $qnum = 0 if (!$type);
1.1 boris 653: if (param('email') && -x $SENDMAIL &&
654: open(F, "| $SENDMAIL -t -n")) {
655: my ($Email) = param('email');
656: my ($mime_type) = $text ? "plain" : "html";
657: print F <<EOT;
658: To: $Email
1.8 boris 659: From: olegstemanov\@mail.ru
1.1 boris 660: Subject: Sluchajnij Paket Voprosov "Chto? Gde? Kogda?"
661: MIME-Version: 1.0
662: Content-type: text/$mime_type; charset="koi8-r"
663:
664: EOT
665: print F &PrintRandom($dbh, $type, $qnum, $text);
666: close F;
667: print "Пакет случайно выбранных вопросов послан. Нажмите
668: на <B>Reload</B> для получения еще одного пакета";
669: } else {
670: print &PrintRandom($dbh, $type, $qnum, $text);
671: }
672: } elsif (param('sstr')) {
1.14 roma7 673: &PrintSearch($dbh, param('sstr'), param('metod'));
1.1 boris 674: } elsif (param('all')) {
675: print &PrintAll($dbh, 0);
676: } elsif (param('from_year') && param('to_year')) {
677: print &PrintDates($dbh);
678: } elsif (param('comp')) {
1.9 boris 679: print header(
680: -'Content-Type' => 'application/x-zip-compressed; name="db.zip"',
681: -'Content-Disposition' => 'attachment; filename="db.zip"'
682: );
683: $tour = (param('tour')) ? param('tour') : 0;
684: my (@files) = &PrintArchive($dbh, $tour);
685: open F, "$ZIP -j - $SRCPATH/COPYRIGHT @files |";
686: print (<F>);
687: close F;
688: $dbh->disconnect;
689: exit;
690: } elsif (param('sqldump')) {
691: print header(
692: -'Content-Type' => 'application/x-zip-compressed; name="dump.zip"',
693: -'Content-Disposition' => 'attachment; filename="dump.zip"'
694: );
1.10 boris 695: open F, "$ZIP -j - $DUMPFILE |";
1.9 boris 696: print (<F>);
697: close F;
698: $dbh->disconnect;
699: exit;
700:
1.1 boris 701: } else {
702: $tour = (param('tour')) ? param('tour') : 0;
703: if ($tour !~ /^[0-9]*$/) {
704: my ($sth) = $dbh->prepare("SELECT Id FROM Tournaments
705: WHERE FileName = '$tour.txt'");
706: $sth->execute;
707: $tour = ($sth->fetchrow)[0];
708: }
709: print &PrintTournament($dbh, $tour, param('answer'));
710: }
711: if (!$text) {
712: print &Include_virtual("../dimrub/db/footer.html");
713: print end_html;
714: }
715: $dbh->disconnect;
716: }
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