Return to collection.pl CVS log

Up to [Local Repository] / processmail

Lev's changes

    1: #!/usr/bin/perl
    2: #
    3: #$Id: collection.pl,v 3.2 2013/10/11 15:39:35 boris Exp $
    4: #
    5: # Собрание сочинений
    6: #
    7: 
    8: use Getopt::Std; 
    9: 
   10: $usage = 
   11: "Usage: collection.pl [-d] [-s|-m] [-t table_file]  [-o results] \n";
   12: 
   13: require 'parameters.pl';
   14: require 'subroutines.pl';
   15: 
   16: die $usage unless getopts('t:o:dsm');
   17: 
   18: $DEBUG=$opt_d;
   19: $SHORT=$opt_s;
   20: $MEDIUM=$opt_m;
   21: 
   22: # Находим максимальный вопрос
   23: $MAXQUEST=1;
   24: for (my $i=1; $i<=$ROUNDS; $i++) {
   25:     if ($MAXQUEST<$MAXQUEST[$i]) {
   26: 	$MAXQUEST=$MAXQUEST[$i];
   27:     }
   28: }
   29: 
   30: 
   31: 
   32: my %teams;
   33: my @answers;
   34: #
   35: # Читаем старые результаты
   36: #
   37: if ($opt_t)
   38: {
   39:     die "Cannot open $opt_t\n" unless open(INFILE,$opt_t);
   40:     readhash(\@answers);
   41:     close(INFILE);
   42: }
   43: 
   44: #
   45: # Читаем ответы команд
   46: #
   47: for (my $i=1; $i<=$ROUNDS; $i++) {
   48:     foreach my $file ( @{$FILES[$i]} ) {
   49: 	open (INFILE, $file);
   50: 	readmail(\%teams);
   51: 	collect_answers(\%teams,\@answers);
   52: 	close (INFILE);
   53:     }
   54: }
   55: 
   56: #
   57: # Пишем измененную таблицу в файл.
   58: #
   59: if ($opt_o)
   60: { 
   61:     die "Cannot open $opt_o\n" unless open(OUTFILE,">$opt_o");
   62:     select OUTFILE;
   63: }
   64: for ($i=1;$i<=$MAXQUEST;$i++)
   65: {
   66:     print "\nВОПРОС $i:\n";
   67:     if ( ! $SHORT || countanswers(\%teams,\@answers,$i,'+') ) {
   68:         print "\nЗАСЧИТАНО:\n";
   69:         anondump(\%teams,\@answers,$i,'+');
   70:     }
   71:     if ( ! $SHORT || countanswers(\%teams,\@answers,$i,'+') ) {
   72:         print "\nНЕ ЗАСЧИТАНО:\n";
   73:         anondump(\%teams,\@answers,$i,'-');
   74:     }
   75:     if ( ! ($SHORT || $MEDIUM) || countanswers(\%teams,\@answers,$i,'?') ) {
   76:         print "\nНЕ ЯСНО:\n";
   77:         anondump(\%teams,\@answers,$i,'?');
   78:     }
   79:     print "\n"; 			# Added by LG for better readability
   80: }
   81: print "***\n";
   82: 
   83: #
   84: # На всякий случай проверяем на наличие команд с дублирующимися номерами.
   85: #
   86: check_dup_numbers(\%teams);
   87: