--- processmail/subroutines.pl 2002/02/04 17:18:33 1.1 +++ processmail/subroutines.pl 2005/02/15 19:27:51 1.4 @@ -1,7 +1,7 @@ # В этот файл собраны процедуры, общие для всей системы # работы с ответами. # -#$Id: subroutines.pl,v 1.1 2002/02/04 17:18:33 boris Exp $ +#$Id: subroutines.pl,v 1.4 2005/02/15 19:27:51 boris Exp $ # sub readhash { @@ -20,6 +20,7 @@ sub readhash if ($answer ne "" && $number >0) { $$answers[$number]->{$answer}->{score} = $score; + %{$$answers[$number]->{$answer}->{teams}} = (); } $answer = ""; $number = $1; @@ -65,9 +66,11 @@ sub readmail { my @teamanswers = (); my %teamhash = ('answers' => \@teamanswers, - 'regnum' => $2); + 'regnum' => $2, + 'numletters'=>0); $$table{$team} = \%teamhash; } + $$table{$team}->{'numletters'}++; if ($$table{$team}->{regnum} != $2) { print STDERR "Warning: Team $team uses registration nos. ", @@ -128,11 +131,6 @@ sub collect_answers my ($teams,$answers) = @_; for ($i=1;$i<=$MAXQUEST;$i++) { - foreach $answer (keys %{$$answers[$i]}) - { - @{$$answers[$i]->{$answer}->{teams}} = (); - } - foreach $team (keys %$teams) { $answer = $$teams{$team}->{answers}[$i]; @@ -140,24 +138,12 @@ sub collect_answers { next; } - if (exists $$answers[$i]->{$answer}) - { - push @{$$answers[$i]->{$answer}->{teams}}, $team; - } - else + $$answers[$i]->{$answer}->{teams}->{$team}=1; + if (!exists $$answers[$i]->{$answer}->{score}) { - my @tmp=($team); - $$answers[$i]->{$answer}->{teams} = \@tmp; $$answers[$i]->{$answer}->{score} = '?'; } } - foreach $answer (keys %{$$answers[$i]}) - { - if (scalar @{$$answers[$i]->{$answer}->{teams}} == 0) - { - delete $$answers[$i]->{$answer}; - } - } } return 1; @@ -174,13 +160,13 @@ sub dumphash if ($$answers[$number]->{$answer}{score} eq $symbol) { print "\#$number. Frequency: ", - scalar @{$answers->[$number]->{$answer}->{teams}}, + scalar keys %{$answers->[$number]->{$answer}->{teams}}, ". Score: ", $$answers[$number]->{$answer}{score},"\n"; print $answer; if ($DEBUG) { - foreach $team (@{$answers->[$number]->{$answer}->{teams}}) + foreach $team (keys %{$answers->[$number]->{$answer}->{teams}}) { print "Team: ", " \"$team\", ",$$teams{$team}->{regnum}, "\n"; @@ -201,7 +187,7 @@ sub anondump { if ($$answers[$number]->{$answer}{score} eq $symbol) { - my $frequency = scalar @{$answers->[$number]->{$answer}->{teams}}; + my $frequency = scalar keys %{$answers->[$number]->{$answer}->{teams}}; my $canon = $answer; $canon =~ s/^ /$symbol/; if ($frequency >1) @@ -212,7 +198,7 @@ sub anondump print $canon; if ($DEBUG) { - foreach $team (@{$answers->[$number]->{$answer}->{teams}}) + foreach $team (keys %{$answers->[$number]->{$answer}->{teams}}) { print STDERR "Team: ", " \"$team\", ",$$teams{$team}->{regnum}, "\n"; @@ -239,7 +225,7 @@ sub rate_questions if ($$answers[$i]->{$answer}{score} eq '+') { $$ratings[$i] -= - scalar @{$answers->[$i]->{$answer}->{teams}} ; + scalar keys %{$answers->[$i]->{$answer}->{teams}} ; } } } @@ -257,10 +243,13 @@ sub rate_questions # sub find_scores { - my ($teams,$answers,$ratings) = @_; + my ($teams,$answers,$ratings,$factor) = @_; foreach $team (keys %$teams) { - $$teams{$team}->{score} = 0; + if (!defined($factor)) { + $factor=1; + } + $$teams{$team}->{score} *=$factor; $$teams{$team}->{rating} = 0; for ($i=1;$i<=$MAXQUEST;$i++) {