Annotation of processmail/createtable2.pl, revision 1.1

1.1     ! boris       1: #!/usr/local/bin/perl
        !             2: #$Id: createtable.pl,v 1.2 2002/02/04 16:23:23 boris Exp $
        !             3: #
        !             4: #
        !             5: #
        !             6: # Исходные файлы и параметры
        !             7: #
        !             8: 
        !             9:     use Getopt::Std; 
        !            10: 
        !            11: $usage = 'createtable.pl $Revision: 1.2 $, $Date: 2002/02/04 16:23:23 $'. "\n".
        !            12: "Usage: createtable.pl [-d] [-s] [-t answers_file] [-m mail_file]  [-o results] \n";
        !            13: 
        !            14: require 'parameters.pl';
        !            15: require 'subroutines.pl';
        !            16: 
        !            17: die $usage unless getopts('t:m:o:ds');
        !            18: 
        !            19: $DEBUG=$opt_d;
        !            20: $SHORT=$opt_s;
        !            21: 
        !            22: my %teams;
        !            23: my @answers;
        !            24: my @ratings;
        !            25: #
        !            26: # Читаем старые результаты
        !            27: #
        !            28: if ($opt_t)
        !            29: {
        !            30:     die "Cannot open $opt_t\n" unless open(INFILE,$opt_t);
        !            31:     readhash(\@answers);
        !            32:     close(INFILE);
        !            33: }
        !            34: 
        !            35: #
        !            36: # Читаем ответы команд
        !            37: #
        !            38: if ($opt_m)
        !            39: {
        !            40:     die "Cannot open $opt_m\n" unless open(INFILE,$opt_m)
        !            41: }
        !            42: else
        !            43: {
        !            44:     *INFILE=*STDIN;
        !            45: }
        !            46: readmail(\%teams);
        !            47: close(INFILE);
        !            48: #
        !            49: # Чистим хэш %answers
        !            50: #
        !            51: collect_answers(\%teams,\@answers);
        !            52: #
        !            53: # Подсчитываем рейтинги вопросов
        !            54: #
        !            55: rate_questions(\%teams,\@answers,\@ratings);
        !            56: #
        !            57: # Вычисляем число ответов и рейтинги команд
        !            58: #
        !            59: find_scores(\%teams,\@answers,\@ratings);
        !            60: #
        !            61: # Ну а теперь печатаем саму таблицу...
        !            62: #
        !            63: if ($opt_o)
        !            64: { 
        !            65:     die "Cannot open $opt_o\n" unless open(OUTFILE,">$opt_o");
        !            66:     select OUTFILE;
        !            67: }
        !            68: #
        !            69: # Печатаем заголовок
        !            70: #
        !            71: printf "%5s ", "N";
        !            72: for ($i=1;$i<=$MAXQUEST;$i++)
        !            73: {
        !            74:     if ($SHORT) {
        !            75:        printf("%1d",$i%10);
        !            76:     } else {
        !            77:        printf "%3d",$i;
        !            78:     }
        !            79: }
        !            80: printf "%3s","О";
        !            81: printf "%4s","Р";
        !            82: printf " КОМАНДА";
        !            83: print "\n";
        !            84: #
        !            85: # Печатаем команды построчно
        !            86: #
        !            87: foreach $team (sort 
        !            88:                {
        !            89:                    $teams{$b}->{score} <=> $teams{$a}->{score}
        !            90:                    or
        !            91:                        $teams{$b}->{rating} <=> $teams{$a}->{rating}
        !            92:                } keys %teams
        !            93:               )
        !            94: {
        !            95:     printf "%5d ",$teams{$team}->{regnum};
        !            96:     for ($i=1;$i<=$MAXQUEST;$i++)
        !            97:     {
        !            98:        my $answer = $teams{$team}->{answers}[$i];
        !            99:        my $score = $answers[$i]->{$answer}->{score};
        !           100:        $score = '-' unless $score;
        !           101:        if ($SHORT) {
        !           102:            printf "%1s",$score;
        !           103:        } else {
        !           104:            printf "%3s", $score;
        !           105:        }
        !           106:     }
        !           107:     printf "%3s",$teams{$team}->{score};
        !           108:     printf "%4s",$teams{$team}->{rating};
        !           109:     print " $team";
        !           110:     print "\n";
        !           111: }
        !           112: #
        !           113: # Печатаем последнюю строку таблицы
        !           114: # в ней рейтинги вопросов
        !           115: #
        !           116: if ($SHORT) {
        !           117:     print "Рейтинг\n";
        !           118:     for ($j=0;$j<$MAXQUEST/12;$j++) {
        !           119:        my $max=$j*12+12;
        !           120:        if ($max>$MAXQUEST) {
        !           121:            $max=$MAXQUEST;
        !           122:        }
        !           123:        for ($i=$j*12+1;$i<=$max;$i++){
        !           124:            printf("%3s",$i);
        !           125:        }
        !           126:        printf "\n";
        !           127:        for ($i=1+$j*12;$i<=$max;$i++){
        !           128:            printf("%3s",$ratings[$i]);
        !           129:        }
        !           130:        printf "\n";
        !           131:     }
        !           132: } else {
        !           133:     printf "%5s ", "Р";
        !           134:     for ($i=1; $i<=$MAXQUEST;$i++)
        !           135:     {
        !           136:         printf "%3s", $ratings[$i];
        !           137:     }
        !           138:     print "\n";
        !           139: }

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