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

1.1     ! roma7       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: my $debug=1; #added by R7
        !             9: my ($PWD) = `pwd`;
        !            10: chomp $PWD;
        !            11: my ($SRCPATH) = "$PWD/../dimrub/src";
        !            12: my ($ZIP) = "/home/piataev/bin/zip";
        !            13: my $DUMPFILE = "/tmp/chgkdump";
        !            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',
        !            19:        'Dec', '11',
        !            20:         'Янв', '0', 'Фев', 1, 'Мар', 2, 'Апр', 3, 'Май', '4',
        !            21:         'Июн', '5', 'Июл', 6, 'Авг', '7', 'Сен', '8', 
        !            22:         'Окт', '9', 'Ноя', '19', 'Дек', '11');
        !            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, $metod) = @_;
        !           109:        my (@arr, @Questions, @fields);
        !           110:        my (@sar, $i, $sth,$where);
        !           111: 
        !           112: #      push @fields, 'Question';
        !           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/) {
        !           144:                if (param($_)) {
        !           145:                        push @fields, "IFNULL($_, '')";
        !           146:                }
        !           147:          }
        !           148: 
        !           149:          @sar = split " ", $sstr;
        !           150:          for $i (0 .. $#sar) {
        !           151:                $sar[$i] = $dbh->quote("%${sar[$i]}%");
        !           152:          }
        !           153: 
        !           154:          my($f) = "CONCAT(" . join(',', @fields) . ")";
        !           155:          if (param('all') eq 'yes') {
        !           156:                $sstr = join " AND $f LIKE ", @sar;
        !           157:          } else {
        !           158:                $sstr = join " OR $f LIKE ", @sar;
        !           159:          }
        !           160:        
        !           161:          $sth = $dbh->prepare("SELECT QuestionId FROM Questions
        !           162:                WHERE $f LIKE $sstr ORDER BY QuestionId");
        !           163: 
        !           164:        } #else -- processing old-style query (R7)
        !           165: 
        !           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 {
        !           190:        my ($dbh, $sstr, $metod) = @_;
        !           191:         my (@Questions) = &Search($dbh, $sstr,$metod);
        !           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: 
        !           211:        my(@sar) = split(' ', $sstr);
        !           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"}, 
        !           260:                                              "Группа: $Tournament{'Title'} ",
        !           261:                                              "$Tournament{'PlayedAt'}") . p . "\n";
        !           262:                                last;
        !           263:                        };
        !           264:                        /Ч/ && do {
        !           265:                                return &PrintTour($dbh, $Tours[0], $answer)
        !           266:                                        if ($#Tours == 0);
        !           267:                                
        !           268:                                my $title="Пакет: $Tournament{'Title'}";
        !           269:                                if ($Tournament{'PlayedAt'}) {
        !           270:                                    $title .= " $Tournament{'PlayedAt'}";
        !           271:                                }
        !           272: 
        !           273:                                $output .= h2({align=>"center"}, 
        !           274:                                        "$title") . p . "\n";
        !           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})
        !           311:                                . " " . $Tournament{'Title'} . " " .
        !           312:                                    $Tournament{'PlayedAt'} . $qnum) . 
        !           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"}, 
        !           325:                                $Tournament{'Title'}. " ". 
        !           326:                                          $Tournament{'PlayedAt'}) . $qnum);
        !           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:        
        !           380:        $output .= h2({align=>"center"}, $Tournament{"Title"}, 
        !           381:                      $Tournament{'PlayedAt'},
        !           382:                      "<br>", $Tour{"Title"} . 
        !           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) {
        !           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;
        !           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"}) . " " .
        !           460:                                         a({href=>url . "?tour=$Tournament{'Id'}"}, $Tournament{'Title'}, $Tournament{'PlayedAt'}));
        !           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: }
        !           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: }
        !           506: 
        !           507: # Returns Id's of 12 random questions
        !           508: sub Get12Random {
        !           509:    my ($dbh, $type, $num) = @_;
        !           510:        my ($i, @questions, $q, $t, $sth);
        !           511:        my ($qnum) = &GetMaxQId($dbh);
        !           512:        my (%chosen);
        !           513:        srand;
        !           514:        
        !           515:    for ($i = 0; $i < $num; $i++) {
        !           516:        do {
        !           517:           $q = int(rand($qnum));
        !           518:           $sth = $dbh->prepare("SELECT Type FROM Questions
        !           519:                                WHERE QuestionId=$q");
        !           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;
        !           527: }
        !           528: 
        !           529: sub Include_virtual {
        !           530:        my ($fn, $output) = (@_, '');
        !           531: 
        !           532:        open F , $fn
        !           533:                or return; #die "Can't open the file $fn: $!\n";
        !           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"},
        !           578:       $Tournament{'Title'}) ." " . $Tournament{'PlayedAt'} . " $New");
        !           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"},
        !           612:       $Tournament{'Title'}, $Tournament{'PlayedAt'}));
        !           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:                };
        !           631:        if (!param('comp') and !param('sqldump') and !$text) {
        !           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')) {
        !           645:                my ($type, $qnum) = ('', 12);
        !           646:                $type .= 'Б' if (param('brain'));
        !           647:                $type .= 'Ч' if (param('chgk'));
        !           648:                $qnum = param('qnum') if (param('qnum') =~ /^\d+$/);    
        !           649:                $qnum = 0 if (!$type);
        !           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
        !           656: From: olegstemanov\@mail.ru
        !           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')) {
        !           670:                &PrintSearch($dbh, param('sstr'), param('metod'));
        !           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')) {
        !           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:                         );
        !           692:            open F, "$ZIP -j - $DUMPFILE |";
        !           693:            print (<F>);
        !           694:            close F;
        !           695:            $dbh->disconnect;
        !           696:            exit;
        !           697: 
        !           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>