Parent Directory
| 
Revision Log
When sorting by student name, the sorts are now case insentitive
1 #!/usr/local/bin/webwork-perl 2 3 ## $Id$ 4 5 #################################################################### 6 # Copyright @ 1995-1998 University of Rochester 7 # All Rights Reserved 8 #################################################################### 9 10 11 use strict; 12 # This file is pScSet6.pl 13 # 14 15 # For these scoring subroutines to work, the calling script must require 16 # the following files, i.e. it must contain the lines: 17 # require "webwork.ph"; 18 # require "${scriptDirectory}$DBglue_pl"; 19 # require "${scriptDirectory}$Global::classlist_DBglue_pl"; 20 # require "${scriptDirectory}FILE.pl"; 21 22 my $debugOn=0; 23 24 # Things defined in Global.pl (can be over ridden by statements in webworkCourse.ph) 25 26 my $scoringDirectory = &getCourseScoringDirectory(); 27 my $databaseDirectory = getCourseDatabaseDirectory(); 28 my $DELIM = &getDelim(); 29 my $scoreFilePrefix = &getScoreFilePrefix(); 30 my $scoring_log = &getScoring_log(); 31 my $dash = &getDash(); 32 my $DAT = &getDat(); 33 my @DBEXT = &getBbext(); 34 my @STATUS_DROP = &getStatusDrop(); 35 my %sortaaArray = (); ## declared here so that we can use it in the sort routines 36 37 ##Global Definition of headerline names 38 my @HL=("PIN","NO OF FIELDS","SET NUMBER","PROB NAME","DUE DATE","DUE TIME","PROB VALUE","STUDENT ID"); 39 40 41 # &scoreMessage("scoring dir is $scoringDirectory"); 42 43 44 sub scoreMessage { 45 46 ## Prints message to scoring log and STDERR 47 my ($string) = $_[0]; 48 unless (-e "${scoringDirectory}${scoring_log}") { 49 &createFile("${scoringDirectory}${scoring_log}", $Global::scoring_files_permission, $Global::numericalGroupID); 50 } 51 open(LOGFILE, ">>${scoringDirectory}${scoring_log}") or 52 &wwerror("$0","Can't append to ${scoringDirectory}${scoring_log}"); 53 print LOGFILE "$string\n"; 54 print STDERR "$string\n"; 55 close(LOGFILE); 56 } 57 58 sub get_raw_scores { 59 60 ## Called with parameters 61 ## ($method, $setNumber, $dueDate, $dueTime, $problemListref, $problemValueListref) 62 ## The $method is either 'db' (the default) or 'scofiles' which 63 ## determined if the data will be read from the database or sco files 64 ## The last two parameters are only used with the 'scofiles' scoring method. 65 ## Before this subroutine is run, the set definition file must be read with readSetDefinition 66 67 ## get the number of Y's and N's from database or sco files S{set#}-{pin#}.sco and 68 ## store them in three files: (1) s{set#}bak{#}.${DAT} by rows: pin# ,ss# , lastname 69 ##, firstnames , #Y , #N , #Y , #N ... . Here bak{#} is bak1, bak2, etc. This file is 70 ## never overwritten. Everytime the set is scored, a new bak file is created. 71 ## (2) s{set#}ful.${DAT} by rows: ss# , lastname , firstnames , #Y , 72 ## #N , #Y , #N ... (3) s{set#}scr.${DAT} by rows: ss# , lastname , firstnames 73 ## , [01] , [01] , ... where 1 indicates a correct answer and 0 otherwise. Files 74 ## (2) and (3) have header rows and are suitable for analyzing with a spreadsheet or 75 ## database program. Note: the delimiters, shown above as comas (","), are set by 76 ## $DELIM e.g. $DELIM="," 77 78 my ($method, $setNumber, $dueDate, $dueTime, $problemListref, $problemValueListref) = @_; 79 my ($noOfProbs,$pin,$num,$warnTag,$i,$string,$dataLine,$probValue); 80 my(@bakArray,@fulArray,@scrArray,@Yarray,@Narray,@Sarray,@temp,@pinNumbersArray); 81 my(%assocArray); 82 my(@probList,@probVal,$bakFileName); 83 84 @pinNumbersArray = &getAllProbSetKeysForSet($setNumber); 85 86 if ($method eq 'scofiles') { 87 @probList = @$problemListref; 88 @probVal = @$problemValueListref; 89 } 90 else { 91 $pin =$pinNumbersArray[0]; 92 &attachProbSetRecord($pin) or &wwerror("$0","no Record $pin"); 93 @probList = &getAllProblemsForProbSetRecord($pin); 94 @probList = sort( { $a <=> $b } @probList); 95 @probVal = (); 96 foreach $num (@probList) { 97 $probValue = &getProblemValue($num,$pin); 98 push @probVal, $probValue; 99 } 100 } 101 102 $i=1; 103 while(-e "${scoringDirectory}s${setNumber}bak$i.${DAT}") {$i++;} ##don't overwrite existing backups 104 $bakFileName ="${scoringDirectory}s${setNumber}bak$i.${DAT}"; 105 106 &createFile($bakFileName, 0660, $Global::numericalGroupID); 107 open(RAWSCORES,">$bakFileName") or &wwerror("$0","Can't open $bakFileName"); 108 &backup("s${setNumber}ful"); ## make upto three backups 109 110 &createFile("${scoringDirectory}s${setNumber}ful.${DAT}", $Global::scoring_files_permission, $Global::numericalGroupID); 111 open(FULLSCORES,">${scoringDirectory}s${setNumber}ful.${DAT}") or 112 &wwerror("$0","Can't open ${scoringDirectory}s${setNumber}ful.${DAT}"); 113 &backup("s${setNumber}scr"); ## make upto three backups 114 115 &createFile("${scoringDirectory}s${setNumber}scr.${DAT}", $Global::scoring_files_permission, $Global::numericalGroupID); 116 open(SCORES,">${scoringDirectory}s${setNumber}scr.${DAT}") or 117 &wwerror("$0","Can't open ${scoringDirectory}s${setNumber}scr.${DAT}"); 118 $noOfProbs=@probList; 119 print "noOfProbs is $noOfProbs\n" if $debugOn; 120 print "problems values are @probVal\n" if $debugOn; 121 122 &bak_dat_header($setNumber, $noOfProbs , $dueDate, $dueTime, \@probVal); 123 &ful_dat_header($setNumber, $noOfProbs , $dueDate, $dueTime, \@probVal); 124 &scr_dat_header($setNumber, $noOfProbs , $dueDate, $dueTime, \@probVal); 125 126 127 foreach $pin (@pinNumbersArray) { 128 attachProbSetRecord($pin); 129 my $studentLogin = getStudentLogin($pin); 130 attachCLRecord($studentLogin); 131 132 #### initialize arrays 133 @bakArray=($pin,&CL_getStudentID($studentLogin), &CL_getStudentLastName($studentLogin), &CL_getStudentFirstName($studentLogin),&CL_getClassSection($studentLogin),&CL_getClassRecitation($studentLogin)); 134 @fulArray=@bakArray; 135 shift @fulArray; 136 @scrArray=@fulArray; 137 138 @Yarray=(0) x ($noOfProbs+1); ##holds number of correct responses 139 @Narray=(0) x ($noOfProbs+1); ##holds number of incorrect responses 140 @Sarray=(0) x ($noOfProbs+1); ##holds scores 141 142 if ($method eq 'scofiles') { 143 ######## GET NUMBER OF CORRECT AND INCORRECT ANSWERS FROM SCO FILES ##### 144 my $Yarrayref = \@Yarray; 145 my $Narrayref = \@Narray; 146 my $Sarrayref = \@Sarray; 147 &getRecordedScores($Sarrayref,$Yarrayref,$Narrayref,$pin); 148 } 149 else { 150 ######## GET NUMBER OF CORRECT AND INCORRECT ANSWERS FROM DATABASE ##### 151 for ($i=1;$i<=$noOfProbs;$i++) { 152 $Yarray[$i] = &getProblemNumOfCorrectAns($i,$pin); 153 $Narray[$i] = &getProblemNumOfIncorrectAns($i,$pin); 154 $Sarray[$i] = &getProblemStatus($i,$pin); 155 } 156 } 157 158 $warnTag=0; 159 for ($i=1;$i<=$noOfProbs;$i++) { 160 if ($Yarray[$i] > 99) { 161 $warnTag=1; 162 $Yarray[$i] = 99 163 } 164 if ($Narray[$i] > 99) { 165 $warnTag=1; 166 $Narray[$i] = 99 167 } 168 } 169 if ($warnTag == 1) { 170 &scoreMessage("Warning: more than 99 attempts for a single problem in ${scoringDirectory}s${setNumber}ful.${DAT}"); 171 } 172 173 for ($i=1;$i<=$noOfProbs;$i++) { 174 push(@bakArray,$Sarray[$i]); 175 push(@bakArray,$Yarray[$i]); 176 push(@bakArray,$Narray[$i]); 177 push(@fulArray,$Sarray[$i]); 178 push(@fulArray,$Yarray[$i]); 179 push(@fulArray,$Narray[$i]); 180 push(@scrArray,$Sarray[$i]); 181 } 182 $dataLine=join("${DELIM}",@bakArray); 183 print "$dataLine\n" if $debugOn; 184 print RAWSCORES "$dataLine\n"; 185 $dataLine=join("${DELIM}",@fulArray); 186 print "$dataLine\n" if $debugOn; 187 print FULLSCORES "$dataLine\n"; 188 $dataLine=join("${DELIM}",@scrArray); 189 print "$dataLine\n" if $debugOn; 190 print SCORES "$dataLine\n"; 191 192 } ##end of $pin for each loop 193 close(RAWSCORES); 194 close(FULLSCORES); 195 close(SCORES); 196 197 ##permissions set here 198 199 chmod($Global::scoring_bak_files_permission,$bakFileName) or 200 &wwerror("$0","Can't do chmod($Global::scoring_bak_files_permission,$bakFileName)"); 201 %assocArray = &dat2aa("s${setNumber}ful"); 202 &aa2dat(\%assocArray,"s${setNumber}ful","AbySec"); ##alphbatize 203 204 %assocArray = &dat2aa("s${setNumber}scr"); 205 &aa2dat(\%assocArray,"s${setNumber}scr","AbySec"); ##alphbatize 206 207 } 208 209 210 211 212 sub ful_dat_header { 213 ## add header lines to the set ful.${DAT} files 214 my ($setNumber, $noOfProbs , $dueDate, $dueTime, $probValref) = @_; 215 my $num =$noOfProbs; 216 my @valArray = @$probValref; 217 218 my ($i); 219 220 $num=3*$num+5; ## number of fields is 5 more than twice number of problems 221 my @array = (); 222 my $dataLine =''; 223 224 ## first header line 225 @array=(" ") x $num; 226 $array[0]=$HL[1]; 227 $dataLine=join("${DELIM}",@array); 228 print FULLSCORES "$dataLine\n"; 229 230 ## second header line set number 231 @array=(" ") x $num; 232 $array[0]=$HL[2]; 233 for ($i=5; $i < $num; $i=$i+3) {$array[$i]=$setNumber;} 234 $dataLine=join("${DELIM}",@array); 235 print FULLSCORES "$dataLine\n"; 236 237 ## third header line problem numbers 238 @array=(" ") x $num; 239 $array[0]=$HL[3]; 240 for ($i=5; $i < $num; $i=$i+3) {$array[$i]=int(($i-2)/3);$array[$i+1]=int(($i-2)/3);$array[$i+2]=int(($i-2)/3);} 241 $dataLine=join("${DELIM}",@array); 242 print FULLSCORES "$dataLine\n"; 243 244 ## fourth header line 245 @array=(" ") x $num; 246 $array[0]=$HL[4]; 247 for ($i=5; $i < $num; $i=$i+3) {$array[$i]=$dueDate;} 248 $dataLine=join("${DELIM}",@array); 249 print FULLSCORES "$dataLine\n"; 250 251 ## fifth header line 252 @array=(" ") x $num; 253 $array[0]=$HL[5]; 254 for ($i=5; $i < $num; $i=$i+3) {$array[$i]=$dueTime;} 255 $dataLine=join("${DELIM}",@array); 256 print FULLSCORES "$dataLine\n"; 257 258 ## sixth header line 259 @array=(" ") x $num; 260 $array[0]=$HL[6]; 261 for ($i=5; $i < $num; $i=$i+3) {$array[$i]=shift(@valArray);} 262 $dataLine=join("${DELIM}",@array); 263 print FULLSCORES "$dataLine\n"; 264 265 ## seventh header line 266 @array=(" ") x $num; 267 $array[0]=$HL[7]; 268 $array[1]='LAST NAME'; 269 $array[2]='FIRST NAMES'; 270 $array[3]='SECTION'; 271 $array[3]='RECITATION'; 272 for ($i=5; $i < $num; $i=$i+3) { 273 $array[$i]='STATUS'; 274 $array[$i+1]='#corr'; 275 $array[$i+2]='#incorr'; 276 } 277 $dataLine=join("${DELIM}",@array); 278 print FULLSCORES "$dataLine\n"; 279 280 } 281 282 283 284 285 sub bak_dat_header { 286 ## add header lines to the set bak.${DAT} files 287 my ($setNumber, $noOfProbs , $dueDate, $dueTime, $probValref) = @_; 288 my $num =$noOfProbs; 289 my @valArray = @$probValref; 290 291 my ($i); 292 293 $num=3*$num+6; ## number of fields is 6 more than twice number of problems 294 my@array = (); 295 my$dataLine = ''; 296 297 ## first header line 298 @array=(" ") x $num; 299 $array[0]="line1"; 300 $array[1]=$HL[1]; 301 $dataLine=join("${DELIM}",@array); 302 print RAWSCORES "$dataLine\n"; 303 304 ## second header line 305 @array=(" ") x $num; 306 $array[0]="line2"; 307 $array[1]=$HL[2]; 308 for ($i=6; $i < $num; $i=$i+3) {$array[$i]=$setNumber;} 309 $dataLine=join("${DELIM}",@array); 310 print RAWSCORES "$dataLine\n"; 311 312 ## third header line 313 @array=(" ") x $num; 314 $array[0]="line3"; 315 $array[1]=$HL[3]; 316 for ($i=6; $i < $num; $i=$i+3) {$array[$i]=int(($i-3)/3);$array[$i+1]=int(($i-3)/3);$array[$i+2]=int(($i-3)/3);} 317 $dataLine=join("${DELIM}",@array); 318 print RAWSCORES "$dataLine\n"; 319 320 ## fourth header line 321 @array=(" ") x $num; 322 $array[0]="line4"; 323 $array[1]=$HL[4]; 324 for ($i=6; $i < $num; $i=$i+3) {$array[$i]=$dueDate;} 325 $dataLine=join("${DELIM}",@array); 326 print RAWSCORES "$dataLine\n"; 327 328 ## fifth header line 329 @array=(" ") x $num; 330 $array[0]="line5"; 331 $array[1]=$HL[5]; 332 for ($i=6; $i < $num; $i=$i+3) {$array[$i]=$dueTime;} 333 $dataLine=join("${DELIM}",@array); 334 print RAWSCORES "$dataLine\n"; 335 336 ## sixth header line 337 @array=(" ") x $num; 338 $array[0]="line6"; 339 $array[1]=$HL[6]; 340 for ($i=6; $i < $num; $i=$i+3) {$array[$i]=shift(@valArray);} 341 $dataLine=join("${DELIM}",@array); 342 print RAWSCORES "$dataLine\n"; 343 344 ## seventh header line 345 @array=(" ") x $num; 346 $array[0]="line7"; 347 $array[1]=$HL[7]; 348 $array[2]="LAST NAME"; 349 $array[3]="FIRST NAMES"; 350 $array[4]="SECTION"; 351 $array[5]="RECITATION"; 352 for ($i=6; $i < $num; $i=$i+3) { 353 $array[$i]='STATUS'; 354 $array[$i+1]="#corr"; 355 $array[$i+2]="#incorr"; 356 } 357 $dataLine=join("${DELIM}",@array); 358 print RAWSCORES "$dataLine\n"; 359 } 360 361 362 363 364 sub scr_dat_header { 365 my ($setNumber, $noOfProbs , $dueDate, $dueTime, $probValref) = @_; 366 my $num =$noOfProbs; 367 my @valArray = @$probValref; 368 369 my ($i); 370 371 $num=$num+5; ## number of fields is 5 more than number of problems 372 my @array =(); 373 my $dataLine =''; 374 375 ## first header line 376 @array=(" ") x $num; 377 $array[0]=$HL[1]; 378 $dataLine=join("${DELIM}",@array); 379 print SCORES "$dataLine\n"; 380 381 ## second header line 382 @array=(" ") x $num; 383 $array[0]=$HL[2]; 384 for ($i=5; $i < $num; $i++) {$array[$i]=$setNumber;} 385 $dataLine=join("${DELIM}",@array); 386 print SCORES "$dataLine\n"; 387 388 ## third header line 389 @array=(" ") x $num; 390 $array[0]=$HL[3]; 391 for ($i=5; $i < $num; $i++) {$array[$i]=$i-3;} 392 $dataLine=join("${DELIM}",@array); 393 print SCORES "$dataLine\n"; 394 395 ## fourth header line 396 @array=(" ") x $num; 397 $array[0]=$HL[4]; 398 for ($i=5; $i < $num; $i++) {$array[$i]=$dueDate;} 399 $dataLine=join("${DELIM}",@array); 400 print SCORES "$dataLine\n"; 401 402 ## fifth header line 403 @array=(" ") x $num; 404 $array[0]=$HL[5]; 405 for ($i=5; $i < $num; $i++) {$array[$i]=$dueTime;} 406 $dataLine=join("${DELIM}",@array); 407 print SCORES "$dataLine\n"; 408 409 ## sixth header line 410 @array=(" ") x $num; 411 $array[0]=$HL[6]; 412 for ($i=5; $i < $num; $i++) {$array[$i]=shift(@valArray);} 413 $dataLine=join("${DELIM}",@array); 414 print SCORES "$dataLine\n"; 415 416 ## seventh header line 417 @array=(" ") x $num; 418 $array[0]=$HL[7]; 419 $array[1]="LAST NAME"; 420 $array[2]="FIRST NAMES"; 421 $array[3]="SECTION"; 422 $array[4]="RECITATION"; 423 for ($i=5; $i < $num; $i++) {$array[$i]="STATUS";} 424 $dataLine=join("${DELIM}",@array); 425 print SCORES "$dataLine\n"; 426 427 } 428 429 430 431 sub backup { 432 ## takes as a parameter the filename without the extension, e.g. ("s5ful") or ("s5scr") 433 ## makes upto three backups of file with x, y, or z appended to filename where x 434 ## the most recent backup 435 436 my $fileName =$_[0]; 437 if (-e "${scoringDirectory}${fileName}y.${DAT}") { 438 rename("${scoringDirectory}${fileName}y.${DAT}","${scoringDirectory}${fileName}z.${DAT}") or 439 &wwerror("$0","can't rename ${scoringDirectory}${fileName}y.${DAT}"); 440 } 441 442 if (-e "${scoringDirectory}${fileName}x.${DAT}") { 443 rename("${scoringDirectory}${fileName}x.${DAT}","${scoringDirectory}${fileName}y.${DAT}") or 444 &wwerror("$0","can't rename ${scoringDirectory}${fileName}x.${DAT}"); 445 } 446 447 if (-e "${scoringDirectory}${fileName}.${DAT}") { 448 rename("${scoringDirectory}${fileName}.${DAT}","${scoringDirectory}${fileName}x.${DAT}") or 449 &wwerror("$0","can't rename ${scoringDirectory}${fileName}.${DAT}"); 450 } 451 } 452 453 sub dat2aa { 454 ## takes as a parameter the filename without the extension, e.g. ("s5ful") or ("s5scr") 455 my $fileName =$_[0]; 456 my(%aaArray); 457 458 &checkdat("$fileName"); 459 print "dat2aa working on ${scoringDirectory}${fileName}.${DAT}\n" if $debugOn; 460 %aaArray = &delim2aa("${scoringDirectory}${fileName}.${DAT}"); 461 } 462 463 464 465 sub aa2dat { 466 467 ## Saves an associative array version of the scoring files as a delimited file. 468 ## Takes three parameters. The first is the name of an associative array 469 ## passed by reference. The second is a filename without the extension, 470 ## e.g. s5ful or s5scr. The third optional parameter determined the 471 ## sorting order. The default will be to sort alpabetically first by section, 472 ## then by student name. If the third parameter is 'A', the 473 ## sort order will be alpabetically by student name. If the third parameter is 'SbySec', 474 ## the sort order will be first by section, then by studentID. If the third parameter 475 ## is 'S', the sort order will be by studentID. 476 ## Creates a $filename.$DAT file which is an text version of the associative array 477 ## E.g., &aa2delim(\%aaArray, s1scr, A) 478 479 my($aaArrayref,$fileName,$sortorder)=@_; 480 %sortaaArray = %$aaArrayref; 481 print "aa2delim working on ${scoringDirectory}${fileName}.${DAT}\n" if $debugOn; 482 483 my(@sortedkeys,@keys,@hdrarray,%mark,$dbString,$studID); 484 unless (defined $sortorder) {$sortorder = 'AbySec';} 485 486 unless(-e "${scoringDirectory}${fileName}.${DAT}") { 487 &createFile("${scoringDirectory}${fileName}.${DAT}", $Global::scoring_files_permission, $Global::numericalGroupID); 488 } 489 open(DATFILE,">${scoringDirectory}${fileName}.${DAT}") or 490 &wwerror("$0","can't open ${scoringDirectory}${fileName}.${DAT}"); 491 @hdrarray=@HL; ##get header line labels 492 shift(@hdrarray); ##put first header line label in 0th position 493 foreach $studID (@hdrarray) { ##put header lines in ${DAT} file 494 $dbString=$sortaaArray{$studID}; 495 $dbString="$studID${DELIM}$dbString"; 496 print DATFILE "$dbString\n"; 497 } 498 if ($sortorder eq "S") {@sortedkeys = sort by_studentID (keys(%sortaaArray));} 499 elsif ($sortorder eq "SbySec") {@sortedkeys = sort by_section_then_by_studentID (keys(%sortaaArray));} 500 elsif ($sortorder eq "A") {@sortedkeys = sort by_studentName (keys(%sortaaArray));} 501 elsif ($sortorder eq "SbyRec") {@sortedkeys = sort by_recitation_then_by_studentID (keys(%sortaaArray));} 502 elsif ($sortorder eq "AbyRec") {@sortedkeys = sort by_recitation_then_by_studentName (keys(%sortaaArray));} 503 else {@sortedkeys = sort by_section_then_by_studentName (keys(%sortaaArray));} 504 505 grep($mark{$_}++,@hdrarray); ##remove header line keys from sortedkeys 506 @keys=grep(!$mark{$_},@sortedkeys); 507 foreach $studID (@keys) { 508 $dbString=$sortaaArray{$studID}; 509 $dbString="$studID${DELIM}$dbString"; 510 print DATFILE "$dbString\n"; 511 } 512 close(DATFILE); 513 514 &columnPrint ("${scoringDirectory}${fileName}.${DAT}","${scoringDirectory}${fileName}.${DAT}") 515 } 516 517 sub by_studentID {$a cmp $b;} ## sort by student ID 518 519 sub by_section_then_by_studentID { ## sort by student ID 520 521 (&get_section($a) cmp &get_section($b)) 522 or 523 ($a cmp $b); 524 } 525 526 sub by_recitation_then_by_studentID { ## sort by student ID 527 528 (&get_recitation($a) cmp &get_recitation($b)) 529 or 530 ($a cmp $b); 531 } 532 533 534 sub by_studentName { 535 ## sort by student name 536 (lc(&get_last_name($a)) cmp lc(&get_last_name($b))) 537 or 538 (lc(&get_first_names($a)) cmp lc(&get_first_names($b))) 539 or 540 ($a cmp $b); 541 } 542 543 sub by_section_then_by_studentName { 544 ## sort by student name 545 (&get_section($a) cmp &get_section($b)) 546 or 547 (lc(&get_last_name($a)) cmp lc(&get_last_name($b))) 548 or 549 (lc(&get_first_names($a)) cmp lc(&get_first_names($b))) 550 or 551 ($a cmp $b); 552 } 553 554 sub by_recitation_then_by_studentName { 555 ## sort by student name 556 (&get_recitation($a) cmp &get_recitation($b)) 557 or 558 (lc(&get_last_name($a)) cmp lc(&get_last_name($b))) 559 or 560 (lc(&get_first_names($a)) cmp lc(&get_first_names($b))) 561 or 562 ($a cmp $b); 563 } 564 565 sub get_last_name { 566 my ($studID) =@_; 567 my @temp=split(/${DELIM}/,$sortaaArray{$studID}); 568 return $temp[0] if defined $temp[0]; 569 ''; 570 } 571 sub get_first_names { 572 my ($studID) =@_; 573 my @temp=split(/${DELIM}/,$sortaaArray{$studID}); 574 return $temp[1] if defined $temp[1]; 575 ''; 576 } 577 sub get_section { 578 my ($studID) =@_; 579 my @temp=split(/${DELIM}/,$sortaaArray{$studID}); 580 return $temp[2] if defined $temp[2]; 581 ''; 582 } 583 584 sub get_recitation { 585 my ($studID) =@_; 586 my @temp=split(/${DELIM}/,$sortaaArray{$studID}); 587 return $temp[3] if defined $temp[3]; 588 ''; 589 } 590 sub append_score_db { 591 ## Takes two parameters. The first is the filename (without the extension) 592 ## of the cummulative database. The second is the filename (without the 593 ## extension) of the database to be appended. E.g. append_score_db ("dbfile", "appenddbfile") 594 595 my ($dbFile,$appenddbFile)=@_; 596 my ($studID,$temp,$i,$dbNoOfFields,$appenddbNoOfFields,$dbString,$string); 597 my (@dbArray,@temp,@temp1,%appenddbaArray); 598 my (%dbaArray); 599 %dbaArray = &dat2aa("$dbFile"); 600 my $cumm_db_non_empty = scalar(%dbaArray); ## this will be 0 if empty 601 %appenddbaArray = &dat2aa("$appenddbFile"); 602 603 if ($cumm_db_non_empty) { 604 $_=$dbaArray{"NO OF FIELDS"}; 605 $temp=s/${DELIM}/${DELIM}/g; ##find number of delims in string 606 } 607 else {$temp =0}; 608 $dbNoOfFields=$temp+2; ##num of fields in dat file 609 $_=$appenddbaArray{"NO OF FIELDS"}; 610 $temp=s/${DELIM}/${DELIM}/g; ##find number of delims in string 611 $appenddbNoOfFields=$temp+2; 612 foreach $studID (keys %dbaArray) { 613 if ( not defined ($appenddbaArray{$studID})) { ##handle case where record is not in 614 ##appended database 615 $dbString=$dbaArray{$studID}; 616 @dbArray=&getRecord($dbString); 617 &scoreMessage("No record for $dbArray[1] $dbArray[0] , ID = $studID,\n in the $appenddbFile database. The record will be padded with blanks."); 618 $temp=" ${DELIM}" x ($appenddbNoOfFields-5); ##blanks for fields 619 $dbString.=$temp; 620 $dbaArray{$studID}=$dbString; 621 622 } 623 else { 624 $dbString=$appenddbaArray{$studID}; 625 $dbString=~s/^[^${DELIM}]*${DELIM}[^${DELIM}]*${DELIM}[^${DELIM}]*${DELIM}[^${DELIM}]*//; ##remove last and first names 626 ##and section ##and (8/16/000 recitation 627 $dbaArray{$studID}.=$dbString; 628 } 629 } 630 ##end of foreach 631 632 foreach $studID (keys (%appenddbaArray)) { ##handle case where record is not in 633 ##cummulative database 634 unless (defined ($dbaArray{$studID})) { 635 $dbString=$appenddbaArray{$studID}; 636 @dbArray=&getRecord($dbString); 637 &scoreMessage("No record for $dbArray[1] $dbArray[0] , ID = $studID,\n in the $dbFile database. The record will be padded with blanks.") if $cumm_db_non_empty ; 638 $temp=" ${DELIM}" x ($dbNoOfFields-5); 639 $dbString=~s/(^[^${DELIM}]*${DELIM}[^${DELIM}]*${DELIM}[^${DELIM}]*${DELIM}[^${DELIM}]*${DELIM})/${1}$temp/; 640 $dbaArray{$studID}=$dbString; 641 } ##end of unless 642 643 } ##end of foreach 644 645 &backup("$dbFile"); ##backup dat files 646 &aa2dat(\%dbaArray,"$dbFile","AbySec"); ##update dat file 647 } ##end of sub append_score_db 648 649 650 651 652 sub checkdat { 653 ## takes as a parameter the filename without the extension, e.g. ("S5ful") or ("S5scr") 654 655 my $fileName =$_[0]; 656 my $msg = htmlcheckdat($fileName); 657 unless ($msg eq 'OK') { 658 &wwerror("$0","$msg"); 659 } 660 } 661 662 sub htmlcheckdat { 663 ## takes as a parameter the filename without the extension, e.g. ("S5ful") or ("S5scr") 664 ## returns 'OK' or error message depending on whether dat file is valid or not 665 666 my $fileName =$_[0]; 667 my ($noOfDelim,$firstLine,$dbString,$num,$temp,$i); 668 my (@keyList, $msg); 669 670 open(DATFILE,"${scoringDirectory}${fileName}.${DAT}") or 671 &wwerror("$0","can't open ${scoringDirectory}${fileName}.${DAT}"); 672 $_= <DATFILE>; 673 $firstLine=$_; 674 if (defined $firstLine) { 675 $noOfDelim=s/$DELIM/$DELIM/g; 676 while (<DATFILE>) { 677 $dbString=$_; 678 $num=s/$DELIM/$DELIM/g; 679 if ($num != $noOfDelim) { 680 $msg = "${scoringDirectory}${fileName}.${DAT} is corrupted.\n The record\n $firstLine\n 681 contains $noOfDelim delimiters ($DELIM) whereas the record\n 682 $dbString contains $num delimiters.\n"; 683 return $msg; 684 } 685 } 686 } 687 close DATFILE; 688 open(DATFILE,"${scoringDirectory}${fileName}.${DAT}") or 689 &wwerror("$0","can't open ${scoringDirectory}${fileName}.${DAT}"); 690 @keyList=(); 691 while (<DATFILE>) { 692 chomp; 693 s/${DELIM}.*//; ## get key 694 push(@keyList,$_); 695 } 696 close DATFILE; 697 @keyList = sort(@keyList); 698 for ($i=0; $i < @keyList-1; $i++) { 699 if ($keyList[$i] eq $keyList[$i+1]) { 700 $msg = "duplicate keys equal to $keyList[$i] in ${scoringDirectory}${fileName}.${DAT}"; 701 return $msg; 702 } 703 } 704 $msg ='OK'; 705 return $msg; 706 } 707 708 709 710 sub recover { 711 ## takes as a parameter the filename without the extension of the bak data file, 712 ## e.g. ("s5bak3"). Produces new versions of the corresponding ful and scr files, 713 ## e.g. s5ful and s5scr. 714 my $fileName =$_[0]; 715 my(@dbArray,$dbString,$fulFileName,$scrFileName,$temp,$noOfProbs,$noOfDelim,$i,$j,$ext); 716 my (%assocArray); 717 $temp=$fileName; 718 $temp=~s\bak.*\\; 719 $fulFileName="$temp"."ful"; 720 $scrFileName="$temp"."scr"; 721 722 &checkdat("$fileName"); 723 724 &backup("$fulFileName"); 725 &backup("$scrFileName"); 726 727 728 open(BAKFILE,"${scoringDirectory}${fileName}.${DAT}") or 729 &wwerror("$0","can't open ${scoringDirectory}${fileName}.${DAT}"); 730 &createFile("${scoringDirectory}${fulFileName}.${DAT}", $Global::scoring_files_permission, $Global::numericalGroupID); 731 open(FULLSCORES,">${scoringDirectory}${fulFileName}.${DAT}") or 732 &wwerror("$0","can't open ${scoringDirectory}${fulFileName}.${DAT}"); 733 &createFile("${scoringDirectory}${scrFileName}.${DAT}", $Global::scoring_files_permission, $Global::numericalGroupID); 734 open(SCORES,">${scoringDirectory}${scrFileName}.${DAT}") or 735 &wwerror("$0","can't open ${scoringDirectory}${scrFileName}.${DAT}"); 736 737 ##recover ful score file 738 while (<BAKFILE>) { 739 chomp; 740 @dbArray=&getRecord($_); 741 shift(@dbArray); 742 $dbString=join("${DELIM}",@dbArray); 743 print FULLSCORES "$dbString\n"; 744 } ## ful score file recovered 745 746 ## recover scr score file 747 748 open(BAKFILE,"${scoringDirectory}${fileName}.${DAT}") or 749 &wwerror("$0","can't open ${scoringDirectory}${fileName}.${DAT}"); 750 while (<BAKFILE>) { 751 chomp; 752 @dbArray=&getRecord($_); 753 shift(@dbArray); ## throw away first element 754 my @outArray =(); 755 for ($j=1; $j <= 5; $j++) { ## put back next 5 elements 756 push @outArray,shift(@dbArray); 757 } 758 while (@dbArray) { 759 push @outArray,shift(@dbArray); #save 760 shift(@dbArray); ## throw away 761 shift(@dbArray); ## throw away 762 } 763 $dbString=join($DELIM,@outArray); 764 print SCORES "$dbString\n"; 765 } ## scr score file recovered 766 767 close(BAKFILE); 768 close(FULLSCORES); 769 close(SCORES); 770 771 %assocArray = &dat2aa("${fulFileName}"); 772 &aa2dat(\%assocArray,"${fulFileName}","AbySec"); ##alphbatize 773 774 %assocArray = &dat2aa("${scrFileName}"); 775 &aa2dat(\%assocArray,"${scrFileName}","AbySec"); ##alphbatize 776 } 777 778 779 sub delete_columns { 780 ## Takes four parameters. The first is the filename without the extension, 781 ## the second is the first column of a range of columns to be deleted. 782 ## the third is the last column of a range of columns to be deleted. 783 ## the fourth is 1 for a prompt and 0 for none 784 ## e.g. (s5ful,20,30,1) or (s5scr,10 15,0). 785 ## Note that "ful" files contain 2 columns for each problem (a `#corr' and an `#incorr' 786 ## column) where as "scr" files contain 1 column for each problem (a `score' column). 787 788 ## the first column is 1 (not 0). -2 refers to the second to last column, etc 789 790 my ($fileName,$beginCol,$endCol,$prompt)=@_; 791 my (@dbArray,@fileArray,$dbString,$studID,$temp,$temp1,$i,$tempFileName); 792 my ($lastCol,$negBeginCol,$negEndCol); 793 794 &checkdat("$fileName"); 795 open(DATFILE,"${scoringDirectory}${fileName}.${DAT}") or 796 &wwerror("$0","can't open ${scoringDirectory}${fileName}.${DAT}"); 797 $_ = <DATFILE>; 798 chomp; 799 @dbArray=&getRecord($_); 800 $lastCol = @dbArray; 801 close(DATFILE); 802 if ($beginCol =~ /^ *-/) { 803 $negBeginCol = $beginCol; 804 $beginCol = $lastCol + $beginCol +1; 805 } 806 else {$negBeginCol = $beginCol-$lastCol-1;} 807 808 if ($endCol =~ /^ *-/) { 809 $negEndCol = $endCol; 810 $endCol = $lastCol + $endCol +1; 811 } 812 else {$negEndCol = $endCol-$lastCol-1;} 813 814 if ($prompt) { 815 print "\n\nThis procedure will remove a range of columns from the ${scoringDirectory}${fileName}.${DAT}\n"; 816 print "data set. That is a range of fields in each record in the ${fileName}.${DAT} data set will be removed.\n\n"; 817 print "The first column to be removed will be column $beginCol (i.e. column $negBeginCol).\n"; 818 print "The last column to be removed will be column $endCol (i.e. column $negEndCol).\n\n"; 819 print "Note that the first column is column 1 (i.e. column -$lastCol) and\n"; 820 print "the last column is column $lastCol (i.e. column -1).\n\n"; 821 print "Note also that \"ful\" data sets (e.g. \"s5ful\") contain 2 columns for each problem\n"; 822 print "(a `#corr' and an `#incorr' column) where as \"scr\" data sets (e.g. \"s5scr\") contain 1 column\n"; 823 print "for each problem (a `score' column).\n"; 824 print "DO YOU WANT TO CONTINUE WITH THIS OPERATION? (Y or N)\n"; 825 $temp=<STDIN>; 826 chomp($temp); 827 unless (($temp eq "Y") || ($temp eq "y")) { 828 print "Operation aborted\n"; 829 exit; 830 } 831 } 832 unless ((1 <= $beginCol) && ($beginCol <= $endCol) && ($endCol <= $lastCol)) { 833 &wwerror("$0","Invalid Column Range. Operation aborted\n 834 beginCol =$beginCol endCol = $endCol lastCol = $lastCol\n"); 835 exit; 836 } 837 &backup("$fileName"); 838 839 ##copy backup file back to original file 840 841 open(BACKFILE,"${scoringDirectory}${fileName}x.${DAT}") or 842 &wwerror("$0","can't open ${scoringDirectory}${fileName}x.${DAT}"); 843 @fileArray = <BACKFILE>; 844 open(ORGFILE,">${scoringDirectory}${fileName}.${DAT}") or 845 &wwerror("$0","can't open ${scoringDirectory}${fileName}.${DAT}"); 846 print ORGFILE @fileArray; 847 close(ORGFILE); 848 849 ##find unique temp file name 850 $i=1; 851 $tempFileName = "${scoringDirectory}$fileName$i"; 852 while(-e "$tempFileName") { 853 $i++; 854 $tempFileName = "${scoringDirectory}$fileName$i"; 855 } 856 857 open(TEMPFILE,">$tempFileName") or 858 &wwerror("$0","can't open $tempFileName"); 859 open(DATFILE,"${scoringDirectory}${fileName}.${DAT}") or 860 &wwerror("$0","can't open ${scoringDirectory}${fileName}.${DAT}"); 861 while (<DATFILE>) { 862 chomp; 863 @dbArray=&getRecord($_); 864 splice(@dbArray,$beginCol-1,$endCol-$beginCol+1); 865 $dbString=join("${DELIM}",@dbArray); 866 print TEMPFILE "$dbString\n"; 867 } 868 869 close(DATFILE); 870 close(TEMPFILE); 871 &columnPrint("$tempFileName","$tempFileName"); 872 rename("$tempFileName","${scoringDirectory}${fileName}.${DAT}") or 873 &wwerror("$0","can't rename ${scoringDirectory}${fileName}.${DAT}"); 874 chmod($Global::scoring_files_permission, "${scoringDirectory}${fileName}.${DAT}") or 875 &wwerror("$0","Can't do chmod($Global::scoring_files_permission, ${scoringDirectory}${fileName}.${DAT})"); 876 chown(-1,$Global::numericalGroupID,"${scoringDirectory}${fileName}.${DAT}") or 877 &wwerror("$0","Can't do chown(-1,$Global::numericalGroupID,${scoringDirectory}${fileName}.${DAT})"); 878 } ############ end of delete_columns; 879 880 881 sub total_score { 882 ## Takes two parameters, the filename (without the extension) of the score 883 ## database and a caption for the total column. E.g. ("s5scr", "set 5"). 884 ## Computes the total score by calculating the sum over 885 ## columns 5,6, ..., last column of round_score((prob value)*(prob scr)). 886 ## That is value of each problem is rounded then added. Note that col. 1 887 ## is the student id, col.'s 2 and 3 hold the student last and first names, 888 ## and column 4 holds the section number. 889 ## The total is appended as a new col in the score database with a prob value of 0 890 ## so that it will not contribute to future calculations of the total score. 891 892 my($dbFile,$caption) = @_; 893 894 my (%assocArray); 895 my($studID,$i,$dbNoOfDelim,$dbString,$total); 896 my(@dbArray,@valArray); 897 898 899 %assocArray =&dat2aa("$dbFile"); ## create assoc array 900 &backup("$dbFile"); ## backup dat file 901 $_=$assocArray{"NO OF FIELDS"}; 902 $dbNoOfDelim=s/${DELIM}/${DELIM}/g; ## find number of delims in string 903 $dbString=$assocArray{"PROB VALUE"}; 904 @valArray=&getRecord($dbString); ## save prob values 905 906 foreach $studID (keys %assocArray) { 907 $dbString=$assocArray{$studID}; 908 @dbArray = &getRecord($dbString); 909 910 if (($studID eq "NO OF FIELDS") || ($studID eq "PROB NAME") || ($studID eq "DUE DATE")|| ($studID eq "DUE TIME")) { 911 push (@dbArray, " "); 912 } 913 elsif ($studID eq "SET NUMBER") {push (@dbArray,$caption);} ## set set number to caption 914 elsif ($studID eq "PROB VALUE") {push (@dbArray, 0);} ## set prob val to zero for total column 915 elsif ($studID eq "STUDENT ID") {push (@dbArray, "total");} 916 else { ## handle actual data records and calculate total 917 $total=0; 918 for ($i=4; $i <= $dbNoOfDelim; $i++) {$total += round_score($dbArray[$i]*$valArray[$i]);} 919 push (@dbArray, $total); 920 } ## end of if statement 921 $dbString=join("${DELIM}",@dbArray); 922 $assocArray{$studID}=$dbString; 923 } ## end of foreach $studID 924 &aa2dat(\%assocArray,"${dbFile}","AbySec"); ##update dat file and alphbatize 925 } ##end of sub total_score 926 927 928 929 930 sub test { 931 ## Takes one parameter, the filename (without the extension) of the score 932 ## database. E.g. ("s5scr"). 933 my($dbFile)=@_; 934 my (%assocArray); 935 %assocArray =&dat2aa("$dbFile"); ## create assoc array 936 &backup("$dbFile"); ## backup dat file 937 &aa2dat(\%assocArray,"${dbFile}","AbySec"); ##update dat file and alphbatize 938 } ##end of test 939 940 941 sub readProblemsAndValuesFromDB { 942 my ($setNum,$studID,$cgiMode,$batchMode) = @_; 943 944 #print "cgiMode is $cgiMode\n"; 945 #print "setNum is $setNum\n"; 946 #print "studID is $studID\n"; 947 #print "batchMode is $batchMode\n"; 948 949 950 my @keyList = &getAllProbSetKeysForSet($setNum); 951 my (@problemList,@problemValues,@fixedProblemList,$fixedProblemValuesref,$num); 952 unless ($studID) {$studID = $keyList[0];} ##take a random studID if studID not defined 953 &attachProbSetRecord($studID) || &wwerror("$0","no Record $studID"); 954 my $dueDate = &getDueDate($studID); 955 my $fixedLogin_name = &getStudentLogin($studID); 956 my ($problemListref,$problemValuesref) = getProblemsAndValues($studID); 957 @fixedProblemList = @$problemListref; 958 $fixedProblemValuesref = $problemValuesref; 959 my $noOfProbs = @fixedProblemList; 960 my $warningMsg = ''; 961 962 unless ($batchMode) { 963 foreach $studID (@keyList) { 964 ($problemListref,$problemValuesref) = getProblemsAndValues($studID); 965 @problemList = @$problemListref; 966 unless (($noOfProbs == @problemList) and (&arraysAreEqual($fixedProblemValuesref,$problemValuesref))) { 967 my $login_name = &getStudentLogin($studID); 968 my $warningMsg = " 969 The values for problems (or the number of problems) are not the same for all students 970 For example, the values for problems for loginID $fixedLogin_name are: 971 @$fixedProblemValuesref 972 whereas the values for problems for loginID $login_name are: 973 @$problemValuesref 974 You can Continue using the values for loginID $fixedLogin_name for all students or you can Quit"; 975 976 if ($cgiMode) {return($warningMsg, $dueDate, \@fixedProblemList, $fixedProblemValuesref); } 977 else { 978 print $warningMsg; 979 print "\nEnter C or Q:[C]"; 980 my $ans; 981 $ans=<STDIN>; 982 chomp($ans); 983 if (($ans eq "Q") || ($ans eq "q")) {exit 0;} 984 } 985 } 986 } 987 } 988 ($warningMsg, $dueDate, \@fixedProblemList, $fixedProblemValuesref); 989 } 990 991 992 993 sub getProblemsAndValues { 994 my ($studID) = @_; 995 &attachProbSetRecord($studID) || &wwerror("$0","no Record $studID"); 996 my @problems = &getAllProblemsForProbSetRecord($studID); 997 my @problemList = sort( { $a <=> $b } @problems); 998 my @problemValues = (); 999 my ($num, $problemListref, $problemValuesref); 1000 foreach $num (@problemList) {push @problemValues, &getProblemValue($num,$studID)} 1001 $problemListref = \@problemList; 1002 $problemValuesref= \@problemValues; 1003 ($problemListref, $problemValuesref); 1004 } 1005 1006 1007 sub arraysAreEqual { 1008 my ($arrayOneref, $arrayTworef) = @_; 1009 my $i; 1010 unless ( @$arrayOneref == @$arrayTworef) { return 0 ;} 1011 for ($i =0; $i < $#{@$arrayOneref}+1 ;$i++) { 1012 unless ( $$arrayOneref[$i] == $$arrayTworef[$i]) { return 0 ;} 1013 } 1014 1; 1015 } 1016 1017 sub getRecordedScores { 1018 1019 my ($Sarrayref,$Yarrayref,$Narrayref,$psvn) = @_; 1020 &attachProbSetRecord($psvn); 1021 my $setNumber = &getSetNumber($psvn); 1022 &detachProbSetRecord($psvn); 1023 my ($scoreFileName)="${databaseDirectory}$scoreFilePrefix$setNumber$dash${psvn}.sco"; 1024 #print "Reading from file $scoreFileName\n" if $debugON; 1025 if ( open(SCORE_FILE,"<$scoreFileName") ) { 1026 while (<SCORE_FILE>) { 1027 my @temp=split(/$DELIM/,$_); 1028 $$Sarrayref[$temp[0]] = $temp[1]; 1029 $$Yarrayref[$temp[0]] = $temp[2]; 1030 $$Narrayref[$temp[0]] = $temp[3]; 1031 1032 }; 1033 close(SCORE_FILE); 1034 } else { 1035 warn "Warning: Couldn't open $scoreFileName. Will continue.\n"; 1036 } 1037 # OPERATES ON THE ARRAYS Yarray and Narray. 1038 }
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |