Annotation of processmail/subroutines.pl, revision 1.1
1.1 ! boris 1: # В этот файл собраны процедуры, общие для всей системы
! 2: # работы с ответами.
! 3: #
! 4: #$Id: subroutines.pl,v 1.9 1998/11/29 21:14:30 boris Exp $
! 5: #
! 6: sub readhash
! 7: {
! 8: my ($answers) = @_;
! 9: my $answer = "";
! 10: my $score = "";
! 11: my $number = -1;
! 12: while (<INFILE>)
! 13: {
! 14: if (/^\s*\#(\d+).*Score:\s*([+-\?])/) # Нашли новый ответ
! 15: {
! 16: if ($DEBUG)
! 17: {
! 18: print STDERR "\#$number. Score: $score\n",$answer;
! 19: }
! 20: if ($answer ne "" && $number >0)
! 21: {
! 22: $$answers[$number]->{$answer}->{score} = $score;
! 23: }
! 24: $answer = "";
! 25: $number = $1;
! 26: $score = $2;
! 27: next;
! 28: }
! 29: if (/^Team:/)
! 30: {
! 31: next;
! 32: }
! 33: if (/^\s*\*\*\*\s*$/)
! 34: {
! 35: if ($answer ne "" && $number >0)
! 36: {
! 37: $$answers[$number]->{$answer}->{score} = $score;
! 38: }
! 39: last;
! 40: }
! 41: $answer .= &canonize_answer;
! 42: }
! 43: return 1;
! 44: }
! 45:
! 46: #
! 47: # Читаем файл с письмами команд
! 48: #
! 49: sub readmail
! 50: {
! 51: my ($table) = @_;
! 52: $team="";
! 53: $number=-1;
! 54: while (<INFILE>)
! 55: {
! 56: if (/^\s*\*\*\*\s*"(.+)"\s*[,.]*\s*(\d+)*/) # Нашли новую команду
! 57: {
! 58: if ($DEBUG)
! 59: {
! 60: print STDERR "Команда: $1, рег. номер: $2\n";
! 61: }
! 62: $team = $1;
! 63: $number = -1;
! 64: if (!exists($$table{$team})) # Новая команда...
! 65: {
! 66: my @teamanswers = ();
! 67: my %teamhash = ('answers' => \@teamanswers,
! 68: 'regnum' => $2);
! 69: $$table{$team} = \%teamhash;
! 70: }
! 71: if ($$table{$team}->{regnum} != $2)
! 72: {
! 73: print STDERR "Warning: Team $team uses registration nos. ",
! 74: $$table{$team}->{regnum}, " and $2!\n";
! 75: }
! 76: next;
! 77: }
! 78: if (s/^\s*\#(\d+)\.*// && $team ne "")
! 79: {
! 80: if ($DEBUG)
! 81: {
! 82: print STDERR "Ответ $1\n";
! 83: print STDERR;
! 84: }
! 85: $number = $1;
! 86: $$table{$team}->{answers}[$number] = &canonize_answer;
! 87: next;
! 88: }
! 89: if (/^\*\*\*/) # Команда кончилась
! 90: {
! 91: $team="";
! 92: $number=-1;
! 93: }
! 94: if ($team ne "" && $number >0)
! 95: {
! 96: if ($DEBUG)
! 97: {
! 98: print STDERR;
! 99: }
! 100: $$table{$team}->{answers}[$number] .= &canonize_answer;
! 101: }
! 102: }
! 103: return 1;
! 104: }
! 105:
! 106: #
! 107: # Приводим ответ к канонической форме: два пробела в начале,
! 108: # ни одного в конце
! 109: #
! 110: sub canonize_answer
! 111: {
! 112: s/^\s*(.*)\s*$/ $1/;
! 113: if (/^\s*$/)
! 114: {
! 115: return "";
! 116: }
! 117: else
! 118: {
! 119: return $_."\n";
! 120: }
! 121: }
! 122:
! 123: #
! 124: # Заполняем поля %answers
! 125: #
! 126: sub collect_answers
! 127: {
! 128: my ($teams,$answers) = @_;
! 129: for ($i=1;$i<=$MAXQUEST;$i++)
! 130: {
! 131: foreach $answer (keys %{$$answers[$i]})
! 132: {
! 133: @{$$answers[$i]->{$answer}->{teams}} = ();
! 134: }
! 135:
! 136: foreach $team (keys %$teams)
! 137: {
! 138: $answer = $$teams{$team}->{answers}[$i];
! 139: if ($answer eq "")
! 140: {
! 141: next;
! 142: }
! 143: if (exists $$answers[$i]->{$answer})
! 144: {
! 145: push @{$$answers[$i]->{$answer}->{teams}}, $team;
! 146: }
! 147: else
! 148: {
! 149: my @tmp=($team);
! 150: $$answers[$i]->{$answer}->{teams} = \@tmp;
! 151: $$answers[$i]->{$answer}->{score} = '?';
! 152: }
! 153: }
! 154: foreach $answer (keys %{$$answers[$i]})
! 155: {
! 156: if (scalar @{$$answers[$i]->{$answer}->{teams}} == 0)
! 157: {
! 158: delete $$answers[$i]->{$answer};
! 159: }
! 160: }
! 161: }
! 162: return 1;
! 163:
! 164: }
! 165:
! 166: #
! 167: # Сбрасываем ответы на вопрос $number с оценкой $symbol
! 168: #
! 169: sub dumphash
! 170: {
! 171: my ($teams,$answers,$number,$symbol) = @_;
! 172: foreach $answer (keys %{$answers->[$number]})
! 173: {
! 174: if ($$answers[$number]->{$answer}{score} eq $symbol)
! 175: {
! 176: print "\#$number. Frequency: ",
! 177: scalar @{$answers->[$number]->{$answer}->{teams}},
! 178: ". Score: ",
! 179: $$answers[$number]->{$answer}{score},"\n";
! 180: print $answer;
! 181: if ($DEBUG)
! 182: {
! 183: foreach $team (@{$answers->[$number]->{$answer}->{teams}})
! 184: {
! 185: print "Team: ",
! 186: " \"$team\", ",$$teams{$team}->{regnum}, "\n";
! 187: }
! 188: }
! 189: }
! 190: }
! 191: return 1;
! 192: }
! 193: #
! 194: # Сбрасываем ответы на вопрос $number с оценкой $symbol
! 195: # в формате, пригодном для собрания сочинений
! 196: #
! 197: sub anondump
! 198: {
! 199: my ($teams,$answers,$number,$symbol) = @_;
! 200: foreach $answer (keys %{$answers->[$number]})
! 201: {
! 202: if ($$answers[$number]->{$answer}{score} eq $symbol)
! 203: {
! 204: my $frequency = scalar @{$answers->[$number]->{$answer}->{teams}};
! 205: my $canon = $answer;
! 206: $canon =~ s/^ /$symbol/;
! 207: if ($frequency >1)
! 208: {
! 209: chomp $canon;
! 210: $canon .= " [$frequency]\n";
! 211: }
! 212: print $canon;
! 213: if ($DEBUG)
! 214: {
! 215: foreach $team (@{$answers->[$number]->{$answer}->{teams}})
! 216: {
! 217: print STDERR "Team: ",
! 218: " \"$team\", ",$$teams{$team}->{regnum}, "\n";
! 219: }
! 220: }
! 221: }
! 222: }
! 223: return 1;
! 224: }
! 225:
! 226: #
! 227: # Подсчитываем рейтинги вопросов. Рейтинг вопроса есть
! 228: # 1+количество команд, которые на него НЕ ответили
! 229: #
! 230: sub rate_questions
! 231: {
! 232: my($teams,$answers,$ratings) = @_;
! 233: my $numteams = scalar keys %$teams;
! 234: for ($i=1;$i<=$MAXQUEST;$i++)
! 235: {
! 236: $$ratings[$i]=$numteams+1;
! 237: foreach $answer (keys %{$$answers[$i]})
! 238: {
! 239: if ($$answers[$i]->{$answer}{score} eq '+')
! 240: {
! 241: $$ratings[$i] -=
! 242: scalar @{$answers->[$i]->{$answer}->{teams}} ;
! 243: }
! 244: }
! 245: }
! 246: if ($DEBUG)
! 247: {
! 248: for ($i=1;$i<=$MAXQUEST;$i++)
! 249: {
! 250: print STDERR "Вопрос $i, Рейтинг: ", $$ratings[$i], "\n";
! 251: }
! 252: }
! 253: }
! 254:
! 255: #
! 256: # Подсчитываем рейтинги команд
! 257: #
! 258: sub find_scores
! 259: {
! 260: my ($teams,$answers,$ratings) = @_;
! 261: foreach $team (keys %$teams)
! 262: {
! 263: $$teams{$team}->{score} = 0;
! 264: $$teams{$team}->{rating} = 0;
! 265: for ($i=1;$i<=$MAXQUEST;$i++)
! 266: {
! 267: my $answer=$$teams{$team}->{answers}[$i];
! 268: if ($$answers[$i]->{$answer}{score} eq '+')
! 269: {
! 270: $$teams{$team}->{score} += 1;
! 271: $$teams{$team}->{rating} +=
! 272: $$ratings[$i];
! 273: }
! 274: }
! 275: if ($DEBUG)
! 276: {
! 277: print STDERR "$team: Score ",
! 278: $$teams{$team}->{score},
! 279: ", Rating ",
! 280: $$teams{$team}->{rating},"\n";
! 281: }
! 282: }
! 283: }
! 284:
! 285:
! 286: 1;
! 287:
! 288:
! 289:
! 290:
! 291:
! 292:
! 293:
! 294:
! 295:
! 296:
! 297:
! 298:
! 299:
! 300:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to subroutines.pl CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Local Repository] / processmail