[BACK]Return to subroutines.pl CVS log [TXT] [DIR] Up to [Local Repository] / processmail

Diff for /processmail/subroutines.pl between versions 3.1 and 3.4

version 3.1, 2008/03/24 16:01:47 version 3.4, 2013/10/30 20:29:22
Line 17  sub readhash Line 17  sub readhash
             {              {
                 print STDERR "\#$number. Score: $score\n",$answer;                  print STDERR "\#$number. Score: $score\n",$answer;
             }              }
             if ($answer ne "" && $number >0)              if ($answer ne "" && $number >= 0)
             {              {
                 $$answers[$number]->{$answer}->{score} = $score;                  $$answers[$number]->{$answer}->{score} = $score;
                 %{$$answers[$number]->{$answer}->{teams}} = ();                  %{$$answers[$number]->{$answer}->{teams}} = ();
Line 33  sub readhash Line 33  sub readhash
         }          }
         if (/^\s*\*\*\*\s*$/)          if (/^\s*\*\*\*\s*$/)
         {          {
             if ($answer ne "" && $number >0)              if ($answer ne "" && $number >= 0)
             {              {
                 $$answers[$number]->{$answer}->{score} = $score;                  $$answers[$number]->{$answer}->{score} = $score;
             }              }
Line 73  sub readmail Line 73  sub readmail
             $$table{$team}->{'numletters'}++;              $$table{$team}->{'numletters'}++;
             if ($$table{$team}->{regnum} != $2)              if ($$table{$team}->{regnum} != $2)
             {              {
                 print STDERR "Warning: Team $team uses registration nos. ",                  print STDERR "Warning: Team $team uses registration numbers ",
                 $$table{$team}->{regnum}, " and $2!\n";                        "'" . $$table{$team}->{regnum} . "'", " and '$2'!\n";
             }              }
             next;              next;
         }          }
Line 112  sub readmail Line 112  sub readmail
 #  #
 sub canonize_answer  sub canonize_answer
 {  {
     s/^\s*(.*)\s*$/  $1/;      s/^\s*(.*?)\s*$/  $1/;    
     if (/^\s*$/)       if (/^\s*$/) 
     {      {
         return "";          return "";
Line 129  sub canonize_answer Line 129  sub canonize_answer
 sub collect_answers  sub collect_answers
 {  {
     my ($teams,$answers) = @_;      my ($teams,$answers) = @_;
     for ($i=1;$i<=$MAXQUEST;$i++)      for ($i=$MINQUEST;$i<=$MAXQUEST;$i++)
     {      {
         foreach $team (keys %$teams)          foreach $team (keys %$teams)
         {          {
Line 176  sub dumphash Line 176  sub dumphash
     }      }
     return 1;      return 1;
 }  }
   
 #  #
 # Сбрасываем ответы на вопрос $number с оценкой $symbol  # Сбрасываем ответы на вопрос $number с оценкой $symbol
 # в формате, пригодном для собрания сочинений  # в формате, пригодном для собрания сочинений
Line 239  sub rate_questions Line 240  sub rate_questions
 #  #
 # Подсчитываем рейтинги команд  # Подсчитываем рейтинги команд
 # @{$nopoint_questions} - список номеров вопросов, идущих вне зачёта.  # @{$nopoint_questions} - список номеров вопросов, идущих вне зачёта.
 # Для них проставляются плясы/минусы, но они не учитываются в подсчёте  # Для них проставляются плюсы/минусы, но они не учитываются в подсчёте
 # очков и рейтингов команд.  # очков и рейтингов команд.
 #  #
 sub find_scores  sub find_scores
Line 287  sub check_dup_numbers Line 288  sub check_dup_numbers
   
     # Имена команд, номера которых встречаются >1 раза.      # Имена команд, номера которых встречаются >1 раза.
     # Массив uniq_compr_names содержит по одному имени на каждый повторяющийся      # Массив uniq_compr_names содержит по одному имени на каждый повторяющийся
     # номер (чуть позже мы найдём все имена, соответствующие каждому из       # номер (чуть позже мы найдём все имена, соответствующие каждому из       
     # этих номеров).      # этих номеров).                                                          
     # '+0' - чтобы номера обрабатывались как числа (072 == 72).      # '+0' - чтобы номера обрабатывались как числа (072 == 72).
     my @uniq_compr_names =      my @uniq_compr_names =
        grep( $seen{$teams->{$_}->{regnum}+0}++ > 1, keys %$teams );         grep( ++$seen{$teams->{$_}->{regnum}+0} > 1, keys %$teams );
   
     # А теперь извлекаем номера из полученного списка.      # А теперь извлекаем номера из полученного списка.
     my @dup_numbers = map {$teams->{$_}->{regnum}} @uniq_compr_names;      my @dup_numbers = map {$teams->{$_}->{regnum}} @uniq_compr_names;
Line 301  sub check_dup_numbers Line 302  sub check_dup_numbers
     if ( @dup_numbers ) {      if ( @dup_numbers ) {
         print STDERR "\nВНИМАНИЕ!  Одинаковые номера у нескольких команд:\n";          print STDERR "\nВНИМАНИЕ!  Одинаковые номера у нескольких команд:\n";
         foreach my $num ( @dup_numbers ) {          foreach my $num ( @dup_numbers ) {
             my @dup_names = grep($teams->{$_}->{regnum} == $num, keys %$teams);              my @dup_names = grep($teams->{$_}->{regnum}+0 == $num+0, keys %$teams);
             print STDERR "\tНомер $num: " .  join(", ", @dup_names) . "\n";              print STDERR "\tНомер $num: " .  join(", ", @dup_names) . "\n";
         }          }
         print STDERR "\n";          print STDERR "\n";
Line 309  sub check_dup_numbers Line 310  sub check_dup_numbers
 }  }
   
   
   #
   # Считаем ответы на вопрос $number с оценкой $symbol
   # (фактически, это anondump(), только без печати списка
   # таких ответов).
   #
   sub countanswers
   {
       my ($teams,$answers,$number,$symbol) = @_;
       my $num=0;
       foreach $answer (keys %{$answers->[$number]})
       {
           if ($$answers[$number]->{$answer}{score} eq $symbol)
           {
               $num++;
           }
       }
       return $num;
   }
   
   
 1;  1;
Removed from v.3.1  
changed lines
  Added in v.3.4

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