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

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

version 1.5, 2005/02/16 22:20:08 version 3.1, 2008/03/24 16:01:47
Line 238  sub rate_questions Line 238  sub rate_questions
   
 #  #
 # Подсчитываем рейтинги команд  # Подсчитываем рейтинги команд
   # @{$nopoint_questions} - список номеров вопросов, идущих вне зачёта.
   # Для них проставляются плясы/минусы, но они не учитываются в подсчёте
   # очков и рейтингов команд.
 #  #
 sub find_scores  sub find_scores
 {  {
     my ($teams,$answers,$ratings,$round,$factor) = @_;      my ($teams,$answers,$ratings,$round,$factor,$nopoint_questions) = @_;
     foreach $team (keys %$teams)      foreach $team (keys %$teams)
     {      {
         if (!defined($factor)) {          if (!defined($factor)) {
Line 254  sub find_scores Line 257  sub find_scores
             my $answer=$$teams{$team}->{answers}[$i];              my $answer=$$teams{$team}->{answers}[$i];
             if ($$answers[$i]->{$answer}{score} eq '+')              if ($$answers[$i]->{$answer}{score} eq '+')
             {              {
                   next if  ( @{$nopoint_questions} && 
                             grep($_==$i, @{$nopoint_questions})
                            );
                 $$teams{$team}->{score}  += 1;                  $$teams{$team}->{score}  += 1;
                 $$teams{$team}->{rating} +=                  $$teams{$team}->{rating} +=
                     $$ratings[$i];                      $$ratings[$i];
Line 270  sub find_scores Line 276  sub find_scores
 }  }
   
   
 1;  #
   # Проверяем на наличие дублирующихся номеров у разных команд.
   #
   sub check_dup_numbers
   {
       my ($teams) = @_;
   
   
   
   
   
       my %seen;
   
       # Имена команд, номера которых встречаются >1 раза.
       # Массив uniq_compr_names содержит по одному имени на каждый повторяющийся
       # номер (чуть позже мы найдём все имена, соответствующие каждому из 
       # этих номеров).
       # '+0' - чтобы номера обрабатывались как числа (072 == 72).
       my @uniq_compr_names =
          grep( $seen{$teams->{$_}->{regnum}+0}++ > 1, keys %$teams );
   
       # А теперь извлекаем номера из полученного списка.
       my @dup_numbers = map {$teams->{$_}->{regnum}} @uniq_compr_names;
       @dup_numbers = sort @dup_numbers;
   
       # И печатаем предупреждение.
       if ( @dup_numbers ) {
           print STDERR "\nВНИМАНИЕ!  Одинаковые номера у нескольких команд:\n";
           foreach my $num ( @dup_numbers ) {
               my @dup_names = grep($teams->{$_}->{regnum} == $num, keys %$teams);
               print STDERR "\tНомер $num: " .  join(", ", @dup_names) . "\n";
           }
           print STDERR "\n";
       }
   }
   
   
   
   1;
Removed from v.1.5  
changed lines
  Added in v.3.1

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