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

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

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