Return to createtable.pl CVS log

Up to [Local Repository] / processmail

Annotation of processmail/createtable.pl, revision 1.1

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