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

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

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>