--- processmail/subroutines.pl 2008/03/23 17:50:50 3.0 +++ processmail/subroutines.pl 2008/03/24 16:01:47 3.1 @@ -1,7 +1,7 @@ # В этот файл собраны процедуры, общие для всей системы # работы с ответами. # -#$Id: subroutines.pl,v 3.0 2008/03/23 17:50:50 boris Exp $ +#$Id: subroutines.pl,v 3.1 2008/03/24 16:01:47 boris Exp $ # sub readhash { @@ -276,18 +276,38 @@ 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;