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

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

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