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

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

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