processmail/subroutines.pl - diff

Return to subroutines.pl CVS log

Up to [Local Repository] / processmail

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

version 3.4, 2013/10/30 20:29:22	version 3.0, 2008/03/23 17:50:50
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 numbers ",	print STDERR "Warning: Team $team uses registration nos. ",
"'" . $$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=$MINQUEST;$i<=$MAXQUEST;$i++)	for ($i=1;$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 240 sub rate_questions	Line 239 sub rate_questions
#	#
# Подсчитываем рейтинги команд	# Подсчитываем рейтинги команд
# @{$nopoint_questions} - список номеров вопросов, идущих вне зачёта.	# @{$nopoint_questions} - список номеров вопросов, идущих вне зачёта.
# Для них проставляются плюсы/минусы, но они не учитываются в подсчёте	# Для них проставляются плясы/минусы, но они не учитываются в подсчёте
# очков и рейтингов команд.	# очков и рейтингов команд.
#	#
sub find_scores	sub find_scores
Line 277 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}+0 == $num+0, keys %$teams);
print STDERR "\tНомер $num: " . join(", ", @dup_names) . "\n";
}
print STDERR "\n";
}
}


#
# Считаем ответы на вопрос $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;

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

Removed from v.3.4
changed lines
	Added in v.3.0