processmail/subroutines.pl - view

File: [Local Repository] / processmail / subroutines.pl
Revision 1.5: download - view: text, annotated - select for diffs - revision graph
Wed Feb 16 22:20:08 2005 UTC (19 years, 4 months ago) by boris
CVS tags: Version_3

Createtable works

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