Parent Directory
|
Revision Log
development version dev-1-7-01 from /ww/webwork/development 15-June-2001
1 #!/usr/local/bin/perl 2 3 ## $Id$ 4 5 #################################################################### 6 # Copyright @ 1995-1998 University of Rochester 7 # All Rights Reserved 8 #################################################################### 9 10 11 # This file is scoreProbSet.pl 12 13 use lib '/ww/webwork/gage_system/webwork/system/lib/'; # mainWeBWorKDirectory 14 15 use strict; 16 use Global; 17 use Auth; 18 use CGI qw(:standard); 19 20 # Timing code 21 use Benchmark; 22 my $beginTime = new Benchmark; 23 # end Timing code 24 25 my $batchMode = 0; 26 my $page =''; 27 28 my %inputs; 29 my ($classID, $setNumber, @setNumbers, $appendTotalsQ,$User,$Session_key,$sortOrder); 30 31 32 &CGI::ReadParse; 33 %inputs = %main::in; 34 my $query = $main::in{CGI}; 35 36 37 38 # get information from CGI inputs (see also below for additional information) 39 $classID = $inputs{'course'}; 40 @setNumbers = $query -> param('setNo' ); 41 42 43 #$setNumber = $inputs{'setNo'}; 44 45 $appendTotalsQ = $inputs{'appendTotals'}; 46 $batchMode = $inputs{'batchMode'}; 47 $sortOrder = $inputs{'sortOrder'}; 48 $page = $inputs{'page'}; 49 $User = $inputs{'user'}; 50 $Session_key = $inputs{'key'}; 51 52 unless ($classID && $User && $Session_key) { 53 &wwerror("$0","The script scoreProbSet.pl did not receive the proper input data.","","", query_string()); 54 } 55 56 57 58 # CAUTION: FOR THIS SCRIPT TO WORK CORRECTLTY, ALL STUDENTS 59 # MUST HAVE BEEN ASSIGNED THE SAME NUMBER OF PROBLREMS 60 61 # print "set is $setNumber"; 62 # print "classID is $classID"; 63 64 &getCourseEnvironment($classID); 65 66 my $scriptDirectory = getWebworkScriptDirectory; 67 my $databaseDirectory = getCourseDatabaseDirectory; 68 my $templateDirectory = getCourseTemplateDirectory; 69 my $scoringDirectory = getCourseScoringDirectory; 70 my $cgiURL = getWebworkCgiURL; 71 my $DAT = &getDat; 72 73 require "${scriptDirectory}$Global::DBglue_pl"; 74 require "${scriptDirectory}$Global::classlist_DBglue_pl"; 75 require "${scriptDirectory}$Global::FILE_pl"; 76 require "${scriptDirectory}$Global::SCRtools_pl"; 77 require "${scriptDirectory}$Global::HTMLglue_pl"; 78 79 # verify the identity of the user if from cgi 80 81 my $keyFile = &Global::getCourseKeyFile($classID); 82 # log access 83 &Global::log_info('', query_string); 84 85 &verify_key($User, $Session_key, $keyFile, $classID); 86 my $permissionsFile = &Global::getCoursePermissionsFile($classID); 87 my $permissions = &get_permissions($User, $permissionsFile); 88 89 if ($permissions != $Global::instructor_permissions ) { 90 print "permissions = $permissions instructor_permissions= $Global::instructor_permissions\n"; 91 print &html_NO_PERMISSION; 92 exit(0); 93 } 94 95 96 # get list of problems and values from the database. Warn user if different students 97 # have different numbers of problems or different valuse for the same problem 98 99 my $cgiMode=1; 100 101 foreach $setNumber (@setNumbers) { 102 103 my ($warningMsg,$dueDate, $problemListref,$problemValueListref) 104 = &readProblemsAndValuesFromDB($setNumber,0,$cgiMode,$batchMode); 105 106 if ($warningMsg ne '') { &warningMsgPage(\%inputs,$warningMsg);} 107 108 109 my @problemList = @$problemListref; 110 my @problemValueList = @$problemValueListref; 111 my $noOfProbs = @problemList; 112 113 114 $dueDate = &formatDateAndTime($dueDate); ##originally dueDate is in the form 4/15/96 at 2:00 AM 115 116 my $dueTime=$dueDate; 117 $dueDate=~s|^\s*||; 118 $dueDate=~s|\s*at.*$||; 119 $dueTime=~s|^.*at\s*||; 120 $dueTime=~s|\s*$||; 121 122 #print "$dueDate\n"; 123 #print "$dueTime\n"; 124 125 &get_raw_scores('db', $setNumber, $dueDate, $dueTime); 126 127 my $scrFileName = "s${setNumber}scr"; 128 129 if ($sortOrder ne 'AbySec') { 130 my %assocArray = &dat2aa("$scrFileName"); 131 &aa2dat(\%assocArray,"$scrFileName", $sortOrder); ##sort 132 } 133 134 my $fullTotalsFileName = "${scoringDirectory}${classID}_totals.${DAT}"; 135 my $fullScrFileName = "${scoringDirectory}s${setNumber}scr.${DAT}"; 136 137 if ($appendTotalsQ == 1) { 138 139 my $totalsFileName = "${classID}_totals"; 140 &total_score($scrFileName,$setNumber); 141 142 my $gid = $Global::numericalGroupID; 143 $gid = $Global::numericalGroupID; ## hack to remove warning message about $Global::numericalGroupID used only once 144 145 unless (-e "$fullTotalsFileName") { 146 &createFile("$fullTotalsFileName", $Global::scoring_files_permission, $gid); 147 } 148 unless (-w "$fullTotalsFileName") { 149 &wwerror("$0","Can't write to the file $fullTotalsFileName."); 150 } 151 &append_score_db($totalsFileName,$scrFileName); 152 &delete_columns ($totalsFileName, -$noOfProbs-1, -2, 0); 153 if ($sortOrder ne 'AbySec') { 154 my %assocArray = &dat2aa("$totalsFileName"); 155 &aa2dat(\%assocArray,"$totalsFileName", $sortOrder); ##sort 156 } 157 } 158 } 159 160 161 162 &finishedMsgPage(\%inputs); 163 164 165 166 sub finishedMsgPage { 167 168 my ($inputref) = @_; 169 my %inputs = %$inputref; 170 # print HTML text 171 print &htmlTOP("Scoring Utilities"); 172 173 # print navigation buttons ${cgiURL}profScoring.pl 174 print qq! 175 <A HREF="${cgiURL}profScoring.pl?user=$inputs{'user'}&key=$inputs{'key'}&course=$inputs{'course'}"> 176 <IMG SRC="${Global::upImgUrl}" align="right" BORDER=1 ALT="[Up]"></A><p> 177 !; 178 179 print <<EOF; 180 <HR><BR> 181 <h3 align="left">WeBWorK scoring message for $classID:</h3> 182 EOF 183 184 print "Sets @setNumbers has been scored and the updated scoring files have been saved in the scoring directory 185 $scoringDirectory .<BR> <BR> 186 To return to the scoring page select the \"Up\" buttom. 187 <BR> To return to the Professor page select \"Professor page \". "; 188 189 print <<EOF; 190 <P> 191 192 <FORM METHOD = "POST" ACTION= "${cgiURL}profLogin.pl"> 193 <INPUT TYPE="SUBMIT" VALUE="Professor page"> 194 195 EOF 196 197 # resume printing the rest of the form 198 199 print <<EOF; 200 <INPUT TYPE="HIDDEN" NAME="user" VALUE="$inputs{'user'}"> 201 <INPUT TYPE="HIDDEN" NAME="key" VALUE="$inputs{'key'}"> 202 <INPUT TYPE="HIDDEN" NAME="course" VALUE="$inputs{'course'}"> 203 </FORM> 204 EOF 205 206 207 print &htmlBOTTOM("profScoreProbSet.pl", \%inputs); 208 209 } #end of finished Page 210 211 212 sub warningMsgPage { 213 214 my ($inputref,$warningMsg) = @_; 215 my %inputs = %$inputref; 216 # print HTML text 217 print &htmlTOP("Scoring Utilities"); 218 219 # print navigation buttons 220 print qq! 221 <A HREF="${Global::cgiWebworkURL}profScoring.pl?user=$inputs{'user'}&key=$inputs{'key'}&course=$inputs{'course'}"> 222 <IMG SRC="${Global::upImgUrl}" align="right" BORDER=1 ALT="[Up]"></A><p> 223 !; 224 225 print <<EOF; 226 <HR><BR> 227 <h3 align="left">WeBWorK scoring WARNING message for $classID:</h3> 228 EOF 229 print "<pre>"; 230 print $warningMsg; 231 print "</pre>"; 232 print "To Continue scoring set $setNumber, check the \"Continue\" check box and then select 233 \"Continue scoring set $setNumber\". <BR> To Quit and return to the Scoring page, select the \"Up\" 234 buttom."; 235 236 ## profScoring form -- allows you to score problem sets 237 print <<EOF; 238 <P> 239 240 <FORM METHOD = "POST" ACTION= "${cgiURL}scoreProbSet.pl"> 241 <INPUT TYPE="SUBMIT" VALUE="Continue scoring set $setNumber"> 242 243 EOF 244 245 246 print qq{ 247 <BR><INPUT TYPE=CHECKBOX NAME="batchMode" VALUE=1 >Continue 248 }; 249 250 # resume printing the rest of the form 251 252 print <<EOF; 253 <INPUT TYPE="HIDDEN" NAME="user" VALUE="$inputs{'user'}"> 254 <INPUT TYPE="HIDDEN" NAME="key" VALUE="$inputs{'key'}"> 255 <INPUT TYPE="HIDDEN" NAME="course" VALUE="$inputs{'course'}"> 256 <INPUT TYPE="HIDDEN" NAME="setNo" VALUE="$inputs{'setNo'}"> 257 <INPUT TYPE="HIDDEN" NAME="appendTotals" VALUE="$inputs{'appendTotals'}"> 258 <INPUT TYPE="HIDDEN" NAME="sortOrder" VALUE="$inputs{'sortOrder'}"> 259 260 </FORM> 261 EOF 262 263 264 print &htmlBOTTOM("scoreProbSet.pl", \%inputs); 265 exit; 266 } #end of warning Page 267 268 269 270 271 272
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |