Annotation of db/prgsrc/db.cgi, revision 1.1

1.1     ! boris       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>