Return to processmail.pl CVS log

Up to [Local Repository] / processmail

New changes from Lev

    1: #!/usr/bin/perl
    2: #$Id: processmail.pl,v 3.3 2013/10/30 19:28:30 boris Exp $
    3: #
    4: #
    5: # Исходные файлы и параметры
    6: #
    7: 
    8:     use Getopt::Std; 
    9: 
   10: $usage = 'processmail.pl $Revision: 3.3 $, $Date: 2013/10/30 19:28:30 $'. "\n".
   11: "Usage: processmail.pl [-d] [-t table_file]  [-o results] \n";
   12: 
   13: require 'parameters.pl';
   14: require 'subroutines.pl';
   15: 
   16: die $usage unless getopts('t:o:d');
   17: 
   18: $DEBUG=$opt_d;
   19: 
   20: # Находим максимальный и минимальный вопрос и слегка подстраховываемся.
   21: $MINQUEST=1e99;
   22: $MAXQUEST=-1;
   23: for (my $r=1; $r<=$ROUNDS; $r++) {
   24:     if ($MINQUEST>$MINQUEST[$r]) {
   25: 	$MINQUEST=$MINQUEST[$r];
   26:     }
   27:     if ($MAXQUEST<$MAXQUEST[$r]) {
   28: 	$MAXQUEST=$MAXQUEST[$r];
   29:     }
   30: }
   31: if ($MINQUEST < 0 || $MAXQUEST < 0) {
   32:    die "Отрицательные номера вопросов не поддерживаются!\n";
   33: }
   34: 
   35: 
   36: my %teams;
   37: my @answers;
   38: #
   39: # Читаем старые результаты
   40: #
   41: if ($opt_t)
   42: {
   43:     die "Cannot open $opt_t\n" unless open(INFILE,$opt_t);
   44:     readhash(\@answers);
   45:     close(INFILE);
   46: }
   47: 
   48: #
   49: # Читаем ответы команд для ВСЕХ зачётов
   50: #
   51: for (my $r=1; $r<=$ROUNDS; $r++) {
   52:     foreach my $file ( @{$FILES[$r]} ) {
   53: 	open (INFILE, $file);
   54: 	readmail(\%teams);
   55: 	collect_answers(\%teams,\@answers);
   56: 	close (INFILE);
   57:     }
   58: }
   59: 
   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: for ($i=$MINQUEST;$i<=$MAXQUEST;$i++)
   69: {
   70:     foreach $symbol ('+','-','?')
   71:     {
   72: 	dumphash(\%teams,\@answers,$i,$symbol);
   73:     }
   74: }
   75: print "***\n";
   76: 
   77: #
   78: # На всякий случай проверяем на наличие команд с дублирующимися номерами.
   79: #
   80: check_dup_numbers(\%teams);