[system] / trunk / webwork / system / cgi / cgi-scripts / profScoreProbSet.pl Repository:
ViewVC logotype

View of /trunk/webwork/system/cgi/cgi-scripts/profScoreProbSet.pl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 6 - (download) (as text) (annotate)
Fri Jun 15 14:29:57 2001 UTC (12 years ago) by gage
File size: 7306 byte(s)
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