Return to collection.pl CVS log

Up to [Local Repository] / processmail

Annotation of processmail/collection.pl, revision 3.3

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